Created
April 9, 2020 11:13
-
-
Save srpatel/edf44a674e90a2db1fd13eaf68796341 to your computer and use it in GitHub Desktop.
This file contains bidirectional Unicode text that may be interpreted or compiled differently than what appears below. To review, open the file in an editor that reveals hidden Unicode characters.
Learn more about bidirectional Unicode characters
#!/usr/bin/perl | |
# This is a REPL loop for Perl. | |
# If you want to be able to navigate on the prompt with arrow keys | |
# and have up/down for history, then: | |
# For OSX, install: Term::EditLine, Term::ReadLine::EditLine | |
# For Linux, install Term::ReadLine::Gnu | |
use strict; | |
use warnings; | |
BEGIN { $ENV{PERL_RL} = "EditLine"; } | |
# Utility things: | |
use feature 'say'; | |
use Term::ReadLine; | |
use Term::ANSIColor qw(:constants); | |
$Term::ANSIColor::AUTORESET = 1; | |
my $term = new Term::ReadLine 'Prepl'; | |
my $attribs = $term->Attribs; | |
$attribs->{catch_signals} = 0; # the default is 1 | |
my $prompt = '> '; | |
my $undef; | |
my @results = (); | |
my %last_mod = (); | |
my $max_history = 100; | |
my $history_file = $ENV{HOME} . "/.prepl_history"; | |
my $fh; | |
if (-e $history_file) { | |
open($fh, "$history_file"); | |
my @lines = (); | |
while (<$fh>) { | |
my $line = $_; | |
$term->addhistory($line); | |
push @lines, $line; | |
if (@lines > $max_history) { | |
# Remove the first line | |
shift @lines; | |
} | |
} | |
close $fh; | |
if (@lines >= $max_history) { | |
# Delete everything except the last 100 lines | |
open($fh, ">$history_file"); | |
print $fh $_ for @lines; | |
close $fh; | |
} | |
} | |
my $previous_line = ""; | |
while ( defined($_ = $term->readline($previous_line ? ' ' : $prompt)) ) { | |
chomp; | |
$_ = $previous_line . $_; | |
$previous_line = ""; | |
if (/\S/) { | |
$term->addhistory($_); | |
open($fh, ">>$history_file"); | |
print $fh "$_\n"; | |
close $fh; | |
} | |
# If the line ends in \, then read the next line too! | |
if (/\\$/) { | |
$_ =~ s/\\$/\n/; | |
$previous_line = $_; | |
next; | |
} | |
# Command | |
my $run = 1; | |
if ($_ =~ /^\s*\./) { | |
$run = 0; # Most commands stop execution of line. | |
$_ =~ /^\s*\.(\S+)(.*)$/; | |
my $command = lc($1); | |
my $rest = $2; | |
if ($command eq 'quit' || $command eq 'q') { | |
last; | |
} elsif ($command eq 'printenv') { | |
# If no arguments, then print the environment stack. | |
my %env = %ENV; | |
my $keyLength = 0; | |
my $maxValLength = 80; | |
for my $k (keys %env) { | |
if (length $k > $keyLength) { | |
$keyLength = length $k; | |
} | |
} | |
for my $k (sort keys %env) { | |
my $pad = ' ' x ($keyLength - length $k); | |
my $val = substr $env{$k}, 0, $maxValLength; | |
if (length $val < length $env{$k}) { | |
$val .= '...'; | |
} | |
print "$k$pad : $val\n"; | |
} | |
} elsif ($command eq 'ogi') { | |
$ENV{UseNewGameInfo} = 0; | |
$run = 1; | |
} elsif ($command eq 'ngi') { | |
$ENV{UseNewGameInfo} = 1; | |
$run = 1; | |
} else { | |
print RED "prepl: Command `.$command` not recognised.\n"; | |
} | |
$_ = $rest; | |
} | |
if ($run) { | |
# Replace all instances of [[\d+]] with the relevant result var | |
while ($_ =~ /\[\[(\d+)\]\]/) { | |
my $i = $1; | |
my $varname = '$undef'; | |
if (@results <= $i) { | |
print RED "prepl: Result `[[$i]]` does not exist.\n"; | |
} else { | |
$varname = "\$results[$i]"; | |
} | |
$_ =~ s/\[\[$i\]\]/$varname/g; | |
} | |
eval { | |
no strict; | |
no warnings; | |
my $command = $_; | |
local $SIG{'INT'} = sub { die; }; | |
my @output = eval($command); | |
# TODO: If we printed anything above without a newline, then print a newline. | |
if ($@) { | |
if ($@ =~ /Missing right curly or square bracket/ || | |
$@ =~ /Can't find string terminator/) { | |
# carry on reading until closing string or brace | |
$previous_line .= $_ . "\n"; | |
} else { | |
print RED "$@", RESET, "\n"; | |
} | |
} else { | |
for my $result (@output) { | |
if (not defined $result) { | |
print FAINT "(undef)\n"; | |
} elsif ($result eq "") { | |
next; | |
} else { | |
my $i = @results; | |
push @results, $result; | |
print "[[$i]] = ".PrintHuman($result)."\n"; | |
} | |
} | |
} | |
1; | |
} or print RED "$@\n"; | |
} | |
} | |
sub PrintHuman { | |
my ($var, $i, $initial) = @_; | |
$i = 0 unless defined $i; | |
$initial = 1 unless defined $initial; | |
my $indent = " " x $i; | |
my $pretty = ""; | |
$pretty .= $indent if $initial; | |
if (defined $var) { | |
$pretty .= "$var"; | |
if (ref $var eq 'ARRAY') { | |
$pretty .= " \[\n"; | |
my $first = 1; | |
for my $v (@$var) { | |
if (not $first) { | |
$pretty .= ",\n"; | |
} else { | |
$first = 0; | |
} | |
$pretty .= "$indent".PrintHuman($v, $i+1); | |
} | |
$pretty .= "\n$indent]"; | |
} elsif (ref $var eq 'HASH') { | |
$pretty .= " {\n"; | |
my $first = 1; | |
for my $v (keys %$var) { | |
if (not $first) { | |
$pretty .= ",\n"; | |
} else { | |
$first = 0; | |
} | |
$pretty .= "$indent '$v' => ".PrintHuman($var->{$v}, $i+1, 0); | |
} | |
$pretty .= "\n$indent}"; | |
} | |
} else { | |
$pretty .= "(undef)"; | |
} | |
return $pretty; | |
} |
Sign up for free
to join this conversation on GitHub.
Already have an account?
Sign in to comment