Skip to content

Instantly share code, notes, and snippets.

@srpatel

srpatel/prepl.pl

Created Apr 9, 2020
Embed
What would you like to do?
#!/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
You can’t perform that action at this time.