#!/usr/bin/perl
# Name:		psh: Perl Shell
# Author:	David Ljung Madison <DaveSource.com>
# See License:	http://MarginalHacks.com/License
# Description:	Just a perl-writing test  - see also mish.c

# Problems:
#	Try 'cd /*/apps/sh<tab>'
#	We reprint the line with the longest completion, but
#	this may be shorter than our current, pathwise.  We
#	should include those lost path-elements in the printout, not
#	just no path at all.

# Ideas:
#	Don't use <glob> - use perl regexp!  <--------------
#	Have () be used for setting $1, $2, etc..
#	  cpx and mvx would just be part of the shell!  :)
#         (Using something like 'cp s/foo.*/bar.*/' would
#          exec 'cp foo.a bar.a foo.b bar.b foo.c bar.c.....'
#	Perl functions! (eval = eval??)
# Shell ideas:
#	<dir> = cd <dir> (implement 'which' at the same time)
#	Do a regular check (or watch an interrupt) that causes this
#	  process to run arbitrary commands (i.e., you could have a all-psh
#	  command, such as to get all psh's to do a cd <- That would be so cool)
# SEE:  /opt/perl5/lib/IPC/Open3.pm or Open2.pm

# Features:
#	History (!# and !substr)
#	aliases
#	Environment Variables (setting)
#	Dynamic, settable prompts (with most of the tcsh %char escapes)
#	Sourcing, .pshrc, .pshlogout
#	Globbing (wildcards in filenames)
#	Completion!
#	Job control!
#
# Missing:
#	Environment variable expansion in line parsing and completion
#	Quoting (of any type)
#	I/O redirection (>,<,|,etc..)
#	(In other words, real parsing)

# Options:
# tcsh-style word completion (words are separated by '_' '-' '.'   not just '/'
$WORD_COMPLETION=1;

#########################
# Char-by-char mode
#########################
sub char_mode {
  return if ($CHAR_MODE);
  $CHAR_MODE=1;
	return if $^O =~ /Win/;
  $ttyname=`tty`;
  system "/bin/stty -icanon -echo min 1 < $ttyname " if (! $?);
}

sub line_mode {
  return if (!$CHAR_MODE);
  $CHAR_MODE=0;
	return if $^O =~ /Win/;
  $ttyname=`tty`;
  `tty -s`;
  system "/bin/stty icanon echo < $ttyname " if (! $? );
}

# Setup select masks
$RIN=$WIN=$EIN='';
vec($RIN, fileno(STDIN), 1) = 1;
$EIN=$RIN;

sub get_char {
  my($ans);

  # Poll for character while watching interrupts
  while(!select($rout=$RIN, undef, undef, 0)) {
    if ($TOOK_INTERRUPT) {
      $TOOK_INTERRUPT=0;
      return -1;
    }
  }

  # Actually get the character
  read(STDIN,$ans,1);
  return $ans;
}

#########################
# Init the system
#########################
my $WINDOWS = ($^O =~ /Win/) ? 1 : 0;
sub init {
  chomp($hostname=`hostname`);
	if ($WINDOWS) {
		$ENV{HOME} ||= $ENV{USERPROFILE};
		$ENV{USER} ||= $ENV{USERNAME};
		$ENV{tty} = '??';
	} else {
  	chomp($ENV{USER}=`whoami`);
  	chomp($ENV{tty}=`tty`);
	}
  ($PROGNAME=$0) =~ s|.*/||;

  # Interrupts
  $SIG{'INT'}='interrupt';
  $SIG{'TERM'}='interrupt';
  $SIG{'HUP'}='interrupt';
  $SIG{'SUSP'}='interrupt';
  $SIG{'QUIT'}='interrupt';

  # Some settings
  $MAX_ALIASES=30;	# Max aliases loop
  $MAX_HISTORY=10;
  $CURR_HISTORY=1;
  $ENV{prompt}="[%~] %t %n@%m:\n[%!] psh%# ";
  #%aliases=("logout","exit","ls","ls -sF","last","!-1","..","cd ..");
  $last_ret=0;
  @JOBS=();
  &char_mode;

	my $pshrc = $WINDOWS ? "$ENV{HOME}\\pshrc" : "$ENV{HOME}/.pshrc";
	$pshrc = "pshrc" if $WINDOWS && ! -r $pshrc;	# Windows has problems with -r and drives
  source($pshrc) if -r $pshrc;
}

#########################
# Interrupts
#########################
sub interrupt {
  alarm(0);	 # Turn off alarms
  # Usually happens during the get_char routine.
  # Best place to check is get_char anyways
  $TOOK_INTERRUPT=1 if (!$EXECUTING_COMMAND);
  return;
}

#########################
# All done
#########################
sub all_done {
  if (!$JOBS_WARNED && keys %JOBS_RUNNING) {
    $JOBS_WARNED=2;
    print STDERR "You have running jobs:\n";
    &show_jobs;
    return 0;
  }
	my $pshlogout = $WINDOWS ? "$ENV{HOME}/pshlogout" : "$ENV{HOME}/.pshlogout";
  source($pshlogout) if -r $pshlogout;
  &line_mode;
  exit;
}

#########################
# Build and show the prompt
#########################
sub prompt {
  $cut=-1;
  $lastcut=0;
  $prompt=$ENV{prompt};
  $prompt=$ENV{prompt}="?> " if (!$prompt);
  if (index($prompt,"%")==-1) {
    $pr=$prompt;
  } else {
# Consider using substr(...)="replace" method

# OR: Andrew's idea:
# $pr=~ s/%(.)/&{$percsubs{$1}}/eg;
# 
# %percsubs = ( "t" => sub { time;... }, "u" => sub { $user }, ... );
# 
# But we only want to calc time once, so pass it in as a hash:
# 
# $pr=~ s/%(.)/&{$percsubs{$1}}(\%timehash)/eg;
# %percsubs = ( "d" => sub { ${$_[0]}{day}; }, ... );

    $pr="";
    while(($cut=index($prompt,"%",$cut+1)) != -1) {
      $pr=$pr.substr($prompt,$lastcut,$cut-$lastcut);
      $code=substr($prompt,++$cut,1);

      # Do time stuff
      ($sec,$min,$hour,$mday,$mon,$year,$wday,$yday,$idst)=localtime;
      $ampm=($hour>12)?"pm":"am";
      $ampmhour=($hour>12)?$hour-12:$hour;
      if ($min<10) { $min="0".$min; }
      if ($sec<10) { $sec="0".$sec; }

      if ($code eq "!" || $code eq "h") {
        $pr=$pr.$CURR_HISTORY;
      } elsif ($code eq "#") {
        $pr=$pr.($ENV{USER} eq "root" ?"#":">");
      } elsif ($code eq "n") {
        $pr=$pr.$ENV{USER};
      } elsif ($code eq "m") {
        $pr=$pr.$hostname;
      } elsif ($code eq "l") {
        $pr=$pr.$ENV{tty};
      } elsif ($code eq "/" || $code eq "~") {
        # There must be a better way!  :(
        $pwd= $WINDOWS ? `echo %CD%` : `pwd`;
        chomp($pwd);
        $pwd =~ s/^$ENV{HOME}/~/ if $code eq "~";
        $pr=$pr.$pwd;
      } elsif ($code eq "t" || $code eq "@") {
        $pr=$pr.$ampmhour.":".$min."pm";
      } elsif ($code eq "T") {
        $pr=$pr.$hour.":".$min;
      } elsif ($code eq "p") {
        $pr=$pr.$ampmhour.":".$min.":".$sec."pm";
      } elsif ($code eq "P") {
        $pr=$pr.$hour.":".$min.":".$sec;
      } elsif ($code eq "d") {
        $pr=$pr.("Sun","Mon","Tue","Wed","Thu","Fri","Sat")[$wday];
      } elsif ($code eq "D") {
        $pr=$pr.($mday<10?"0".$mday:$mday);
      } elsif ($code eq "w") {
        $pr=$pr.("Jan","Feb","Mar","Apr","May","Jun","Jul","Aug","Sep","Oct","Nov","Dec")[$mon];
      } elsif ($code eq "W") {
        $pr=$pr.($mon<10?"0".$mon:$mon);
      } elsif ($code eq "y") {
        $pr=$pr.$year;
      } elsif ($code eq "Y") {
        $pr=$pr.($year>71?"19".$year:"20".$year);
      } elsif ($code eq "?") {
        $pr=$pr.$last_ret;
      } else {
        $pr=$pr."%".$code;
      }
      $lastcut=++$cut;
    }
    $pr=$pr.substr($prompt,$lastcut);
  }
  print STDERR "$pr";
}

