276 lines
7.3 KiB
Perl
Executable File
276 lines
7.3 KiB
Perl
Executable File
#!/usr/bin/perl
|
|
#
|
|
# by Erik Osheim
|
|
#
|
|
# licensed under the GNU GPL version 2
|
|
|
|
use Data::Dumper;
|
|
use File::Basename;
|
|
use Getopt::Long;
|
|
use Perl6::Slurp;
|
|
use Scalar::Util;
|
|
use Term::ReadLine;
|
|
|
|
Getopt::Long::Configure('bundling');
|
|
|
|
$| = 1;
|
|
$Data::Dumper::Terse = 1;
|
|
$Data::Dumper::Indent = 1;
|
|
|
|
sub usage {
|
|
my($status) = @_;
|
|
my $prog = basename($0);
|
|
print <<EOT;
|
|
usage: $prog [options]
|
|
-h,--help show this message
|
|
-e,--eval STR eval STR before interaction
|
|
-p,--pipe run in pipe mode (as a subprocess)
|
|
-q,--quiet do not output eval results
|
|
-r,--run PATH run PATH before interaction
|
|
-v,--verbose output eval results (default)
|
|
|
|
perl needs a good interpreter.
|
|
EOT
|
|
exit($status);
|
|
}
|
|
|
|
my @OLDARGV = @ARGV;
|
|
my $verbose = 'yes';
|
|
my $pipe;
|
|
my @preload;
|
|
GetOptions(
|
|
'help|h' => sub { usage(0); },
|
|
'eval|e=s' => sub { push(@preload, ['eval', $_[1]]); },
|
|
'pipe|p' => sub { $pipe = 'line' },
|
|
'quiet|q' => sub { $verbose = 0 },
|
|
'run|r=s' => sub { push(@preload, ['run', $_[1]]); },
|
|
'use|u=s' => sub { push(@preload, ['use', $_[1]]); },
|
|
'verbose|v' => sub { $verbose = 'please'; },
|
|
) || usage(1);
|
|
|
|
my ($prompt, $input) = (">>>", "");
|
|
unless($pipe) {
|
|
print "Welcome to Erik's Perl Interpreter\n";
|
|
print "(Type \"help\", \"exit\", or something else)\n";
|
|
}
|
|
|
|
my $pkgregex = qr/^(?:[a-zA-Z_][a-zA-Z0-9_]*::)+$/;
|
|
my $nameregex = qr/^[a-zA-Z_][a-zA-Z0-9_]*$/;
|
|
sub sigilfind {
|
|
my ($pkg, $sigil, $base, $proc) = @_;
|
|
$base = "" unless $base;
|
|
$proc = {$pkg => 1} unless $proc;
|
|
$pkg = $base if $base;
|
|
my @results;
|
|
foreach my $item (eval("keys(\%${pkg})")) {
|
|
my $item2 = $base . $item;
|
|
next if $proc->{$item2};
|
|
if($item =~ m/$nameregex/) {
|
|
push(@results, $item2) if eval("defined(${sigil}::${base}${item})");
|
|
} elsif($item =~ m/$pkgregex/) {
|
|
$proc->{$item2} = 1;
|
|
push(@results, sigilfind($item2, $sigil, $item2, $proc));
|
|
}
|
|
}
|
|
return @results;
|
|
}
|
|
|
|
sub _repr {
|
|
my ($item) = @_;
|
|
if(!defined($item)) {
|
|
return 'undef';
|
|
} elsif(Scalar::Util::blessed($item)) {
|
|
return "$item";
|
|
} elsif(ref($item) eq 'CODE') {
|
|
return "$item";
|
|
} else {
|
|
my $s = Dumper($item);
|
|
$s =~ s/\n+$//;
|
|
return $s;
|
|
}
|
|
}
|
|
|
|
sub repr {
|
|
my @output;
|
|
foreach my $item (@_) {
|
|
push(@output, _repr($item));
|
|
}
|
|
return join("\n", @output);
|
|
}
|
|
|
|
sub escape {
|
|
my($s) = @_;
|
|
$s =~ s/\\/\\\\/g;
|
|
$s =~ s/\n/\\n/g;
|
|
return $s;
|
|
}
|
|
|
|
sub _draw {
|
|
my ($s, $prefix, $suffix) = @_;
|
|
if($pipe) {
|
|
print "$prefix:" . escape($s) . "\n";
|
|
} else {
|
|
print $s . ($suffix ? $suffix : '');
|
|
}
|
|
}
|
|
|
|
sub draw_prompt {
|
|
my($p) = @_;
|
|
_draw($p, "PROMPT", " ");
|
|
}
|
|
sub draw_result {
|
|
my ($result) = @_;
|
|
$result = 'undef' unless defined($result);
|
|
_draw($result, "RESULT", "\n");
|
|
}
|
|
sub draw_error {
|
|
my ($err) = @_;
|
|
_draw($err, "ERROR");
|
|
}
|
|
sub draw_completions {
|
|
my (@items) = @_;
|
|
if($pipe) {
|
|
print 'COMPLETIONS:' . join('|', @items) . "\n";
|
|
} else {
|
|
print join("\n", @items) . "\n";
|
|
}
|
|
}
|
|
sub draw_message {
|
|
my ($mesg) = @_;
|
|
_draw($mesg, "MESSAGE");
|
|
}
|
|
sub draw_exit {
|
|
_draw("Bye.", "EXIT", "\n");
|
|
}
|
|
|
|
sub complete {
|
|
my ($word) = @_;
|
|
$word =~ m/^([&\$%@\*]?)(.*)$/;
|
|
my $sigil = $1 ? $1 : '&';
|
|
my $name = $2;
|
|
my @candidates = grep {
|
|
$_ =~ m/^$name/
|
|
} sigilfind('main::', $sigil);
|
|
return map { "${1}$_" } sort(@candidates);
|
|
}
|
|
|
|
my $HELP = <<EOT;
|
|
Greetings!
|
|
|
|
I'm program is designed to help you write Perl. Like the "perl" command,
|
|
I can parse and execute Perl code. Unlike it, I can execute perl code
|
|
interactively, allowing you to call functions, save their results, inspect
|
|
the results, and repeat.
|
|
|
|
I contain a lot of tricky functionality.
|
|
|
|
One side-note: I can't be run under the "strict" pragma; thus, you don't
|
|
need to use my() or our() to declare variables. The reaon for this has to
|
|
do with the way I evaluate blocks you enter. Sorry.
|
|
EOT
|
|
|
|
my $term;
|
|
|
|
sub main {
|
|
foreach my $pair (@preload) {
|
|
if($pair->[0] eq 'eval') {
|
|
eval $pair->[1];
|
|
die "failed to eval '$pair->[1]': $@" if $@;
|
|
} elsif($pair->[0] eq 'run') {
|
|
die "no path named $pair->[1] found" unless -e $pair->[1];
|
|
my $data = slurp($pair->[1]);
|
|
eval $data;
|
|
die "failed to run $pair->[1]: $@" if $@;
|
|
} elsif($pair->[0] eq 'use') {
|
|
eval "use $pair->[1]";
|
|
die "failed to use $pair->[1]: $@" if $@;
|
|
}
|
|
}
|
|
|
|
unless($pipe) {
|
|
$term = Term::ReadLine->new('IPERL');
|
|
my $attribs = $term->Attribs();
|
|
$attribs->{special_prefixes} = '$@%*&';
|
|
$attribs->{completion_function} = sub {
|
|
my ($word, $line, $x) = @_;
|
|
return complete($word);
|
|
};
|
|
}
|
|
|
|
while(1) {
|
|
my $line;
|
|
if($pipe) {
|
|
draw_prompt($prompt);
|
|
$line = <STDIN>;
|
|
} else {
|
|
$line = $term->readline("$prompt ");
|
|
}
|
|
last unless defined($line);
|
|
chomp($line);
|
|
|
|
if($pipe) {
|
|
if($line =~ m/ENTER:(.*)$/) {
|
|
$line = $1;
|
|
} else {
|
|
if($line =~ m/COMPLETE:(.*)$/) {
|
|
draw_completions(complete($1));
|
|
} else {
|
|
draw_error("malformed pipe input line");
|
|
}
|
|
next;
|
|
}
|
|
}
|
|
|
|
if($line eq '') {
|
|
} elsif($line eq 'exit') {
|
|
last;
|
|
} elsif($line eq 'help') {
|
|
($input, $prompt) = ("", ">>>");
|
|
draw_message($HELP);
|
|
} elsif($line eq 'reload') {
|
|
($input, $prompt) = ("", ">>>");
|
|
draw_message("reloading...\n");
|
|
exec($0, @OLDARGV);
|
|
} elsif($line eq 'sh') {
|
|
($input, $prompt) = ("", ">>>");
|
|
system("bash") unless $pipe;
|
|
} elsif($line =~ m/^sh (.+)$/) {
|
|
($input, $prompt) = ("", ">>>");
|
|
system($1) unless $pipe;
|
|
} elsif($line =~ m/^:tab *(.*)$/) {
|
|
} elsif($line eq ':code') {
|
|
draw_completions(sigilfind('main::', '&'));
|
|
} elsif($line eq ':scalar') {
|
|
draw_completions(sigilfind('main::', '$'));
|
|
} elsif($line eq ':hash') {
|
|
draw_completions(sigilfind('main::', '%'));
|
|
} elsif($line eq ':array') {
|
|
draw_completions(sigilfind('main::', '@'));
|
|
} elsif($line eq ':glob') {
|
|
draw_completions(sigilfind('main::', '*'));
|
|
} elsif($line =~ m/^[\t ]/ || $line =~ m/\{ *$/) {
|
|
$input .= $line;
|
|
$prompt = "..>";
|
|
} elsif($line =~ m/\\ *$/) {
|
|
$line =~ s/\\ *$//;
|
|
$input .= $line;
|
|
$prompt = "..>";
|
|
} else {
|
|
$input .= $line;
|
|
my @results = eval($input);
|
|
if($@) {
|
|
draw_error($@);
|
|
} elsif(scalar(@results) < 2) {
|
|
@results = map { chomp($_); repr($_); }
|
|
draw_result($results[0]);
|
|
} else {
|
|
@results = map { chomp($_); repr($_); }
|
|
draw_result(join(", ", @results));
|
|
}
|
|
($input, $prompt) = ("", ">>>");
|
|
}
|
|
}
|
|
draw_exit();
|
|
}
|
|
main();
|