##############################################################################
##############################################################################
##############################################################################
##############################################################################
# Private, Lexical Variables:
my ($input,$readline_saves_history);
##############################################################################
##############################################################################
## SUBROUTINES: Command-line processing
##############################################################################
##############################################################################
# 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.
my ($message, $from) = @_;
if (!defined($from)) { $from = 'eval'; }
return if ($from eq 'hide');
if ($message =~ m/^SECRET $Psh::bin:(.*)$/s) {
if ($from ne 'main_loop') { Psh::Util::print_out("$1\n"); }
Psh::Util::print_error("$from error ($message)!\n");
if ($from eq 'main_loop') {
if( Psh::Options::get_option('ignoredie')) {
Psh::Util::print_error_i18n('internal_error');
die("Internal psh error.");
my ($line, @use_strats) = @_;
local @Psh::temp_use_strats;
push @Psh::temp_use_strats, @use_strats if @use_strats;
return ($Psh::last_success_code, @Psh::last_result);
my $trace= Psh::Options::get_option('trace');
while( my $element= shift @elements) {
if ($type == Psh::Parser::T_EXECUTE()) {
for (my $i=1; $i<@tmp; $i++) {
print STDERR "+ $tmp[$i][4]\n";
@result= Psh::OS::execute_complex_command(\@tmp);
} elsif ($type == Psh::Parser::T_OR()) {
return @result if @result and $result[0]; # we already had success
} elsif ($type == Psh::Parser::T_AND()) {
return (0) unless @result;
next if ($result[0]); # we last had success
Psh::Util::print_error("evl: Don't know type $type\n");
# string read_until(PROMPT_TEMPL, 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//.
my ($prompt_templ, $terminator, $get) = @_;
$temp = $prompt_templ?&$get(Psh::Prompt::prompt_string($prompt_templ),
1,\&Psh::Prompt::pre_prompt_hook):
Psh::Util::print_error_i18n('input_incomplete',join('',@input),$Psh::bin);
last if $temp =~ m/^$terminator$/;
# string read_until_complete(PROMPT_TEMPL, 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. Prompting is done with PROMPT_TEMPL.
my ($prompt_templ, $sofar, $get) = @_;
&$get(Psh::Prompt::prompt_string($prompt_templ),1,
\&Psh::Prompt::pre_prompt_hook):
Psh::Util::print_error_i18n('input_incomplete',$sofar,$Psh::bin);
last if Psh::Parser::incomplete_expr($sofar) <= 0;
# void process(bool Q_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 Q_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//.
my ($q_prompt, $get) = @_;
my $last_result_array = '';
my $result_array_ref = \@Psh::val;
my $result_array_name = 'Psh::val';
$input = &$get(Psh::Prompt::prompt_string(Psh::Prompt::normal_prompt()), 0, \&Psh::Prompt::pre_prompt_hook);
Psh::OS::reap_children(); # Check wether we have dead children
Psh::OS::check_terminal_size() if $Psh::interactive;
unless (defined($input)) {
last unless $Psh::interactive;
my $control_d_max=$ENV{IGNOREEOF}||0;
if ($control_d_max !~ /^\d$/) {
Psh::OS::exit_psh() if ($control_d_counter>=$control_d_max);
next if $input=~ m/^\s*$/;
if ($input =~ m/(.*)<<([a-zA-Z_0-9\-]*)(.*)/) {
my $continuation = $q_prompt ? Psh::Prompt::continue_prompt() : '';
$input = join('',$pre,'"',
read_until($continuation, $terminator, $get),
$terminator,'"',$post,"\n");
} elsif (Psh::Parser::incomplete_expr($input) > 0) {
my $continuation = $q_prompt ? Psh::Prompt::continue_prompt() : '';
$input = read_until_complete($continuation, $input, $get);
my @elements= eval { Psh::Parser::parse_line($input) };
Psh::Util::print_debug_class('e',"(evl) Error: $@") if $@;
($success,$result)= _evl(@elements);
Psh::Util::print_debug_class('s',"Success: $success\n");
$Psh::last_success_code= $success;
@Psh::last_result= @result= @$result;
undef $Psh::last_success_code;
next unless $Psh::interactive;
my $echo= Psh::Options::get_option('echo');
if (ref($echo) eq 'CODE') {
$qEcho = &$echo(@result);
Psh::Util::print_warning_i18n('psh_echo_wrong',$Psh::bin);
if ($echo) { $qEcho = defined_and_nonempty(@result); }
# Figure out where we'll save the result:
if ($last_result_array ne $Psh::result_array) {
$last_result_array = $Psh::result_array;
my $what = ref($last_result_array);
$result_array_ref = $last_result_array;
find_array_name($result_array_ref);
if (!defined($result_array_name)) {
$result_array_name = 'anonymous';
Psh::Util::print_warning_i18n('psh_result_array_wrong',$Psh::bin);
$result_array_ref = \@Psh::val;
$result_array_name = 'Psh::val';
} else { # Ordinary string
$result_array_name = $last_result_array;
$result_array_name =~ s/^\@//;
$result_array_ref = (Psh::PerlEval::protected_eval("\\\@$result_array_name"))[0];
if (scalar(@result) > 1) {
my $n = scalar(@{$result_array_ref});
push @{$result_array_ref}, \@result;
foreach my $val (@result) {
push @printresult,qq['$val'];
push @printresult,qq[undef];
Psh::Util::print_out("\$$result_array_name\[$n] = [", join(',',@printresult), "]\n");
my $n = scalar(@{$result_array_ref});
push @{$result_array_ref}, $res;
Psh::Util::print_out("\$$result_array_name\[$n] = \"$res\"\n");
if (@{$result_array_ref}>100) {
shift @{$result_array_ref};
# string find_array_name ( arrayref REF, string PACKAGE )
# If REF is a reference to an array variable in the given PACKAGE or
# any of its subpackages, find the name of that variable and return
# it. PACKAGE defaults to main.
if (!defined($pack)) { $pack = "::"; }
for my $symb ( keys %{$pack} ) {
push @otherpacks, $symb unless ($pack eq 'main::' and $symb eq 'main::');
elsif (\@{"$pack$symb"} eq $arref) { return "$pack$symb"; }
for my $subpack (@otherpacks) {
my $ans = find_array_name($arref,"$pack$subpack");
if (defined($ans)) { return $ans; }
# bool defined_and_nonempty(args)
# returns true if it has any defined, nonempty args
if (!defined(@_)) { return 0; }
if (scalar(@_) == 0) { return 0; }
if (!defined($_[0])) { return 0; }
if ($_[0] eq '') { return 0; }
return 1; # multiple args always true
# void process_file(string FILENAME)
# process() the lines of FILENAME
Psh::Util::print_debug("[PROCESSING FILE $path]\n");
local $Psh::interactive=0;
Psh::Util::print_error_i18n('cannot_read_script',$path,$Psh::bin);
unless (open(FILE, "< $path")) {
Psh::Util::print_error_i18n('cannot_open_script',$path,$Psh::bin);
if ($Psh::debugging=~ /f/ or
$Psh::debugging eq '1') {
Psh::Util::print_debug_class('f',$txt);
process(0, sub { my $txt=<FILE>;$txt });
Psh::Util::print_debug("[FINISHED PROCESSING FILE $path]\n");
local $Psh::interactive=0;
if (ref $var eq 'ARRAY') {
@lines= split /\n/, $var;
@lines= map { $_."\n" } @lines;
process(0, sub { shift @lines });
# string iget(string PROMPT [, boolean returnflag [, code prompt_hook]])
# 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.
# If returnflag is true, iget will return after
# 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.
# Additional newline handling for prompts as Term::ReadLine::Perl
# cannot use them properly
if( $Psh::term->ReadLine eq 'Term::ReadLine::Perl' &&
$prompt=~ /^(.*\n)([^\n]+)$/) {
Psh::OS::setup_readline_handler();
# Trap ^C in an eval. The sighandler will die which will be
# trapped. Then we reprompt
&$prompt_hook if $prompt_hook;
print $prompt_pre if $prompt_pre;
eval { $line = $Psh::term->readline($prompt); };
&$prompt_hook if $prompt_hook;
print $prompt_pre if $prompt_pre;
print $prompt if $prompt;
if( $@ =~ /Signal INT/) {
Psh::Util::print_out_i18n('readline_interrupted');
Psh::OS::remove_readline_handler();
handle_message( $@, 'iget');
Psh::OS::remove_readline_handler();
Psh::OS::reinstall_resize_handler();
return undef unless defined $line;
return $line . "\n"; # This is expected by other code.
return if !$line or $line =~ /^\s*$/;
if (!@Psh::history || $Psh::history[$#Psh::history] ne $line) {
my $len= Psh::Options::get_option('histsize');
$Psh::term->addhistory($line) if $Psh::term;
push(@Psh::history, $line);
if( @Psh::history>$len) {
splice(@Psh::history,0,-$len);
return unless $Psh::term;
Psh::Util::print_debug_class('o',"[Saving history]\n");
if( Psh::Options::get_option('save_history')) {
my $file= Psh::Options::get_option('history_file');
if ($readline_saves_history) {
$Psh::term->StifleHistory(Psh::Options::get_option('histsize'));
$Psh::term->WriteHistory($file);
if (open(F_HISTORY,">> $file")) {
Psh::OS::lock(*F_HISTORY, Psh::OS::LOCK_EX());
foreach (@Psh::history) {
Psh::OS::unlock(*F_HISTORY);
# 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
$| = 1; # Set output autoflush on
# Set up accessible psh:: package variables:
$Psh::eval_preamble = '';
$Psh::currently_active = 0;
$Psh::which_regexp = '^[-a-zA-Z0-9_.~+]+$'; #'
$Psh::which_regexp= qr($Psh::which_regexp); # compile for speed reasons
Psh::Util::print_debug_class('e',"(minimal_init) Error: $@") if $@;
my @tmp= Psh::OS::splitdir($0);
Psh::Options::set_option('history_file',
Psh::OS::catfile(Psh::OS::get_home_dir(),
'.'.$Psh::bin.'_history'));
$Psh::old_shell = $ENV{SHELL} if $ENV{SHELL};
$ENV{OLDPWD}= $ENV{PWD} = Psh::OS::getcwd_psh();
Psh::OS::setup_signal_handlers();
# The following accessible variables are undef during the
Psh::Strategy::setup_defaults();
# 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.
Psh::OS::setup_sigsegv_handler() if
Psh::Options::get_option('ignoresegfault');
if (!defined($Psh::longhost)) {
$Psh::longhost = $ENV{HOSTNAME}||Psh::OS::get_hostname();
if (!defined($Psh::host)) {
$Psh::host= $Psh::longhost;
$Psh::host= $1 if( $Psh::longhost=~ /([^\.]+)\..*/);
$ENV{HOSTNAME}= $Psh::host;
sub initialize_interactive_mode {
eval { require Term::ReadLine; };
Psh::Util::print_error_i18n('no_readline');
eval { $Psh::term= Term::ReadLine->new('psh'); };
# Try one more time after a second, maybe the tty is
eval { $Psh::term= Term::ReadLine->new('psh'); };
Psh::Util::print_error_i18n('readline_error',$@);
$Psh::term->MinLine(10000); # We will handle history adding
# ourselves (undef causes trouble).
$Psh::term->ornaments(0);
Psh::Util::print_debug_class('i','[Using ReadLine: ', $Psh::term->ReadLine(), "]\n");
if ($Psh::term->ReadLine() eq 'Term::ReadLine::Gnu') {
$readline_saves_history = 1;
my $attribs= $Psh::term->Attribs;
$attribs->{completion_function} =
my $word_break=" \\\n\t\"&{}('`\$\%\@~<>=;|/";
$attribs->{special_prefixes}= "\$\%\@\~\&";
$attribs->{word_break_characters}= $word_break;
$attribs->{completer_word_break_characters}= $word_break ;
Psh::OS::install_resize_handler();
Psh::OS::reinstall_resize_handler();
# ReadLine objects often mess with the SIGWINCH handler
if (defined($Psh::term) and Psh::Options::get_option('save_history')) {
my $file= Psh::Options::get_option('history_file');
if ($readline_saves_history) {
$Psh::term->StifleHistory(Psh::Options::get_option('histsize'));
$Psh::term->ReadHistory($file);
if (open(F_HISTORY,"< $file")) {
Psh::OS::lock(*F_HISTORY);
$Psh::term->addhistory($_);
Psh::OS::unlock(*F_HISTORY);
# We're used for the first TAB completion - load
# the real completion module and call it
$Psh::term->Attribs->{completion_function} =
\&Psh::Completion::completion;
return Psh::Completion::completion(@_);
return unless $Psh::term;
if ($Psh::term->can('add_defun')) { # Term::ReadLine::Gnu
$Psh::term->add_defun('run-help', \&run_help);
$Psh::term->parse_and_bind("\"\eh\":run-help"); # bind to ESC-h
require Psh::Builtins::Help;
my $line= substr($Psh::term->Attribs->{line_buffer},0,
$Psh::term->Attribs->{end});
Psh::Builtins::Help::any_help($line);
# Search for and process .pshrc files.
push @rc, Psh::OS::get_rc_files();
Psh::Util::print_debug_class('i',"[PROCESSING $rc]\n");
# Process files listed on command-line.
Psh::Util::print_debug_class('i',"[PROCESSING @ARGV FILES]\n");
foreach my $arg (@ARGV) {
Psh::Util::print_debug('i',"[PROCESSING $arg]\n");
# Determine whether or not we are operating interactively,
# set up the input routine accordingly, and process the
my $interactive = (-t STDIN) and (-t STDOUT);
Psh::Util::print_debug_class('i',"[STARTING MAIN LOOP]\n");
if ($interactive) { $get = \&iget; }
else { $get = sub { return <STDIN>; }; }
process($interactive, $get);
# Return true if ARG is a number
return defined($test) && !ref($test) &&
$test=~/^([+-]?)(?=\d|\.\d)\d*(\.\d*)?([Ee]([+-]?\d+))?$/o;