#########################
# Create the command array
#########################
sub parse_comm {
# SNIFTY TRICK TO TRY:	(saves whitespace)
# @arr= $line =~ /\S+|\s+/g;	# Splits up whitespace and non-ws
#
  my($str)=@_;
  $str =~ s/^\s+//;
  # Cheat - put whitespace before '&' if it doesn't have it
  $str =~ s/([^\s])&/$1 &/g;
  my(@a)=split(/\s+/,$str);
  return @a;
}

#########################
# Do the command
#########################
sub Do {
  my(@a)=@_;

  # 'exit' twice will ignore the job warning
  $JOBS_WARNED-- if ($JOBS_WARNED>0);

  $cnt=0;	# Alias loop counter

  #########################
  # Expand aliases
  #########################
# ZZZZZZZZZZZZZZZZZZZZz
# ZZZZZZZZZZZZZZZZZZZZz
# Try using substr(...)="replace" method
# Perhaps don't break into array until done with expansions
# ZZZZZZZZZZZZZZZZZZZZz
# ZZZZZZZZZZZZZZZZZZZZz
  while ($al=$aliases{$a[0]}) {
    $old=$a[0];
    $a[0]=$al;
    @a=&parse_comm(join(" ",@a));
    ( ($cnt++ > $MAX_ALIASES) || ($old eq (split(/\s+/,$al))[0]) ) && last;
  }

  #########################
  # Expand history (assume no aliases in history)
  #########################
  if (substr($a[0],0,1) eq "!") {
    $cnt=$CURR_HISTORY;
    $event=substr($a[0],1);
    if ($event < 0) { $event += $CURR_HISTORY; }
    if ($history{$event}) {
      $a[0]=$history{$event};
      @a=&parse_comm(join(" ",@a));
    } else {
      while(--$cnt>$CURR_HISTORY-$MAX_HISTORY-1) {
        if ($history{$cnt} =~ /^$event/) {
          @a=split(/\s+/,$history{$cnt});
          last;
        }  #if
      }  # while
    }  # else
  }
  # If we still have a !command, then we didn't find a history expansion
  if (substr($a[0],0,1) eq "!") {
    print substr($a[0],1).": Event not found.\n";
    return;
  }

  #########################
  # Add to history
  #########################
  $history{$CURR_HISTORY}=join(" ",@a);
  delete $history{($CURR_HISTORY++)-$MAX_HISTORY};

  ($comm,@args)=@a;
  #########################
	# Evaluate environment variables
	# (We could do better than this...)
  #########################
	map { s/\$(\w+)/$ENV{$1}/eg } @args;

  #########################
  # Glob
  # (This kind of cheats because I believe perl fires off a csh to do the glob)
  #########################
  @comm=($comm);	# Start up the comm[] array
  for $arg (@args) {
    if (!/[\*\?\[]/) {
      @comm=(@comm,$arg);
      next;
    }
    @tmp=<${arg}>;	# Glob
    if ($#tmp >= 0) {
      @comm=(@comm,@tmp);
    } else {
      @comm=(@comm,$arg);
    }
  }
	my $fullComm = join(' ',@comm);
	(undef,@args) = @comm;

  #########################
  # Evaluate command
  #   Check for built-ins first
  #########################
  if (($comm eq "exit" || $comm eq "logout") && !(&all_done)) {
    ;		# If all_done fails then we do nothing
  } elsif ($comm eq "jobs") {
    &show_jobs;
  } elsif ($comm eq "kill"
           && (@comm=&kill_wrapper(@comm)) && @comm[0] ne "kill") {
    ;	# We just use the kill_wrapper and keep going
  } elsif ($comm eq "source") {
    shift(@comm);	# Get rid of the 'source'
    &source(@comm);
  } elsif ($comm eq "env") {
    for $key (sort keys %ENV) {
			my $val = $ENV{$key};
			$val =~ s/\n/\\n/mg;
      print "  $key\t$val\n";
    }
  } elsif ($fullComm =~ /^\s*(\S+)\s*=\s*(.*)$/) {
		# Set an environment variable
		my ($key,$val) = ($1,$2);
		$val=$1 if $val =~ /^"(.*)"$/;
    $ENV{$key}=$val;
  } elsif ($comm eq "echo") {
		print "@args\n";
  } elsif ($comm eq "history") {
    for $key (sort {$a<=>$b;} keys %history) {
      print "  $key\t$history{$key}\n";
    }
  } elsif ($comm eq "unalias") {
    delete $aliases{$comm[1]};
  } elsif ($comm eq "alias") {
    if ($#a == 0) {
      for $key (sort keys %aliases) { print "$key\t$aliases{$key}\n"; }
    } elsif ($#a==1) {
      $aliases{$comm[1]} && print "$aliases{$comm[1]}\n";
    } else {
      if ($comm[1] eq "unalias") {
        print "$comm[1]: Too dangerous to alias that.\n";
      } else {
        $a=shift(@args);
        # This is hokey kludgy crap.  This should be from the original line
        $aliases{$a}=join(" ",@args);
      }
    }
  } elsif ($comm eq "cd") {
    print "$comm[1]:  No such file or directory\n"
      if (!chdir($comm[1]));
  } elsif ($comm) {
    $EXECUTING_COMMAND=1;
    $run_background=(@comm[$#comm] eq "&");
    pop(@comm) if ($run_background);
# Check first if we can execute this command
#   This could have the benefit of timing out on hung PATH checks
# (we can't just chdir after we fork...)
    unless ($pid=fork) {
      $WINDOWS ? exec join(" ",@comm) : exec @comm;
      print STDERR "$PROGNAME:  $comm: Command not found.\n";
      exit;
    }
    if ($run_background) {
      &add_job($pid,@comm);
    } else {
      waitpid($pid,0);
    }
    $last_ret=$?;
    $EXECUTING_COMMAND=0;
  }
}

#########################
# Erase a string (do as many ^H as needed)
#########################
sub erase {
  my($str)=@_;
  my($i);
  for($i=0;$i<length($str);$i++) {
    print STDERR "";
  }
}

#########################
# Longest match of an array of strings
#########################
sub longest_match {
  my($tmp)=@_;
  my($max_len)=length($tmp);

  foreach $t (@_) {
    for($i=0;$i<length($t) && substr($t,$i,1) eq substr($tmp,$i,1);$i++) 
      {}	# Empty!
    $max_len=$i if ($i<$max_len);
  }
  return substr($tmp,0,$max_len);
}

#########################
# Pretty print possible options
# First arg is boolean - whether or not we should treat these as files
#########################
sub column_print {
  my($files,@options)=@_;

  # Find out number of columns
  my($max)=0;
  for($i=0;$i<=$#options;$i++) {
    $max=length($options[$i]) if (length($options[$i]) > $max);
  }
  $cols=($ENV{COLUMNS}?$ENV{COLUMNS}:80)-1;
  $col_size=$max+($files?3:2);
  $num_cols=int $cols/$col_size;

  # Print them out
  my($rows)=int $#options/$num_cols;
  my($i,$j);
  print STDERR "\n";
  for($i=0;$i<=$rows;$i++) {
    for($j=0;$j<$num_cols;$j++) {
      if ($el = $options[$i+$j*($rows+1)]) {
        $s=$el;
        if ($files) {
          # Prune path info if they're files
          $s =~ s|.*/|| if ($files);
          if (-d $el) { $s.="/"; }
          elsif (-x $el) { $s.="*"; }
        }
        printf STDERR "%-${col_size}s",$s;
      }
    }
    print STDERR "\n";
  }
}

#########################
# Get completion list
#   Second argument is the command.
#   This is a command completion if $command=0
#########################
sub get_completions {
  my($arg,$command)=@_;
  my(@tmp)=();

  $arg.="*";
  $arg=~s/\./*./g if ($WORD_COMPLETION);
  # Deal with words that start with '.'  globbing treats them special :(
  # (echo *.t* doesn't show .t* files)
  # This solution is incomplete.
  #    /*.a/*.b should become '/*.a/*.b /*.a/.b/ /.a/*.b/ /.a/.b'
  # Stupid globbing
  # (For each '*.stuff' add '.stuff')
  $arg.=" $1" if ($arg =~ /^\*(\..*)/);
  # (For each 'path/*.stuff' add 'path/.stuff')
  $arg.=" $`/$1" if ($arg =~ /\/\*(\..*)/);

  if ($command) {
    # This is an arg
    @tmp=<${arg}>;

    # Specific completion example:
    @tmp=grep(-d,@tmp) if ($command eq "cd");

  } else {
    # This is a command
    foreach $p ( split(/:/,$ENV{PATH}) ) {
      next if (! -d $p);
      @new=<${p}/${arg}>;
      # This grep should be okay since all path elements will have /
      push(@tmp,grep(s|.*/||,@new));
    }
  }
  return @tmp;
}

