#! /usr/bin/perl
#
# psh - Perl Shell
#
# TODO: The background symbol & is currently handled in a hackish way
# in three different places in this file. Could these be unified/made
# less of a hack?
#
# Copyright (C) 1999 Gregor N. Purdy. All rights reserved.
# This script is free software. It may be copied or modified according
# to the same terms as Perl itself.
#

package psh;

use locale;
use vars qw($VERSION);
$VERSION   = '0.004';

use Config;
use Cwd;
use Cwd 'chdir';
use FileHandle;
use Getopt::Std;
use POSIX qw(:sys_wait_h getpid setpgid tcgetpgrp tcsetpgrp);

use Psh::Joblist;
use Psh::Job;
use Psh::Completion;
use Psh::Locale::Base;
use Psh::Parser;

#
# Must be on top of file before any "my" variables!
#
#
# array protected_eval(string EXPR, string FROM) 
#
# Evaluates "$psh::eval_preamble EXPR", handling trapped signals and
# printing errors properly. The FROM string is passed on to
# handle_message to indicate where errors came from.
# 
# If EXPR ends in an ampersand, it is stripped and the eval is done in
# a forked copy of perl.
#
sub protected_eval
{
	#
	# Local package variables because lexical variables here mask
	# variables of the same name in main!!
	#
 
	local ($psh::string, $psh::from) = @_;
	local $psh::currently_active     = 0;
        local $psh::redo_sentinel        = 0;
	local $psh::fgflag               = 1;

	if ($psh::string =~ m/^(.*)\&\s*$/) {
		$psh::string = $1;
		$psh::fgflag      = 0;
	}

	# It's not possible to use fork_process for foreground perl
	# as we would lose all variables etc.

	if( $psh::fgflag) {
		{ #Dummy block to catch loop-control statements at outermost
                  #level in EXPR 
		      # First, protect against infinite loop
		      # caused by redo:
		      if ($redo_sentinel) { last; } 
		      $redo_sentinel = 1;
                      $currently_active = -1;
		      local @psh::result= eval "$psh::eval_preamble $psh::string";
		      handle_message($@, $psh::from);
                      $currently_active = 0;
                      return @psh::result;
                }
                handle_message("Can't use loop control outside a block",
			       $psh::from);
		return undef;
	} else {
	      { #Another such dummy block
		      if ($redo_sentinel) { last; }
		      $redo_sentinel = 1;
		      fork_process( sub {
			      #No need to save the result, we're not using it:
			      eval "$psh::eval_preamble $psh::string";
			      if ($@) { exit -1; }
			      exit 0;
		      }, $psh::fgflag, $psh::string);
		      return undef; # child never gets here, parent always does
		                    # but has no value to return.
	      }
	      exit -2; # child could get here, if it uses loop control
                       # statements at outermost level. I used a different
                       # exit status just in case we can ever look at
                       # that.
	}
	#I believe it's now impossible to get here:
	print_error("psh internal error code name MANGLED FORK");
	return undef;
}


#
# array variable_expansion (arrayref WORDS)
#
# For each element x of the array referred to by WORDS, substitute
# perl variables that appear in x respecting the quoting symbols ' and
# ", and return the array of substituted values. Substitutions inside
# quotes always return a single element in the resulting array;
# outside quotes, the result is split() and pushed on to the
# accumulating array of substituted values
#

