#!/usr/bin/perl -w use strict; my $obj = PSH->new; $obj->cmdloop; package PSH; use base qw(Term::Shell); use Data::Dumper; use Cwd; sub precmd { my $o = shift; my $hnd = shift; my $cmd = shift; my $args = shift; @$args = expand(@$args); } sub expand { for (@_) { $_ =~ s[^~][$ENV{HOME}]; $_ =~ s[\$([_A-Za-z0-9]+)][$ENV{$1} || '']eg; } @_; } sub prompt_str { my $cwd = cwd; $cwd =~ s[^\Q$ENV{HOME}\E][~]; "psh:$cwd> " } sub smry_eval { "how to evaluate Perl code" } sub help_eval { <<'END'; You can evaluate snippets of Perl code just by putting them on a line beginning with !: psh:~> ! print "$_\n" for keys %ENV END } #============================================================================= # External commands #============================================================================= { my $eval_num = "000001"; sub catch_run { my ($o, $command, @args) = @_; # Evaluate perl code if it's a ! line. if ($command =~ s/^!//) { (my $code = $o->line) =~ s/^!//; my $really_long_string = <<END; package PSH::namespace_$eval_num; { no strict; eval "no warnings"; local \$^W = 0; $code; } END { local *_; my ($eval_num, $o, $command, @args, $code); eval $really_long_string; } print "$@\n" if $@; $eval_num++; } # Real external commands. else { system($command, @args); } } } sub catch_comp { my ($o, $action, $word, $line, $start) = @_; # Complete environment variables (not working) if ($word =~ /^\$/) { return $o->completions($word, [keys %ENV]); } my @files = glob("$word*"); return $o->completions($word, \@files); } sub comp_ { my ($o, $word, $line, $start) = @_; my @exes; use Config; for my $part (split /\Q$Config{path_sep}\E/, $ENV{PATH}) { next unless -d $part; opendir (PART, $part) or die "can't opendir $part: $!"; while (my $entry = readdir(PART)) { my $file = "$part/$entry"; push @exes, $entry if -f $file and -x $file; } closedir (PART) or die "can't closedir $part: $!"; } my @comp = grep { length($_) } $o->possible_actions($word, 'run', 1); push @comp, $o->completions($word, \@exes); @comp = sort @comp; @comp; } #============================================================================= # Shell Builtins #============================================================================= sub smry_echo { 'output the args' } sub help_echo { <<'END'; echo: echo [arg ...] Output the args. END } sub run_echo { my ($o, @args) = @_; my @exp = expand(@args); defined $_ or $_ = '' for @exp; print "@exp\n" if @exp; } sub smry_set { 'set environment variables' } sub help_set { <<'END'; set: set [ name[=value] ... ] set lets you manipulate environment variables. You can view environment variables using 'set'. To view specific variables, use 'set name'. To set environment variables, use 'set foo=bar'. END } sub run_set { my ($o, @args) = @_; if (@args) { for my $arg (@args) { my ($key, $val) = split /=/, $arg; if (defined $val) { $ENV{$key} = $val; } else { $val = $ENV{$key} || ''; print "$key=$val\n"; } } } else { my ($key, $val); while(($key, $val) = each %ENV) { print "$key=$val\n"; } } } sub smry_cd { 'change working directory' } sub help_cd { <<'END'; cd: cd [dir] Change the current directory to DIR. The variable $HOME is the default DIR. END } sub run_cd { my ($o, $dir) = @_; $dir = $ENV{HOME} unless defined $dir; chdir $dir or do { print "$0: $dir: $!\n"; return; }; $ENV{PWD} = $dir; } __END__ # Not working yet... sub smry_alias { 'view or set command aliases' } sub help_alias { <<'END'; alias: [ name[=value] ... ] 'alias' with no arguments prints the list of aliases in the form NAME=VALUE on standard output. An alias is defined for each NAME whose VALUE is given. END } sub run_alias { my $o = shift; if (@_) { for my $a (@_) { my ($key, $val) = split /=/, $a; if (defined $val) { $o->{SHELL}{alias}{$key} = $val; } else { $val = $o->{SHELL}{alias}{$key}; print "alias $key=$val\n" if defined $val; print "alias: `$key' not found\n" if not defined $val; } } } else { my ($key, $val); while (($key, $val) = each %{$o->{SHELL}{alias}}) { print "alias $key=$val\n"; } } }