prepl.pl

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