All pastes #137784 Raw Edit

PREPL v1.0 beta

public text v1 · immutable
#137784 ·published 2006-08-18 17:28 UTC
rendered paste body
#!/usr/bin/perl -w
use strict;
use warnings;

my $header = "perl: ";
my (@errors, $param, @statement, $command, @context, @buffer);
my $evalstring = '';

my %builtins = (
	spit => \&spit,
	clear => \&clear,
	save => \&save,
	quit => sub { exit },
	'exit' => sub { exit },
	errors => \&printerrors,
	help => \&help,
	set => \&replset,
);

my %replenv = (
	save => 0,
);


print $header;
while (my $line = <>) {
	chomp $line;
	@buffer = makebuffer("$line"); #format the incoming line so that each statement on the line is a separate value in @buffer
	clear() unless $replenv{save};
	
	while (@buffer > 0) {
		@statement = split(/ /, $buffer[0]); #so that i can set hooks on certain commands.
		$statement[0] =~ s/\W//; #remove the ';' added by makebuffer()
		
			
		if (exists($builtins{"$statement[0]"})) {
			$command = shift @statement;
			$param = join " ", @statement;
			$builtins{"$command"}->("$param");
		}
		else {
			push @context, "$buffer[0]";
			$evalstring = join " ", @context;
			eval "no strict; use warnings; $evalstring" if (@buffer == 1); #run only if this is the last thing in the buffer.
			if ($@) {
				warn $@;
				push @errors, $@;
			}
		}
		
		shift @buffer;
	}
	
	print "\n$header";
}

sub save { 
	if ($replenv{save}) {
		print "NOT saving input as context.";
	}
	else {
		print "SAVING input as context.";
	}
	$replenv{save} = !$replenv{save};
	clear();
	return;
}

sub spit {
	my $temp = "$evalstring";
	print "Current context:\n$temp\nEND\nWe are ";
	if ($replenv{save}) {
		print "SAVING";
	}
	else {
		print "NOT saving";
	}
	print " input as context.\n";
	return;
}

sub clear {
	@context = ();
	return;
}

sub help {
	print "Soon";
	return;
}

sub printerrors {
	for (@errors) { print "$_\n"; }
	return;
}

sub replset {
	print "Soon";
	return;
}

sub makebuffer {
	my $rawline = shift;
	if ($rawline !~ /[;}]\s*$/) {
		$rawline .= ';';
	}
	$rawline =~ s/;/;BREAK/g; #to make splitting it easier
	if ($rawline =~ /[({].*?BREAK.*?[)}]/) {
		$rawline =~ s/BREAK//g; #so that we dont split inside a for's EXPR or inside a block
	}
	
	my $blargh = [ split(/BREAK/, $rawline) ];
	return @{$blargh};
}