Beefy Boxes and Bandwidth Generously Provided by pair Networks
The stupid question is the question not asked
 
PerlMonks  

psh (perl testing shell)

by jettero (Monsignor)
on May 11, 2006 at 18:16 UTC ( #548787=sourcecode: print w/ replies, xml ) Need Help??

Category: Utility Scripts
Author/Contact Info jettero
Description: I'm sorry to say, I've written another perl shell. This one is designed to help with the development of perl programs by giving you a place try things out. I've been using it to support my own coding for quite some time now and a friend encouraged me to publish it. I wrote this one to compete with hilfe specifically, though python and ruby have similar devices. UPDATE(2/14/08): This has evolved a bit since my original post May 11, 2006 at 14:16 EDT. UPDATE(8/28/8): More evolution. There is now support for paging in less, shell forks, config editing, and assorted perldoc forks.
#!/usr/bin/perl

use common::sense;
use utf8;
use Encode;
use Data::Dumper; $Data::Dumper::Indent = $Data::Dumper::Sortkeys = 1;
use Term::ReadLine;
use File::Slurp qw(slurp);

binmode STDIN,  ":utf8";
binmode STDOUT, ":utf8";

if( $ARGV[0] eq "-h" or $ARGV[0] eq "--help" ) { exec "perldoc", $0; e
+xit 900 }

my $term = new Term::ReadLine 'psh';
my $OUT  = $term->OUT || \*STDOUT;
my @s = ();

if( $ENV{TERM} =~ m/(?:xterm|)/ ) {
    local $| = 1;
    print "\e]0; PSH \x07";
}

*d = *Dumper;
eval 'use Data::Dump qw(dump)';
if( !$@ ) { *d = *dump; *Dumper = *dump; }

BEGIN {
    eval "use List::Util qw(first max maxstr min minstr reduce shuffle
+ sum)";
    eval "use Scalar::Util qw(blessed dualvar isweak readonly refaddr 
+reftype tainted weaken isvstring looks_like_number set_prototype);";
    eval "use Math::Units::PhysicalValue qw(PV)";
    unless( $@ ) {
        *pv = *PV;
        *p = *PV;
    }
}

$SIG{INT} = sub { exit 0 }; END { print "\n" }
$SIG{HUP} = sub { exit 0 };

print "Welcome to Paul's perl shell (type 'help' for documentation)\n"
+;
for my $file ("$ENV{HOME}/.pshrc") {
    if( -f $file and open my $n, $file ) {
        local $/; my $thefile = <$n>;

        no strict "vars";
        eval $thefile; 
        die "(while evaluating $file): $@" if $@;
    }
}

END {
    eval { # try it... don't freak out if it doesn't work
        $term->write_history("$ENV{HOME}/.psh_history");
    };
}

my $cmd  = 0;

eval { # try it, but don't freak out if it fails...
    my $file = "$ENV{HOME}/.psh_history";
    $term->history_truncate_file($file, 100);
    $term->read_history($file);
    print "[loaded ", int ($term->GetHistory), " command(s) from histo
+ry file]\n";
};

$SIG{INT} = sub { print "\n" };

print "\n";
$term->ornaments('', '', '', '');
our $PS1; $PS1 = "\\# psh> " unless $PS1;
while ( defined ($_ = $term->readline(sub_ps1_vars($PS1))) ) {
    s/^\s*//; s/\s*$//; s/[\r\n]//g;
  # s/\bs(\d+)/\$s[$1]/g;

    print "\r\e[2K"; # move to start of line and erase it

    $cmd ++;

    my $less_next_command = 0;

    if( m/^(?:q|e|quit|exit)\b/ ) {
        exit;

    } elsif( m/^\/?(?:hist|last)\s*(\d*)/ ) {
        my @hist = reverse $term->GetHistory;
        my $max = ($1>0 ? $1-1 : $#hist);

        for my $i ( reverse 0 .. $max ) {
            print "$i - $hist[$i]\n";
        }

    } elsif( m/^\/?less\s+(.+)/ ) {
        $_ = $1;
        $less_next_command = 1;
        goto EXECUTE_AFTER_TRANSFORM;

    } elsif( m/^\/?(?:help|h)/ ) {
        system("perldoc", $0);

    } elsif( $ENV{EDITOR} and $ENV{HOME} and m/^\/?(?:conf?i?g?u?r?a?t
+?i?o?n?)/ ) {
        system($ENV{EDITOR} => "$ENV{HOME}/.pshrc");

    } elsif( m/^\/?(?:doc|mod|m)\b\s*(.+)/ ) {
        system("perldoc", argparse($1));

    } elsif( m/^\s*'\s*(.+)/ and my $args = balanced_single_quotes($1)
+ ) {
        system(argparse($args));

    } elsif( m/^\/?(?:func|f)\b\s*(.+)/ ) {
        system("perldoc", "-f", argparse($1));

    } elsif( m/^\/?(?:s|l|stack|list)\b\s*(\d*)/ ) {
        my $max = ($1>0 ? $1-1 : $#s);

        for my $i ( reverse 0 .. $max ) {
            my $r = "";
            if( my $R = ref $s[$i] ) {
                $r = "\t\t[$R]";
            }
            print "s$i = $s[$i]$r\n";
        }

    } elsif( m/./ ) {
        EXECUTE_AFTER_TRANSFORM:

        my $less;
        my $ofh;
        if( $less_next_command ) {
            open $less, '|-', ($ENV{PAGER}||'less') or die "unable to 
+open ENV{PAGER}||less: $!";
            $ofh = select $less;
            $less_next_command = 0;
        }

        my $eval_line;
        my $val;
        my $dt;

            {
                my $__before = time;
                local $SIG{INT} = sub { die "interrupted\n"; };
                no strict "vars";
                $val = eval $_; $eval_line = __LINE__;
                $dt = time - $__before;
            }

        if( $dt > 1 ) {
            my $s = "";
               $s = "s" if $dt != 1;
            print "(dt=$dt second$s)\n";
        }

        if( $@ ) {
            if( $@ eq "interrupted\n" ) {
                warn "(operation interrupted with ^C)\n";

            } else {
                $@ =~ s/at \s*$0\s+line $eval_line//; # rare, but can 
+happen if the error uses caller() stuff
                $@ =~ s/at\s*\(eval\s*\d+\)/in command #$cmd/; # make 
+eval into command
                $@ =~ s/\s*line\s+\d+\.$//; # take the line off, it's 
+1
                warn "ERROR: $@\n";
            }

        } else {
            do_val( $val );

            my $res;
            if( ref $val and not blessed $val ) {
                local $Data::Dumper::Indent = 0;

                $res = Dumper($val);
                $res =~ s/\$VAR\d\s*=\s*//;

            } else {
                $res = $val;
            }

            $res =~ s/([^\n[:print:]])/sprintf('\x%02x', ord($1))/eg;

            print "\$s[0] = $res\n";
        }

        if( $less ) {
            select $ofh;
            close $less;
        }

        # this is actually automatic
        # $term->addhistory($_) if /\S/;
    }

    print "\n";
}

sub sub_ps1_vars {
    my $p = shift;

    $p =~ s/\\#/$cmd/eg;

    return $p;
}

sub do_val {
    my $v = shift;
    unshift @s, $v unless "$s[$#s]" eq "$v";
    pop @s while @s > 50;
}

sub argparse {
    my $args = shift;

    #TODO: handle quotes

    return split /\s+/, $args;
}

sub balanced_single_quotes {
    my $v = shift;
    my $cnt = () = $v =~ m/\'/g;

    return undef unless ($cnt/2) == int ($cnt/2);
    return $v;
}

__END__

=head1 NAME

psh -- yet another perl shell, complete with fun

=head1 SYNOPSIS

I wanted a hilfe (pike shell) or python shell like setup for
perl.  Because I designed the shell through actual use, I ended
up including a few handy shortcuts and commands.

=head1 THE STACK

Everything returned from expressions you type is dumped into the
stack (@s).  The most recent value is s0.  You can type the literal
's0' anywhere in an expression and psh will substitue '$s[0]'
(which also works).  You can similarly type 's15' for '$s[15]'.
The @s never grows bigger than 50.

You can view the stack with: 'list', 'l', 'stack', and 's'.
These commands take an optional number (e.g. 'l 10') argument to
limit the lines printed.

=head1 STRICTNESS

Your expressions are evaluated under 'use strict'; but also under
no strict 'vars'.  Warnings are not enabled, but you can 'use
warnings' in your .pshrc.

=head1 HISTORY

The history is nothing fancy.  I highly recommend installing
Term::ReadLine::Gnu, but that is a personal preference I suppose.

** However, your history will NOT save until you install it **

You can list your history with 'last'.  Presently there is no way
to actually execute something from history other than the obvious
arrow keys and/or vim keys (iff applicable).

=head1 COMPLETE COMMAND LIST

You can lead each command with a '/' if you desire.  Why would
you want to? IRC and TinyFugue habits?  The '/' is optional.

    last, hist        - show the history
    s, l, stack, list - show the stack
    config, conf      - edit your config (iff $ENV{EDITOR} set)
    less              - pipe the results to less, if found in path
    doc, mod, m       - fork of perldoc <something>
    func, f           - fork of perldoc -f <something>
    '                 - arbitrary fork (checks for unbalanced 's)
    help              - this document
    q, e, quit, exit  - exit

=head1 COMPLETE LIST OF SUBSTITUTIONS

    *p  = *PV     -- from Math::Units::PhysicalValue (if available)
    *pv = *PV     -- from Math::Units::PhysicalValue (if available)
    *d  = *Dumper -- from Data::Dumper               (if available)

=head2 GLOB SUB EXAMPLES

    (Disclaimer: This may be a plug for PV. Meh.)
    
    psh> p "3,000 ft"
    psh> p "2 minutes"
    psh> ($s[1]/$s[2]) + "0 miles/hour"

Violla, $s[0] is now set to 17.05 miles/hour!

Lastly, because you probably do not even have PV installed, but most l
+ikely do have Data::Dumper (since it's required):

    psh> [qw(lol dude!)]
    psh> d $s[0]
    psh> d [1, 2, 3]

Oh and one more because strange attractors are neat.

    psh> 7
    psh> sqrt $s[0]
    psh> sqrt $s[0]
    psh> sqrt $s[0]

=head1 FILES

    $ENV{HOME}/.psh_history - contains your command history
    $ENV{HOME}/.pshrc       - evaled at starttime if it exists

=head1 PS1

I intend to add many bash substitutions, but for now only \# (cmd
number) actually works.  You can (and possibly should) set your
PS1 in your .pshrc. I choose this because I like blue:

    $PS1 = "\e[1;34m\\# psh>\e[0;37m ";

=head1 AUTHOR

Paul Miller <jettero@cpan.org>

=head1 COPYRIGHT

Public Domain!  

I relinquish all my rights to anything written in this
document/program.  However, I politely request that you leave my
name on the project unless you rewrite, add, or alter the project
in such a way that the diff -u is bigger than the original source
file.

=head1 SEE ALSO

NOTE: In a few ways this is a reduplication of the perl debugger.
In many other ways, it is most definitely not.

perl(1), perldebug(1), perldebtut(1)

=cut

Comment on psh (perl testing shell)
Download Code

Back to Code Catacombs

Log In?
Username:
Password:

What's my password?
Create A New User
Node Status?
node history
Node Type: sourcecode [id://548787]
help
Chatterbox?
and the web crawler heard nothing...

How do I use this? | Other CB clients
Other Users?
Others cooling their heels in the Monastery: (6)
As of 2014-12-25 01:17 GMT
Sections?
Information?
Find Nodes?
Leftovers?
    Voting Booth?

    Is guessing a good strategy for surviving in the IT business?





    Results (159 votes), past polls