#########################
# Read a line, do completion, etc..
#########################
sub get_line {
  my ($c,$line)=(0,"");

  my $last_c = 0;
  while(1) {
    return if ( ($c=&get_char)==-1 );

    # Backspace (wipe a character)
    if ($c eq "") {
      next if (!$line);
      $line=substr($line,0,length($line)-1);
      print STDERR " ";
      next;
    }

    # Tab: completion
    # EOF: (like tab but just list possible completions)
    if ($c eq "\t" || $c eq "") {
      $comm = $prev = $arg = 0;
      ($prev,$arg) = $line =~ /^(.*?)(\S+)$/;
      $prev=$line if (!$arg);
      ($comm) = $prev =~ /^\s*(\S+)/;
      @comps=&get_completions($arg,$comm);
 
      next if ($#comps == -1);
      if ($#comps == 0 && $c eq "\t") {
        # We only found one possibility
        $rest=$comps[0];
        $rest.=(-d $comps[0]?"/":" ");
        $line="$prev$rest";
        &erase($arg);
        print STDERR "$rest";
      } else {
        $line=$prev.&longest_match(@comps) if ($c eq "\t");
        # Print out the possible completions
        &column_print(($prev?1:0),@comps);
        &prompt;
        print STDERR "$line";
      }
      next;
    }

    # End of line
    if ($c eq "\n" || $c eq "\r") {
      # Check for \ before end of line
      return "$line" if ($last_c ne "\\");

      # Prompt 2 - should be settable?
      chop($line);      # Remove the \ char
      print STDERR "\n...> ";
      next;
    }


    # Normal case
    print STDERR "$c";
    $line.=$c;
    $last_c=$c;
  }
}

#########################
# Sourcing
#########################
sub source {
  my (@files) = @_;

  foreach $file (@files) {
    my($HANDLE)="SOURCE_$file";
    if (! open($HANDLE,$file)) {
      print STDERR "$PROGNAME: $file not found\n";
      return 0;
    }
    while(<$HANDLE>) {
			s/#.*//;	# No comments
      Do(@arr) if (@arr=&parse_comm($_));
      # No check_jobs here?  Guess not..
    }
    close($HANDLE);
  }
}

#########################
# Job control
#########################
sub kill_wrapper {
  my(@comm)=@_;

  for($i=1;$i<=$#comm;$i++) {
    if ($comm[$i] =~ /^%([0-9]*)$/) {
      if (!$JOBS_PID{$1}) {
        print STDERR "kill: No such job $1\n";
        return 0;	# This will skip the exec of kill
      }
      $comm[$i]=$JOBS_PID{$1};
    }
  }
  return @comm;
}

sub add_job {
  # Pick next number
  $number=1;
  foreach $pid ( keys %JOBS_NUMBER ) {
    $number=$JOBS_NUMBER{$pid}+1 if ($JOBS_NUMBER{$pid}>=$number);
  }
  $JOBS_NUMBER{$pid}=$number;
  $JOBS_PID{$number}=$pid;
  $JOBS_RUNNING{$pid}=1;
  $JOBS_NAME{$pid}=join(" ",@comm);
  print STDERR "[$JOBS_NUMBER{$pid}] $pid\n";
}

sub job_string {
  my($pid) = @_;

  return sprintf("%-6s%s %-30s%-30s%s",
         "[".$JOBS_NUMBER{$pid}."]",		# pid
         " ",					# ?? Is +- in most shells
         # What about Stopped and Terminated?
         ($JOBS_RUNNING{$pid}?"Running":"Done"),
         $JOBS_NAME{$pid},
         (length($JOBS_NAME{$pid})>30?" ...":"") );
}

sub show_jobs {
  foreach $pid ( sort keys %JOBS_NUMBER ) {
    print STDERR &job_string($pid)."\n";
  }
}

sub check_jobs {
  foreach $pid ( keys %JOBS_RUNNING ) {
    if (waitpid($pid,1)) {
      $JOBS_RUNNING{$pid}=0;
      print STDERR &job_string($pid)."\n";
      delete $JOBS_RUNNING{$pid};
      delete $JOBS_NAME{$pid};
      $number=$JOBS_NUMBER{$pid};
      delete $JOBS_PID{$number};
      delete $JOBS_NUMBER{$pid};
    }
  }
}

#########################
# Main	- Our actual shell code
#########################
&init;
while (1) {
  &prompt;
  $line=&get_line;
  print STDERR "\n";
  Do(@arr) if (@arr=&parse_comm($line));
  &check_jobs;
}