sub variable_expansion
{
	local ($psh::arref) = @_;
	local @psh::retval  = ();
	local $psh::word;

	for $psh::word (@{$psh::arref}) {
		if    ($psh::word =~ m/^\'/) { push @psh::retval, $psh::word; }
		elsif ($psh::word =~ m/^\"/) { 
			local $psh::val = eval("$psh::eval_preamble $psh::word");

			if ($@) { push @psh::retval, $psh::word; }
			else    { push @psh::retval, "\"$psh::val\""; }
		} else {
			local $psh::val = eval("$psh::eval_preamble \"$psh::word\"");

			if ($@) { push @psh::retval, $psh::word; }
			else    { push @psh::retval, split(" ",$psh::val); }
		}
	}

	return @psh::retval;
}


##############################################################################
##############################################################################
##
## Variables
##
##############################################################################
##############################################################################



#
# Global Variables:
#
# The use vars variables are intended to be accessible to the user via
# explicit psh:: package qualification. They are documented in the pod
# page. 
#
#
# The other global variables are private, lexical variables.
#

use vars qw($bin $news_file $cmd $prompt $echo $host $debugging
	    $perlfunc_expand_arguments $executable_expand_arguments
	    $history_file $save_history $history_length
	    $eval_preamble $currently_active $handle_segfaults
	    @val @wday @mon @strategies @bookmarks @netprograms
		%array_exports %text %perl_builtins %perl_builtins_noexpand
	    %prompt_vars %built_ins %strategy_which %strategy_eval);


#
# Private, Lexical Variables:
#

my %opt;
my $default_prompt         = '\s\$ ';
my @default_strategies     = qw(comment bang built_in perlfunc executable eval);
my $input;
my $readline_saves_history = 0;
my $last_dir               = '.'; # By default 'cd -' won't change directory at all.
my $term;                         # Term::ReadLine object.
my @absed_path    = ();
my $joblist;


##############################################################################
##############################################################################
##
## SETUP
##
##############################################################################
##############################################################################



$SIG{'INT'}   = \&signal_handler;
$SIG{'QUIT'}  = \&signal_handler;
$SIG{'CONT'}  = \&signal_handler;
$SIG{'STOP'}  = \&signal_handler;
$SIG{'TSTP'}  = \&signal_handler;
$SIG{'TTIN'}  = \&signal_handler;
$SIG{'TTOU'}  = \&signal_handler;
$SIG{'CHLD'}  = \&ignore_handler;
$SIG{'WINCH'} = \&resize_handler;


#
# Parse the command line and deal with the options except -r, which is
# handled in the MAIN program below. We do this part vary early in this
# file so that the results apply to all the setting up we do before the
# MAIN program.
#

getopts('dwr:c:', \%opt);


#
# -w is "warnings mode":
#

if ($opt{'w'}) {
	print_out_i18n('simulate_perl_w');

	$^W = 1;
	use strict;
}

#
# -d is "debug mode":
#

if ($opt{'d'}) { $debugging = 1; }
else           { $debugging = 0; }

print_debug("Debugging!\n");


##############################################################################
##############################################################################
##
## SUBROUTINES: Support
##
##############################################################################
##############################################################################



#
# string abs_path(string DIRECTORY)
#
# expands the argument DIRECTORY into a full, absolute pathname.
#

eval "use Cwd 'fast_abs_path';";
if (!$@) {
  print_debug("Using &Cwd::fast_abs_path()\n");
  sub abs_path { return fast_abs_path(@_); }
} else {
    sub abs_path {
		my $dir = shift;
		
		$dir = '~' unless defined $dir and $dir ne '';
		
		if ($dir =~ m|^(~([a-zA-Z0-9-]*))(.*)$|) {
			my $user = $2; 
			my $rest = $3;
			
			my $home;
			
			if ($user eq '') { $home = $ENV{HOME}; }
			else             { $home = (getpwnam($user))[7]; }
			
			if ($home) { $dir = "$home$rest"; } # If user's home not found, leave it alone.
		}
		
		if (!$dir =~ m|^/|) { $dir = cwd . '/'. $dir }
		
		return $dir;
	}
}


#
# string which(string FILENAME)
#
# search for an occurrence of FILENAME in the current path as given by 
# $ENV{PATH}. Return the absolute filename if found, or undef if not.
#

{
	#
	# "static variables" for which() :
	#

	my $last_path_cwd = '';
	my %hashed_cmd    = ();

	sub which
    {
		my $cmd      = shift;

		print_debug("[which $cmd]\n");

		if ($cmd =~ m|/|) {
			my $try = abs_path($cmd);
			if ((-x $try) and (! -d _)) { return $try; }
			return undef;
		}

		if ($last_path_cwd ne ($ENV{PATH} . cwd())) {
			$last_path_cwd = $ENV{PATH} . cwd();
			@absed_path    = ();
			%hashed_cmd    = ();

			my @path = split(':', $ENV{PATH});

			foreach my $dir (@path) {
				push @absed_path, abs_path($dir);
			}
		}

		if (exists($hashed_cmd{$cmd})) { return $hashed_cmd{$cmd}; }
      
		foreach my $dir (@absed_path) {
			my $try = "$dir/$cmd";

			if ((-x $try) and (!-d _)) { 
				$hashed_cmd{$cmd} = $try;
				return $try; 
			}
		}
      
		$hashed_cmd{$cmd} = undef;

		return undef;
	}
}



##############################################################################
##############################################################################
##
## SUBROUTINES: Built-Ins
##
##############################################################################
##############################################################################



#
# int builtin_cd(string DIR)
#
# Changes directories to the given DIR; '-' is interpreted as the
# last directory that psh was in
#

sub builtin_cd
{
	my $in_dir = shift;
	my $dir = $in_dir;

	$dir = $last_dir if $dir eq '-';
	$dir = abs_path($dir);

	if ((-e $dir) and (-d _)) {
		if (-x _) {
			$last_dir = cwd;
			chdir $dir;
		} else {
			print_error_i18n('perm_denied',$in_dir,$bin);
			return 1;
		}
	} else  {
		print_error_i18n('no_such_dir',$in_dir,$bin);
		return 1;
	}

	return 0;
}


#
# int builtin_kill(string COMMAND)
#

sub builtin_kill
{
	my @args = split(' ',$_[0]);
	my ($sig, $pid, $job);

	if (scalar(@args) == 1) {
		$pid = $args[0];
		$sig = 'TERM';
	} elsif (scalar(@args) == 2) {
		($sig, $pid) = @args;
	} else {
		print_error("kill: usage: kill <sig> <pid>\n");
		return 1;
	}

	if ($pid =~ m|^%(\d+)$|) {
		my $temp = $1 - 1;

		$job= $joblist->find_job($temp);
		if( !defined($job)) {
			print_error("kill: No such job $pid\n");
			return 1;
		}

		$pid = $job->{pid};
	}

	if ($pid =~ m/\D/) {
		print_error("kill: Unknown job specification $pid\n");
		return 1;
	}

	if ($sig ne 'CONT' and $joblist->job_exists($pid)
		and !(($job=$joblist->get_job($pid))->{running})) {
		#Better wake up the process so it can respond to this signal
		$job->continue;
	}

	if (kill($sig, $pid) != 1) {
		print_error("kill: Error sending signal $sig to process $pid\n");
		return 1;
	}

	if ($sig eq 'CONT' and $joblist->job_exists($pid)) {
		$joblist->get_job($pid)->{running}=1;
	}

	return 0;
}


#
# int builtin_which(string COMMAND)
#

sub builtin_which
{
	my $cmd   = shift;

	print_debug("[builtin_which $cmd]\n");

	if (!defined($cmd) or $cmd eq '') {
		print_error("which: requires a command or command line as argument\n");
		return 1;
	}
  
	my @words = Psh::Parser::decompose(' ',$cmd,undef,1,undef,'\&');

	for my $strat (@psh::strategies) {
		if (!defined($psh::strategy_which{$strat})) {
			print_warning("$bin: WARNING: unknown strategy '$strat'.\n");
			next;
		}

		my $how = &{$psh::strategy_which{$strat}}(\$cmd,\@words);

		if ($how) {
			print_out("$cmd evaluates under strategy $strat by: $how\n");
			return 0;
		}
	}

	print_warning("which: can't determine how to evaluate $cmd\n");

	return 1;
}


#
# int builtin_alias(string COMMAND)
#

{
  # "Static variable" for builtin_alias
  my %aliases = ();

  sub builtin_alias
  {
        my $line = shift;
	my ($command, $firstDelim, @rest) = Psh::Parser::decompose('([ \t\n=]+)', $line, undef, 0);
	if (!defined(@rest)) { @rest = (); }
	my $text = join('',@rest); # reconstruct everything after the
                                   # first delimiter, sans quotes
	if (($command eq "") && ($text eq "")) {
	        my $wereThereSome = 0;
 	        for $command (sort keys %aliases) {
		        print_out("alias $command='$aliases{$command}'\n");
			$wereThereSome = 1;
		}
		if (!$wereThereSome) {
		        print_out("No aliases.\n");
		}
	} else {
	        #
                # TODO: if $text is empty, should we just print out the
	        # alias for $command like bash does?
                #
		print_debug("[[ Aliasing '$command' to '$text']]\n");
		# my apologies for the gobbledygook
		my $string_to_eval = "\$psh::built_ins{$command} = "
			. " sub { local \$psh::built_ins{$command} = undef; psh::evl(q($text) .' '. shift); }";
		print_debug("[[ alias evaluating: $string_to_eval ]]\n");
		eval($string_to_eval);
		if ($@) { print_error($@); return 1; }
		# if successful, record the alias
		$aliases{$command} = $text;
	}

	return 0;
  }

  #
  # TODO: I do believe we need an unalias.
  #

}



#
# void builtin_fg(int JOB_NUMBER)
#

sub builtin_fg
{
	my $arg = shift;

	$arg = -0 if (!defined($arg) or ($arg eq ''));
	$arg =~ s/\%//;

	restart_job(1, $arg - 1);

	return undef;
}


#
# int builtin_bg(string JOB)
#

sub builtin_bg
{
	my $arg = shift;

	$arg = 0 if (!defined($arg) or ($arg eq ''));
	$arg =~ s/\%//;

	restart_job(0, $arg - 1);

	return undef;
}


#
# void builtin_jobs()
#
# Checking whether jobs are running might print reports that
# jobs have stopped, so accumulate the job list and print it
# all at once so it's readable.
#

sub builtin_jobs {
	my $result = '';
	my $job;
	my $visindex=1;

	$joblist->enumerate;

	while( ($job=$joblist->each)) {
		my $pid      = $job->{pid};
		my $command  = $job->{call};
	    
		$result .= "[$visindex] $pid $command";

		if ($job->{running}) { $result .= "\n"; }
		else                 { $result .= " (stopped)\n"; }
		$visindex++;
	}

	if (!$result) { $result = "No jobs.\n"; }

	print_out($result);

	return undef;
}


#
# void builtin_exit(int RETURN_CODE)
#
# TODO: What if a string is passed in?
#

sub builtin_exit
{
	my $result = shift;
	$result = 0 unless defined($result) && $result;

	if ($save_history && $readline_saves_history) {
		$term->WriteHistory($psh::history_file);
	}
	
	my $file= "$ENV{HOME}/.${bin}_logout";
	if( -r $file) {
		process_file(abs_path($file));
	}

	exit $result;
}


#
# void builtin_source(string LIST_OF_FILES)
#

sub builtin_source
{
	local $echo = 0;

	for my $file (split(' ',$_[0])) { process_file(abs_path($file)); }

	return undef;
}


#
# void builtin_readline(string IGNORED)
#
# Interface to the readline module being used. Currently very rudimentary 
#
# TODO: How can we print out the current bindings in an
# ReadLine-implementation-independent way? We should allow rebinding
# of keys if Readline interface allows it, etc.
#

sub builtin_readline
{
	print_out("Using ReadLine: ", $term->ReadLine(), ", with features:\n");

	my $featureref = $term->Features();

	for my $feechr (keys %{$featureref}) {
		print_out("  $feechr => ${$featureref}{$feechr}\n");
	}

	return undef;
}


#
# string do_setenv(string command)
#
# command is of the form "VAR VALUE" or "VAR = VALUE" or "VAR"; sets
# $ENV{VAR} to "VALUE" in the first two cases, or to "$VAR" in the
# third case unless $VAR is undefined. Used by the setenv and export
# builtins. Returns VAR (which is a string with no $).

sub do_setenv
{
	my $arg = shift;
	if( $arg=~ /^\s*(\w+)(\s+|\s*=\s*)(.+)/ ) {
		my $var= $1;
		$var =~ s/^\$//;
		# Use eval so that variables may appear on RHS
		# (expression $3); use protected_eval so that lexicals
		# in this file don't shadow package variables
        	protected_eval("\$ENV{$var}=\"$3\"", 'do_setenv');
		return $var;
	} elsif( $arg=~ /(\w+)/ ) {
		my $var= $1;
		$var =~ s/^\$//;
		protected_eval("\$ENV{$var}=\$$var if defined(\$$var);",
			       'do_setenv');
		return $var;
        }
        return '';
}

#
# void builtin_setenv(string command)
#
# Allows to set environment variables without needing to use
# $ENV{..}

sub builtin_setenv
{
        my $var = do_setenv(@_);
	if (!$var) {
		print_error("Usage: setenv <variable> <value>\n".
					"       setenv <variable>\n");
	}
	return undef;
}

#
# void builtin_export(string command)
#
# Like setenv, but also ties the variable so that changing it affects
# the environment
#

sub builtin_export
{
	my $var = do_setenv(@_);
	if ($var) {
		my @result = protected_eval("tied(\$$var)");
		my $oldtie = $result[0];
		if (defined($oldtie)) {
			if (ref($oldtie) ne 'Env') {
				print_warning("Variable \$$var is already ",
							  "tied via $oldtie, ",
							  "can't export.\n");
			}
		} else {
			protected_eval("use Env '$var';");
			if( exists($array_exports{$var})) {
				eval "use Env::Array";
				if( ! @$) {
					protected_eval("use Env::Array qw($var $array_exports{$var});");
				}
			}
		}
	} else {
		print_error("Usage: export <variable> [=] <value>\n".
					"       export <variable>\n");
	}
	return undef;
}


##############################################################################
##############################################################################
##
## SUBROUTINES: Command-line processing
##
##############################################################################
##############################################################################


#
# variable_expansion is defined above for technical reasons; see
# comments there
#

# EVALUATION STRATEGIES: We have two hashes, %strategy_which and
#  %strategy_eval; an evaluation strategy called "foo" is implemented
#  by putting a subroutine object in each of these hashes keyed by
#  "foo". The first subroutine should accept a reference to a string
#  (the exact input line) and a reference to an array of strings (the
#  'psh::decompose'd line, provided as a convenience). It should
#  return a string, which should be null if the strategy does not
#  apply to that input line, and otherwise should be an arbitrary
#  non-null string describing how that strategy applies to that
#  line. It is guaranteed that the string passed in will contain some
#  non-whitespace, and that the first string in the array is
#  non-empty.
#
# The $strategy_eval{foo} routine accepts the same first two arguments
#  and a third argument, which is the string returned by
#  $strategy_which{foo}. It should do the evaluation, and return the
#  result. Note that the $strategy_eval function will be evaluated in
#  an array context. Note also that if $psh::echo is true, the
#  process() function below will print and store away any
#  result that is not undef.
#
# @psh::strategies contains the evaluation strategies in order that
# will be called by evl().
#
#
# TODO: Is there a better way to detect Perl built-in-functions and
# keywords than the following? Surprisingly enough,
# defined(&CORE::abs) does not work, i.e., it returns false.
#

%perl_builtins = qw( -X 1 abs 1 accept 1 alarm 1 atan2 1 bind 1
binmode 1 bless 1 caller 1 chdir 1 chmod 1 chomp 1 chop 1 chown 1 chr
1 chroot 1 close 1 closedir 1 connect 1 continue 1 cos 1 crypt 1
dbmclose 1 dbmopen 1 defined 1 delete 1 die 1 do 1 dump 1 each 1
endgrent 1 endhostent 1 endnetent 1 endprotoent 1 endpwent 1
endservent 1 eof 1 eval 1 exec 1 exists 1 exit 1 exp 1 fcntl 1 fileno
1 flock 1 for 1 foreach 1 fork 1 format 1 formline 1 getc 1 getgrent 1
getgrgid 1 getgrnam 1 gethostbyaddr 1 gethostbyname 1 gethostent 1
getlogin 1 getnetbyaddr 1 getnetbyname 1 getnetent 1 getpeername 1
getpgrp 1 getppid 1 getpriority 1 getprotobyname 1 getprotobynumber 1
getprotoent 1 getpwent 1 getpwnam 1 getpwuid 1 getservbyname 1
getservbyport 1 getservent 1 getsockname 1 getsockopt 1 glob 1 gmtime
1 goto 1 grep 1 hex 1 import 1 if 1 int 1 ioctl 1 join 1 keys 1 kill 1
last 1 lc 1 lcfirst 1 length 1 link 1 listen 1 local 1 localtime 1 log
1 lstat 1 m// 1 map 1 mkdir 1 msgctl 1 msgget 1 msgrcv 1 msgsnd 1 my 1
next 1 no 1 oct 1 open 1 opendir 1 ord 1 pack 1 package 1 pipe 1 pop 1
pos 1 print 1 printf 1 prototype 1 push 1 q/STRING/ 1 qq/STRING/ 1
quotemeta 1 qw/STRING/ 1 qx/STRING/ 1 rand 1 read 1 readdir 1 readlink
1 recv 1 redo 1 ref 1 rename 1 require 1 reset 1 return 1 reverse 1
rewinddir 1 rindex 1 rmdir 1 s/// 1 scalar 1 seek 1 seekdir 1 select 1
semctl 1 semget 1 semop 1 send 1 setgrent 1 sethostent 1 setnetent 1
setpgrp 1 setpriority 1 setprotoent 1 setpwent 1 setservent 1
setsockopt 1 shift 1 shmctl 1 shmget 1 shmread 1 shmwrite 1 shutdown 1
sin 1 sleep 1 socket 1 socketpair 1 sort 1 splice 1 split 1 sprintf 1
sqrt 1 srand 1 stat 1 study 1 sub 1 substr 1 symlink 1 syscall 1
sysread 1 system 1 syswrite 1 tell 1 telldir 1 tie 1 time 1 times 1
tr/// 1 truncate 1 uc 1 ucfirst 1 umask 1 undef 1 unless 1 unlink 1
unpack 1 unshift 1 untie 1 until 1 use 1 utime 1 values 1 vec 1 wait 1
waitpid 1 wantarray 1 warn 1 while 1 write 1 y/// 1 );


#
# The following hash contains names where the arguments should never
# undergo expansion in the sense of
# $psh::perlfunc_expand_arguments. For example, any perl keyword where
# an argument is interpreted literally by Perl anyway (such as "use":
# use $yourpackage; is a syntax error) should be on this
# list. Flow-control keywords should be here too.
#
# TODO: Is this list complete ?
#

%perl_builtins_noexpand = qw( continue 1 do 1 for 1 foreach 1 goto 1 if 1 last 1 local 1 my 1 next 1 package 1 redo 1 sub 1 until 1 use 1 while 1);

#
# bool matches_perl_binary(string FILENAME)
#
# Returns true if FILENAME referes directly or indirectly to the
# current perl executable
#

sub matches_perl_binary
{
	my ($filename) = @_;

	#
	# Chase down symbolic links, but don't crash on systems that don't
	# have them:
	#

	if ($Config{d_readlink}) {
		my $newfile;
		while ($newfile = readlink($filename)) { $filename = $newfile; }
	}

	if ($filename eq $Config{perlpath}) { return 1; }

	my ($perldev,$perlino) = (stat($Config{perlpath}))[0,1];
	my ($dev,$ino) = (stat($filename))[0,1];

	#
	# TODO: Does the following work on non-Unix OS ?
	#

	if ($perldev == $dev and $perlino == $ino) { return 1; }

	return 0;
}


#
# string signal_name( int )
# Looks up the name of a signal
#

sub signal_name {
	my $signalnum = shift;
	my @numbers= split ",",$Config{sig_num};
	my @names= split " ",$Config{sig_name};
	for( my $i=0; $i<$#numbers; $i++)
	{
		return $names[$i] if( $numbers[$i]==$signalnum);
	}
	return $signalnum;
}

#
# string signal_description( int signal_number | string signal_name )
# returns a descriptive name for the POSIX signals
#

sub signal_description {
	my $signal_name= signal_name(shift);
	my $desc= $text{sig_description}->{$signal_name};
   	if( defined($desc) and $desc) {
		
		return "SIG$signal_name - $desc";
	}
	return "signal $signal_name";
}

#
# EVALUATION STRATEGIES:
#

#
# TODO: We have a foolproof symbol for ignoring a line, and for
# sending it to system. Should there be one for sending it to the Perl
# interpreter? I suggest adding a "brace" strategy, so that any line
# whose first word starts with a brace is automatically sent to the 
# perl evaluator unchanged.
#

%strategy_which = (
	'bang'     => sub { if (${$_[1]}[0] =~ m/^!/)  { return 'system';  } return ''; },

	'comment'  => sub { if (${$_[1]}[0] =~ m/^\#/) { return 'comment'; } return ''; },

	'built_in' => sub {
		 my $fnname = ${$_[1]}[0];

		 if (defined($built_ins{$fnname})) { return "(built-in $fnname)" }

		 return '';
	},

	'perlfunc' => sub {
		my $fnname = ${$_[1]}[0];
		# TODO: The following check will catch input lines
		# like "print 'Hello';"; should we also look at
		# everything up to the first '(' to grab input lines
		# like "print('hello');" at this stage instead of
		# having to let them trickle all the way down to the
		# "eval" strategy? We could simply re-"decompose" the
		# first word with "(" as a delimiter, and check the
		# first word of that as well.
		if (exists($perl_builtins{$fnname}) 
			or defined(&{"main::$fnname"})) {
			my $copy = ${$_[0]};

			#
			# remove braces containing no whitespace
			# and at least one comma in checking,
			# since they might be for brace expansion
			#

			$copy =~ s/{\S*,\S*}//g;

			if (!$perlfunc_expand_arguments
				or exists($perl_builtins_noexpand{$fnname})
				or $copy =~ m/[(){},]/) {
				return ${$_[0]};
			} else {                     # no parens, braces, or commas, so  do expansion
				my $ampersand = '';
				my $lastword  = pop @{$_[1]};

				if ($lastword eq '&') { $ampersand = '&';         }
				else                  { push @{$_[1]}, $lastword; }

				shift @{$_[1]};          # OK to destroy command line since we matched

				#
				# No need to do variable expansion, because the whole thing
				# will be evaluated later.
				#

				my @args = Psh::Parser::glob_expansion($_[1]);

				#
				# But we will quote barewords, expressions involving
				# $variables, filenames, and the like:
				#

				foreach (@args) {
					if (&Psh::Parser::needs_double_quotes($_)) {
	                    $_ = "\"$_\"";
                    } 
				}

				my $possible_proto = '';

				if (defined($perl_builtins{$fnname})) {
					$possible_proto = prototype("CORE::$fnname");
				} else {
					$possible_proto = prototype($fnname);
				}

				#
				# TODO: Can we use the prototype more fully here?
				#

				my $command = '';

				if (defined($possible_proto) and $possible_proto != '@') {
					#
					# if it's not just a list operator, better not put in
					# parens, because they could change the semantics
					#

					$command = "$fnname " . join(",",@args);
				} else {
					#
					# Otherwise put in the parens to avoid any ambiguity: we
					# want to pass the given list of args to the function. It
					# would be better in perlfunc eval to get a reference to
					# the function and simply pass the args to it, but I
					# couldn't find any way to make that work with perl
					# builtins. You can't take a reference to CODE::sort, for
					# example.
					#

					$command .= "$fnname(" . join(",",@args) . ')';
				}

				return $command . $ampersand;			}
		}

 		return '';
	},

	'perlscript' => sub {
		my $script = which(${$_[1]}[0]);

		if (defined($script) and -r $script) {
			#
			# let's see if it really looks like a perl script
			#

			my $sfh = new FileHandle($script);
			my $firstline = <$sfh>;

			$sfh->close();
			chomp $firstline;

			my $filename;
			my $switches;

			if (($filename,$switches) = 
				($firstline =~ m|^\#!\s*(/.*perl)(\s+.+)?$|go)
				and matches_perl_binary($filename)) {
				my $possibleMatch = $script;
				my %bangLineOptions = ();

				if( $switches) {
					$switches=~ s/^\s+//go;
					local @ARGV = split(' ', $switches);

					#
					# All perl command-line options that take aruments as of 
					# Perl 5.00503:
					#

					getopt('DeiFlimMx', \%bangLineOptions); 
				}

				if ($bangLineOptions{w}) { 
					$possibleMatch .= " warnings"; 
					delete $bangLineOptions{w};
				}

				#
				# TODO: We could handle more options. [There are some we
				# can't. -d, -n and -p are popular ones that would be tough.]
				#

				if (scalar(keys %bangLineOptions) > 0) {
					print_debug("[[perlscript: skip $script, options $switches.]]\n");
					return '';
				}

				return $possibleMatch;
			}
		}

		return '';
	},

	'executable' => sub {
		my $executable = which(${$_[1]}[0]);

		if (defined($executable)) { 
			shift @{$_[1]}; # OK to destroy the command line because we're
                            # going to match this strategy
			if (!$executable_expand_arguments) {
				return "$executable @{$_[1]}"; 
			}

			# No need to do glob_expansion, the system call will do that.

			@newargs = variable_expansion($_[1]);

			return "$executable @newargs";
		}

		return '';
	},

   'eval' => sub { return 'perl evaluation'; }
);


#
# void remove_signal_handlers()
#
# TODO: Is there a way to do this in a loop over something from the
# Config module? If so, should we use it? If we do, shouldn't we
# use the same mechanism to set up the signal handlers in the first
# place?
#

sub remove_signal_handlers
{
	$SIG{INT}   = 'DEFAULT';
	$SIG{QUIT}  = 'DEFAULT';
	$SIG{CONT}  = 'DEFAULT';
	$SIG{STOP}  = 'DEFAULT';
	$SIG{TSTP}  = 'DEFAULT';
	$SIG{TTIN}  = 'DEFAULT';
	$SIG{TTOU}  = 'DEFAULT';
	$SIG{CHLD}  = 'DEFAULT';
#	$SIG{WINCH} = 'DEFAULT';
# This one should stay installed
}


#
# void give_terminal_to (int PID) 
#
# Make pid the foreground process of the terminal controlling STDIN.
#

sub give_terminal_to
{
	# Why are the signal handlers changed for this method only ?!?

        # Current answer by gtw: I put these signal-handler changes in
        # here. It's the last bit of "magic" I copied from
        # bash-2.03/jobs.c . I don't know why it's necessary, I just
        # know that job control was erratic, sometimes causing hangs
        # when foreground children terminated, until I changed these
        # signal handlers. This whole function is closely modeled on
        # the function by the same name in bash-2.03/jobs.c .

	local $SIG{TSTP}  = 'IGNORE';
	local $SIG{TTIN}  = 'IGNORE';
	local $SIG{TTOU}  = 'IGNORE';
	local $SIG{CHLD}  = 'IGNORE';

	#
	# Perl will always complain about the tcsetpgrp if warnings
	# are enabled... so we switch it off here
	# TODO: Find out if really something is wrong with this line
	local $^W=0;
	tcsetpgrp(STDIN,$_[0]);
}


%strategy_eval = (
	'comment' => sub { return undef; },

	'bang' => sub {
		my ($string) = (${$_[0]} =~ m/!(.*)$/);

		my_system($string);

		return undef;
	},

	'built_in' => sub {
		my ($command,$rest) = Psh::Parser::std_tokenize(${$_[0]},2);
        if ($command ne ${$_[1]}[0]) {
                print_error("Parsing error: $command ne ${$_[1]}[0]\n");
				return undef;
		}
		return &{$psh::built_ins{$command}}($rest);
	},

	'perlscript' => sub {
		my ($script, @options) = split(' ',$_[2]);
		my @arglist = @{$_[1]};

		shift @arglist; # Get rid of script name
		my $fgflag = 1;

		if (scalar(@arglist) > 0) {
			my $lastarg = pop @arglist;

			if ($lastarg =~ m/\&$/) {
				$fgflag = 0;
				$lastarg =~ s/\&$//;
			}

			if ($lastarg) { push @arglist, $lastarg; }
		}

		print_debug("[[perlscript $script, options @options, args @arglist.]]\n");

		my $pid;

		my %opts = ();
		foreach (@options) { $opts{$_} = 1; }

		fork_process(sub {
			package main;
			# TODO: Is it possible/desirable to put main in the pristine
			# state that it typically is in when a script starts up,
			# i.e. undefine all routines and variables that the user has set?
			
			local @ARGV = @arglist;
			local $^W;

			if ($opts{warnings}) { $^W = 1; }
			else                 { $^W = 0; }

			do $script;

			exit 0;
		}, $fgflag, $script);

		return undef;
	},

	'executable' => sub { my_system("$_[2]"); return undef; },

	#
	# TODO: Is this the best way to manage the package context?
	#
	# Consider:
	#
	#     my $pkg = package;
	#     package psh;
	#     ...
	#     package $pkg;
	#     eval ...
	#     package $psh;
	#
	# The idea here is to not force "package main" as it does now.
	#
	# [gtw 1999 Nov 22: The above is a nice idea, but I believe neither
	#    'my $pkg = package;' nor 'package $pkg;' is valid Perl syntax.
	#    As far as I can see, the only way to allow different package
	#    contexts would be to keep track of the desired package by a
	#    built-in command, and prepending the desired package to every
	#    evaluation. Toward that possible goal, I have added a variable
	#    $psh::eval_preamble which is prepended to every eval. This
	#    defaults to 'package main;'. To allow selecting other packages
	#    for evaluation, its value could be manipulated.
	# ]
	#

	'eval'     => sub { return protected_eval(${$_[0]}, 'eval'); },

	'perlfunc' => sub { return protected_eval($_[2],    'eval'); }
);


#
# void handle_message (string MESSAGE, string FROM = 'eval')
#
# handles any message that an eval might have returned. Distinguishes
# internal messages from psh's signal handlers from all other
# messages. It displays internal messages with print_out or does
# nothing with them if FROM = 'main_loop'. It displays other messages with
# print_error, and if FROM = 'main_loop', psh dies in addition.
#

sub handle_message
{
	my ($message, $from) =  @_;

	if (!defined($from)) { $from = 'eval'; }

	chomp $message;

	if ($message) {
		if ($message =~ m/^SECRET $bin:(.*)$/s) {
			if ($from ne 'main_loop') { print_out("$1\n"); }
		} else {
			print_error("$from error ($message)!\n");
			if ($from eq 'main_loop') { die("Internal psh error."); }
		}
	}
}


#
# array evl(string LINE, [array STRATEGIES])
#
# evaluate a single logical "line" of input (which may have been built
# up from several actual lines by the process loop). This function
# simply calls std_tokenize on LINE, and then tries the evaluation
# strategies in @psh::strategies in order. If no strategy matches, it
# prints an error message. If some strategy does match, it calls the
# evaluation function for that strategy and returns its value. If the
# STRATEGIES argument is supplied, it overrides @psh::strategies.
#

sub evl 
{
	my ($line, @use_strats) = @_;
	my @words = Psh::Parser::std_tokenize($line);

	if (!defined(@use_strats) or scalar(@use_strats) == 0) {
		@use_strats = @strategies;
	}

	my $qSucceeded = 0;
	my @result;

	for my $strat (@use_strats) {
		if (!defined($psh::strategy_which{$strat})) {
			print_warning("$bin: WARNING: unknown strategy '$strat'.\n");
			next;
		}

		my $how = &{$psh::strategy_which{$strat}}(\$line,\@words);

		if ($how) {
			print_debug("Using strategy $strat by $how\n");
			eval {
				@result = &{$psh::strategy_eval{$strat}}(\$line,\@words,$how);
			};

			handle_message($@, $strat);
			$qSucceeded = 1;

			last;
		}
	}

	if (!$qSucceeded) {
		print_error("Can't determine how to evaluate '$line'.\n");
		return undef;
	}

	return @result;
}


#
# string read_until(string TERMINATOR, subr GET)
#
# Get successive lines via calls to GET until one of those
# entire lines matches the patterm TERMINATOR. Used to implement
# the `<<EOF` multiline quoting construct and brace matching;
#
# TODO: Undo any side effects of, e.g., m//.
#

sub read_until
{
	my ($terminator, $get) = @_;
	my $input;
	my $temp;

	$input = '';

	while (1) {
		$temp = &$get();
		last unless defined($temp);
		last if $temp =~ m/^$terminator$/;
		$input .= $temp;
	}

	return $input;
}

# string read_until_complete(string SO_FAR, subr GET)
#
# Get successive lines via calls to GET until the cumulative input so
# far is not an incomplete expression according to
# incomplete_expr. 
#
# TODO: Undo any side effects of, e.g., m//.
#

sub read_until_complete
{
	my ($sofar, $get) = @_;
	my $temp;

	while (1) {
		$temp = &$get();
		if (!defined($temp)) {
		       print_error("End of input during incomplete expression $sofar");
			   last;
		}
		$sofar .= $temp;
		last if Psh::Parser::incomplete_expr($sofar) <= 0;
	}

	return $sofar;
}


#
# void process(bool PROMPT, subr GET)
#
# Process lines produced by the subroutine reference GET until it
# returns undef. GET must be a reference to a subroutine which takes a
# string argument (the prompt, which may be empty) and returns the
# next line of input, or undef if there is none.
#
# Any output generated is handled by the various print_xxx routines
#
# The prompt is printed only if the PROMPT argument is true.  When
# sourcing files (like .pshrc), it is important to not print the
# prompt string, but for interactive use, it is important to print it.
#
# TODO: Undo any side effects, e.g. done by m//.
#

sub process
{
	my ($prompt, $get) = @_;
	local $cmd;

	while (1) {
		if ($prompt) {
			$input = &$get(prompt_string());
		} else {
			$input = &$get();
		}

		reap_children(); # Check wether we have dead children

		$cmd++;

		last unless defined($input);

		if ($input =~ m/^\s*$/) { next; }
		if ($input =~ m/<<([a-zA-Z_0-9\-]*)/) {
			my $terminator = $1;
			$input .= read_until($terminator, $get);
			$input .= "$terminator\n";
		} elsif (Psh::Parser::incomplete_expr($input) > 0) {
			$input = read_until_complete($input, $get);
		}

		chomp $input;
		
		my @result = evl($input);

		my $qEcho = 0;

		if (ref($echo) eq 'CODE') {
			$qEcho = &$echo(@result);
		} elsif (ref($echo)) {
			print_warning("$bin: WARNING: \$psh::echo is neither a SCALAR nor a CODE reference.\n");
		} else {
			if ($echo) { $qEcho = defined_and_nonempty(@result); }
		}

		if ($qEcho) {
			if (scalar(@result) > 1) {
				my $n = scalar(@val);
				push @val, \@result;
				print_out("\$psh::val[$n] <- [", join(',',@result), "]\n");
			} else {
				my $n = scalar(@val);
				my $res = $result[0];
				push @val, $res;
				print_out("\$psh::val[$n] <- $res\n");
			}
		}
	}
}


#
# bool defined_and_nonempty(args)
#
# returns true if it has any defined, nonempty args
#

sub defined_and_nonempty
{
	if (!defined(@_))    { return 0; }
	if (scalar(@_) == 0) { return 0; }

	if (scalar(@_) == 1) {
		if (!defined($_[0])) { return 0; }
		if ($_[0] eq '')     { return 0; }

		return 1;
	}

	return 1; # multiple args always true
}


#
# void process_file(string FILENAME)
#
# process() the lines of FILENAME
#

sub process_file
{
	my ($path) = @_;

	print_debug("[[PROCESSING FILE $path]]\n");

	if (!-r $path) {
		print_error("$bin: Cannot read script `$path'\n");
		return;
	}
	
	my $pfh = new FileHandle($path,'r');

	if (!$pfh) {
		print_error("$bin: Cannot open script `$path'\n");
		return;
	}

	process(0, sub { return <$pfh>; }); # don't prompt

	$pfh->close();

	print_debug("[[FINISHED PROCESSING FILE $path]]\n");
}


#
# string prompt_string()
#
# Construct a prompt string.
#
# TODO: Should we have an entry for '\'?
#

%prompt_vars = (
	'd' => sub {
			my ($wday, $mon, $mday) = (localtime)[6, 4, 3];
			$wday = $wday[$wday];
			$mon  = $mon[$mon];
			return "$wday $mon $mday";
		},
	'h' => sub { return $host; },
	'H' => sub { return $longhost; },
	's' => sub {
			my $shell = $bin;
			$shell =~ s/^.*\///;
			return $shell;
		},
	'n' => sub { return "\n"; },
	't' => sub {
			my ($hour, $min, $sec) = (localtime)[2, 1, 0];
			return sprintf("%02d:%02d:%02d", $hour, $min, $sec);
		},
	'u' => sub {
			# Camel, 2e, p. 172: 'getlogin'.
			return getlogin || (getpwuid($>))[0] || "uid$>";
		},
	'w' => sub { return cwd; },
	'W' => sub { my $dir = cwd; $dir =~ s/^.*\///; return $dir },
	'#' => sub { return $cmd; },
	'$' => sub { return ($> ? '$' : '#'); }
);

sub prompt_string
{
	my $temp;

	#
	# First, get the prompt string from a subroutine or from the default:
	#

	if (ref($prompt) eq 'CODE') { # If it is a subroutine,
		$temp = &$prompt();
	} elsif (ref($prompt)) {      # If it isn't a scalar
		print_warning("$bin: Warning: \$psh::prompt is neither a SCALAR nor a CODE reference.\n");
		$temp = $default_prompt;
	} else {
		$temp = $prompt;
	}

	#
	# Now, subject it to substitutions:
    #
	# There are two kinds of escapes: (1) Single (non-digit) character, and (2) one or more
	# digits. The former are looked up in %prompt_vars, and the latter are mapped to ascii
	# characters.
	#

	while ($temp =~ m/^(.*)\\([0-9]+|[^0-9])(.*)$/) {
		my $sub;

		my ($save1, $code, $save2) = ($1, $2, $3);
		my $var = $prompt_vars{$code};

		if (ref $var eq 'CODE') {
			$sub = &$var();
 		} elsif($code =~ /[0-9]+/) {
 			# I want my colour prompt back!
 			if ($code =~ /^0/) { $sub = chr(oct($code)); }
 			else               { $sub = chr(hex($code)); }

		} else {
			print_warning("$bin: Warning: \$psh::prompt (`$temp') contains unknown escape sequence `\\$code'.\n");
			$sub = ''
		}

		{
			local $1;
			if ($sub =~ m/\\(.)/) {
				print_warning("$bin: Warning: Expansion of `\\$code' in prompt string yielded\n",
					  "     string containing `$1'. Stripping escape sequences from\n",
					  "     substitution.\n");
				$sub =~ s/\\(.)//g;
			}
		}

		$temp = $save1 . $sub . $save2
	}

	return $temp;
}


#
# readline_handler()
#
# Readline ^C handler.
#

sub readline_handler
{
	my $sig= shift;
    die "SECRET $bin: Signal $sig\n"; # changed to SECRET... just in case
}


#
# string iget(string PROMPT)
#
# Interactive line getting routine. If we have a
# Term::ReadLine instance, use it and record the
# input into the history buffer. Otherwise, just
# grab an input line from STDIN.
#
# readline() returns a line WITHOUT a "\n" at the
# end, and <STDIN> returns one WITH a "\n", UNLESS
# the end of the input stream occurs after a non-
# newline character. So, first we chomp() the
# output of <STDIN> (if we aren't using readline()),
# and then we tack the newline back on in both
# cases. Other code later strips it off if necessary.
#
# iget() uses PROMPT as the prompt; this may be the empty string if no
# prompting is necessary.
#
# TODO: Handle ^D nicely (i.e. allow log out or at least print "\n";)
#

sub iget
{
	my $prompt = shift;
	my $line;
	my $sigint = 0;

	local $SIG{'INT'}=\&readline_handler;
 
	do {
		if ($sigint) {
			print_out_i18n('readline_interrupted');
			$sigint=0;
		}
		# Trap ^C in an eval.  The sighandler will die which will be
		# trapped.  Then we reprompt
		if ($term) {
			eval { $line = $term->readline($prompt); } # trap ^C which will die;
		} else {
			eval {
				print $prompt;
				$line = <STDIN>;
			}
		}
		if ($@) { $sigint=1; }
	} while ($sigint);

	chomp $line;

# [ gtw: Why monkey with the input? If we take out whitespace now,
#   we'll never know if it was there. Better wait.
# ]

#	$line =~ s/^\s+//;
#	$line =~ s/\s+$//;

	if ($term and $line !~ m/^\s*$/) {
               $term->addhistory($line); 

		if ($save_history && !$readline_saves_history) {
		  my $fhist = new FileHandle($psh::history_file, 'a');
		  $fhist->print("$line\n");
		  $fhist->close();
		}
	}

	return $line . "\n";         # This is expected by other code.
}


#
# string news()
#
# Return the news

sub news 
{
	if (-r $news_file) {
		return `cat $news_file`;
	} else {
		return '';
	}
}


#
# void minimal_initialize()
#
# Initialize just enough to be able to read the .pshrc file; leave
# uncritical user-accessible variables until later in case the user
# sets them in .pshrc.

sub minimal_initialize
{
	$|                           = 1;                # Set ouput autoflush on

	#
    # Set up accessible psh:: package variables:
	#

    @strategies                  = @default_strategies;
	$eval_preamble               = 'package main;';
    $currently_active            = 0;
	$perlfunc_expand_arguments   = 0;
	$executable_expand_arguments = 0;
	$cmd                         = 1;

	$bin                         = $0;
	$bin                         =~ s/.*\///;

	$news_file                   = "$bin.NEWS";

	%built_ins = (
		      '.'        => \&builtin_source,
		      'alias'    => \&builtin_alias,
		      'bg'       => \&builtin_bg,
		      'cd'       => \&builtin_cd,
		      'exit'     => \&builtin_exit,
		      'fg'       => \&builtin_fg,
		      'jobs'     => \&builtin_jobs,
		      'kill'     => \&builtin_kill,
		      'readline' => \&builtin_readline,
		      'which'    => \&builtin_which,
		      'source'   => \&builtin_source,
			  'setenv'   => \&builtin_setenv,
			  'export'   => \&builtin_export
	);

	# We define these variables here so the user can easily add
	# to them with a push in her .pshrc file or delete them or
	# whatever
	@bookmarks=('http://','ftp://');
	@netprograms=('ping','ssh','telnet','ftp','ncftp','traceroute',
					  'netscape','lynx','mozilla','wget');
	%array_exports=('PATH'=>':','CLASSPATH'=>':','LD_LIBRARY_PATH'=>':');


	# The following accessible variables are undef during the
	# .pshrc file:
	undef $prompt;
	undef $save_history;
	undef $history_length;
	undef $longhost;
	undef $host;
	undef $history_file;

	$joblist= new Psh::Joblist();

	@val = ();

	&Psh::Locale::Base::init;
}

#
# void finish_initialize()
#
# Set the remaining psh:: package variables if they haven't been set
# in the .pshrc file, and do other "late" initialization steps that
# depend on these variable values.

sub finish_initialize
{
	$SIG{SEGV} = \&error_handler       if $psh::handle_segfaults;

	$prompt          = $default_prompt if !defined($prompt);
	$save_history    = 1               if !defined($save_history);
	$history_length  = 50              if !defined($history_length);
	if (!defined($longhost)) {
		$longhost                    = qx(hostname);
		chomp $longhost;
	}
	if (!defined($host)) {
		$host                        = qx(hostname -s);
		chomp $host;
	}
	if (!defined($history_file)) {
		$history_file                = "$ENV{HOME}/.${bin}_history";
	}


    #
    # Set up Term::ReadLine:
    #
	eval "use Term::ReadLine;";

	if ($@) {
		$term = undef;
		print_error_i18n(no_readline);
	} else {
		$term = Term::ReadLine->new('psh');
		$term->MinLine(10000);   # We will handle history adding
		# ourselves (undef causes trouble). 
		$term->ornaments(0);
		print_debug("Using ReadLine: ", $term->ReadLine(), "\n");
		if ($term->ReadLine() eq "Term::ReadLine::Gnu") {
			$readline_saves_history = 1;
			$term->StifleHistory($history_length); # Limit history
		}
		&Psh::Completion::init($term, \@absed_path);
		$term->Attribs->{completion_function} =
			\&Psh::Completion::custom_completion;

	}

    #
    # Set up Term::Size:
    #
	eval "use Term::Size 'chars'";

	if ($@) {
		print_debug("Term::Size not available. Trying Term::ReadKey\n");   
		eval "use Term::ReadKey";
		if( $@) {
			print_debug("Term::ReadKey not available - no resize handling!\n");
		}
	}
	else    { print_debug("Using &Term::Size::chars().\n"); }


	if (defined($term) and $save_history) {
		if ($readline_saves_history) {
			$term->ReadHistory($psh::history_file);
		} else {
			my $fhist = new FileHandle($psh::history_file);
			if ($fhist) {
				while (<$fhist>) {
					chomp;
					$term->addhistory($_);
				}
				$fhist->close();
			}
		}
	}
}


#
# void process_rc()
#
# Search for and process .pshrc files.
#

sub process_rc
{
	my @rc;
	my $rc_name = ".pshrc";

	print_debug("[ LOOKING FOR .pshrc ]\n");

	if ($opt{'r'}) {
		push @rc, $opt{'r'};
	} else {
		if ($ENV{HOME}) { push @rc, "$ENV{HOME}/$rc_name"; }
		push @rc, "$rc_name" unless $ENV{HOME} eq cwd;
	}

	foreach my $rc (@rc) {
		if (-r $rc) {
			print_debug("[ PROCESSING $rc ]\n");
			process_file($rc);
		}
	}
}


#
# void process_args()
#
# Process files listed on command-line.
#

sub process_args
{
	print_debug("[ PROCESSING @ARGV FILES ]\n");

	foreach my $arg (@ARGV) {
		if (-r $arg) {
			print_debug("[ PROCESSING $arg ]\n");
			process_file($arg);
		}
	}
}


#
# void main_loop()
#
# Determine whether or not we are operating interactively,
# set up the input routine accordingly, and process the
# input.
#

sub main_loop
{
	my $interactive = (-t STDIN) and (-t STDOUT);
	my $get;

	print_debug("[[STARTING MAIN LOOP]]\n");

	if ($interactive) { $get = \&iget;                  }
	else              { $get = sub { return <STDIN>; }; }

	process($interactive, $get);
}

# bool is_number(ARG)
#
# Return true if ARG is a number
#

sub is_number
{
	my $test = shift;
	return defined($test) && $test &&
		$test=~/^([+-]?)(?=\d|\.\d)\d*(\.\d*)?([Ee]([+-]?\d+))?$/o;
}

sub print_warning
{
	print STDERR @_;
}

sub print_debug
{
	print STDERR @_ if $debugging;
}

sub print_error
{
	print STDERR @_;
}

#
# print_i18n( stream, key, args)
# print_out_i18n( key, args)
# print_error_i18n( key, args)
#
# The print..._i18n suite of functions will fetch the
# text from the %text hash, replace %1 with the first arg,
# %2 with the second and so on and then print it out
#

sub print_i18n
{
	my( $stream, $text, @rest) = @_;
	$text= $psh::text{$text};
	# This was looping over 0 and 1 and replacing %0 and %1
	for( my $i=1; $i<=@rest; $i++)
	{
		$text=~ s/\%$i/$rest[$i-1]/g; # removed o from flags huggie
	}
	print $stream $text;
}


sub print_error_i18n
{
	print_i18n(STDERR,@_);
}

sub print_out_i18n
{
	print_i18n(STDOUT,@_);
}

sub print_out
{
	print STDOUT @_;
}


#
# void symbols()
#
# Print out the symbols of each type used by a package. Note: in testing,
# it bears out that the filehandles are present as scalars, and that arrays
# are also present as scalars. The former is not particularly surprising,
# since they are implemented as tied objects. But, use vars qw(@X) causes
# both @X and $X to show up in this display. This remains mysterious.
#

sub symbols
{
	my $pack = shift;
	my (@ref, @scalar, @array, @hash, @code, @glob, @handle);
	my @sym;

	{
		no strict qw(refs);
		@sym = keys %{*{"${pack}::"}};
	}

	for my $sym (sort @sym) {
		next unless $sym =~ m/^[a-zA-Z]/; # Skip some special variables
		next if     $sym =~ m/::$/;       # Skip all package hashes

		{
			no strict qw(refs);

			push @ref,    "\$$sym" if ref *{"${pack}::$sym"}{SCALAR} eq 'REF';
			push @scalar, "\$$sym" if ref *{"${pack}::$sym"}{SCALAR} eq 'SCALAR';
			push @array,  "\@$sym" if ref *{"${pack}::$sym"}{ARRAY}  eq 'ARRAY';
			push @hash,   "\%$sym" if ref *{"${pack}::$sym"}{HASH}   eq 'HASH';
			push @code,   "\&$sym" if ref *{"${pack}::$sym"}{CODE}   eq 'CODE';
#			push @glob,   "\*$sym" if ref *{"${pack}::$sym"}{GLOB}   eq 'GLOB';
			push @handle, "$sym"   if ref *{"${pack}::$sym"}{FILEHANDLE};
		}
	}

	print_out("Reference: ", join(' ', @ref),    "\n");
	print_out("Scalar:    ", join(' ', @scalar), "\n");
	print_out("Array:     ", join(' ', @array),  "\n");
	print_out("Hash:      ", join(' ', @hash),   "\n");
	print_out("Code:      ", join(' ', @code),   "\n");
#	print_out("Glob:      ", join(' ', @glob),   "\n");
	print_out("Handle:    ", join(' ', @handle), "\n");
}



##############################################################################
##############################################################################
##
## SUBROUTINES: Signal Handlers
##
##############################################################################
##############################################################################



#
# void signal_handler( string SIGNAL )
#

sub signal_handler
{
	my ($sig) = @_;
	
	if ($psh::currently_active > 0) {
		print_debug("Received signal SIG$sig, sending to $psh::currently_active\n");

		kill $sig, $psh::currently_active;
	} elsif ($currently_active < 0) {
		print_debug("Received signal SIG$sig, sending to Perl code\n");

		die "SECRET $bin: Signal $sig\n";
	} else {
		print_debug("Received signal SIG$sig, die-ing\n");
	}

	$SIG{$sig} = \&signal_handler;
}


#
# ignore_handler()
#
# From Markus: Apparently letting a signal execute an empty sub is not the same
# as setting the sighandler to IGNORE
#

sub ignore_handler
{
	my ($sig) = @_;
	$SIG{$sig} = \&ignore_handler;
}


sub error_handler
{
	my ($sig) = @_;
	print_error("Received SIG$sig - ignoring\n");
	$SIG{$sig} = \&error_handler;
	kill 'INT',getpid(); # HACK to stop a possible endless loop!
}

#
# resize_handler()
#

sub resize_handler
{
	my ($sig) = @_;
	my ($cols, $rows) = (0, 0);

	eval {
		($cols,$rows)= &Term::Size::chars();
	};

	unless( $cols) {
		eval {
			($cols,$rows)= &Term::ReadKey::GetTerminalSize(STDOUT);
		};
	}


# I do not really want to active this before I know more about
# where this will work
#
#  	unless( $cols) {
#  		#
#  		# Portability alarm!! :-)
#  		#
#  		eval 'use "ioctl.ph';
#  		eval 'use "sys/ioctl.ph';
#  		eval 'use "sgtty.ph';
#		
#  		eval {
#  			my $TIOCGWINSZ = &TIOCGWINSZ if defined(&TIOCGWINSZ);
#  			my $TIOCGWINSZ = 0x40087468 if !defined($TIOCGWINSZ);
#  			my $winsz_t="S S S S";
#  			my $winsize= pack($winsz_t,0,0,0,0);
#  			if( ioctl(STDIN,$TIOCGWINSZ,$winsize)) {
#  				($rows,$cols)= unpack("S S S S",$winsize);
#  			}
#  		}
#  	}

	if(($cols > 0) && ($rows > 0)) {
		$ENV{COLUMNS} = $cols;
		$ENV{LINES}   = $rows;
	}

	$SIG{$sig} = \&resize_handler;
}



##############################################################################
##############################################################################
##
## SUBROUTINES: Support
##
##############################################################################
##############################################################################

#
# void fork_process( code, int fgflag)
#

sub fork_process {
	local( $psh::code, $psh::fgflag, $psh::string) = @_;
	local $psh::pid;

	unless ($psh::pid = fork) { #child
		open(STDIN,"-");
		open(STDOUT,">-");
		open(STDERR,">&STDERR");
		remove_signal_handlers();
		setpgid(getpid(),getpid());
		give_terminal_to(getpid()) if $psh::fgflag;
		&{$psh::code};
	}
	setpgid($psh::pid,$psh::pid);
	local $psh::job= $joblist->create_job($psh::pid,$psh::string);
	if( !$psh::fgflag) {
		my $visindex= $joblist->get_job_number($psh::job->{pid});
		print_out("[$visindex] Background $psh::pid $psh::string\n");
	}
	wait_for_system($psh::pid, 1) if $psh::fgflag;
}

#
# void my_system(string COMMAND_LINE)
#
# Executes COMMAND_LINE via system, noticing and stripping final '&'
# to allow jobcontrol
#

sub my_system
{
	my($call) = @_;

	#
	# TODO: This is an absolute hack... we need
	# a full parser for quoting and all special
	# characters soon!!
	#
	# Well, Psh::Parser::decompose is pretty flexible now; perhaps
	# this function ought to be modified to take the fgflag as a
	# parameter, and the calls changed to have done the parsing
	# already, passing only the actyal string to be exec'ed and
	# the fgflag. Just one way maybe to skin the cat...

	my $fgflag = 1;

	if ($call =~ /^(.*)\&\s*$/) {
		$call= $1;
		$fgflag=0;
	}

	fork_process( sub {
		exec $call;
		print_error_i18n(`exec_failed`,$call);
		exit -1;
	}, $fgflag, $call);
}


#
# void wait_for_system(int PID, [bool QUIET_EXIT])
#
# Waits for a program to be stopped/ended, prints no message on normal
# termination if QUIET_EXIT is specified and true.
#

sub wait_for_system
{
	my($pid, $quiet) = @_;
        if (!defined($quiet)) { $quiet = 0; }

	my $psh_pgrp = getpgrp;

	my $pid_status = -1;

	my $job= $joblist->get_job($pid);

	while (1) {
	  print_debug("[[About to give the terminal to $pid.]]\n");
	  give_terminal_to($pid);
	  #
	  # TODO: Is the following line necessary? Should we check to
	  # make sure te job exists after we do it? This is tricky
	  # stuff.
	  #
	  if (!$job->{running}) { $job->continue; }
	  my $returnpid;
	  {
	    local $psh::currently_active = $pid;
	    $returnpid = waitpid($pid, &WUNTRACED);
	    $pid_status = $?;
	  }
	  give_terminal_to($psh_pgrp);
	  print_debug("[[Just gave myself back the terminal. $pid $returnpid $pid_status]]\n");
	  handle_wait_status($returnpid, $pid_status, $quiet);
	  if ($returnpid == $pid) { last; }
	}
}

#
# void handle_wait_status(int PID, int STATUS, bool QUIET_EXIT)
#
# Take the appropriate action given that waiting on PID returned
# STATUS. Normal termination is not reported if QUIET_EXIT is true.
#

sub handle_wait_status {
	my ($pid, $pid_status, $quiet) = @_;
	# Have to obtain these before we potentially delete the job
	my $job= $joblist->get_job($pid);
	my $command = $job->{call};
	my $visindex= $joblist->get_job_number($pid);
	my $verb='';
  
	if (&WIFEXITED($pid_status)) {
		$verb= "\u$text{done}" if (!$quiet);
		$joblist->delete_job($pid);
	} elsif (&WIFSIGNALED($pid_status)) {
		$verb = "\u$text{terminated} (" .
			signal_description(WTERMSIG($pid_status)) . ')';
		$joblist->delete_job($pid);
	} elsif (&WIFSTOPPED($pid_status)) {
		$verb = "\u$text{stopped} (" .
			signal_description(WSTOPSIG($pid_status)) . ')';
		$job->{running}= 0;
	}
	if ($verb) {
		print_out( "[$visindex] $verb $pid $command\n");
	}
}


#
# void reap_children()
#
# Checks wether any children we spawned died
#

sub reap_children
{
	my $returnpid=0;
	while (($returnpid = waitpid(-1, &WNOHANG | &WUNTRACED)) > 0) {
		handle_wait_status($returnpid, $?);
	}
}

#
# void restart_job(bool FOREGROUND, int JOB_INDEX)
#
sub restart_job
{
	my ($fg_flag, $job_to_start) = @_;

	my $job= $joblist->find_job($job_to_start);

	if(defined($job)) {
		my $pid = $job->{pid};
		my $command = $job->{call};

		if ($command) {
			my $verb = "\u$text{restart}";
			my $qRunning = $job->{running};
			if ($fg_flag) {
			  $verb = "\u$text{foreground}";
			} elsif ($qRunning) {
			  # bg request, and it's already running:
			  return;
			}
			my $visindex = $joblist->get_job_number($pid);
			print_out("[$visindex] $verb $pid $command\n");

			if($fg_flag) {
				eval { wait_for_system($pid, 0); };
			} elsif( !$qRunning) {
				$job->continue;
			}
		}
	}
}

##############################################################################
##############################################################################
##
## MAIN:
##
##############################################################################
##############################################################################



minimal_initialize;
process_rc;
finish_initialize;

# TODO: Is this implementation equivalent to sh's ?
if($opt{'c'}) {
	evl($opt{'c'});
	exit 0;
}



if (@ARGV) {
	process_args;
} else {
	while (1) {
		eval { main_loop; };
		handle_message($@,'main_loop');
    }
}

exit 0;


#
# End of file.
#

# The following is for Emacs - I hope it won't annoy anyone
# but this could solve the problems with different tab widths etc
#
# Local Variables:
# tab-width:4
# indent-tabs-mode:t
# c-basic-offset:4
# End:

