#!/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