#!/usr/bin/perl
use strict;

local $SIG{'KILL'} = local $SIG{'TERM'} = local $SIG{'HUP'} = sub { finish(); exit; };

local $SIG{'INT'} = sub { die "Caught INT\n" };

# this sub is the beginning of some introspective tools to be used from within the shell
sub symbols {
	my $package = shift;
	my @types = @_ ? @_ : qw(SCALAR ARRAY HASH CODE);
	my @symbols = keys %{"::${package}::"};
	my $smap = { SCALAR => '$', ARRAY=> '@', HASH => '%', CODE => '&' };
	for my $type (@types) {
		print "${type}s in package $package:\n";
		print join @types == 1 ? "\n" : ', ', map { $smap->{$type}.$_ } grep { $type eq 'SCALAR' ? defined ${*{"${package}::$_"}{$type}} : defined *{"${package}::$_"}{$type} } @symbols;
		print "\n\n";
		}
	return;
	}

sub reuse (@) {
	my ($module, @args) = @_;
	my $file = $module;
	$file =~ s{::}{/}g;
	$file .= ".pm";
	if (exists $INC{$file}) {
		delete $INC{$file};
		}
	my $result = eval { require $file; };
	if ($@) {
		print "$@\n";
		return;
		}
	$module->import(@args);
	print "Reloaded $module\n";
	return $result;
	}

sub watch {
	my ($module, @args) = @_;
	my $file = $module;
	$file =~ s{::}{/}g;
	$file .= ".pm";
	unless (exists $INC{$file}) {
		require $file;
		$module->import(@args);
		}
	$file = $INC{$file};
	unless (-e $file) {
		warn "Can't locate module $module.\n";
		return;
		}
	
	push @psh::watched, {
		file => $file,
		module => $module,
		mtime => (stat $file)[9],
		args => \@args
		};
	return 1;
	}

# a tool to help you read binary data
sub bin_dump {
	print map { ' '.((ord $_ >= 32 and ord $_ < 127) ? $_ : '.') } split //, $_[0];
	print "\n";
	print map { sprintf '%02x', ord $_ } split //, $_[0];
	print "\n";
	return;
	}

package psh;
use Data::Dumper;
use Term::ReadLine;
if (eval { require Text::Balanced }) {
	Text::Balanced->import('extract_codeblock');
	}
else {
	warn "Text::Balanced module not found; no multi-line input.\n(Try \"perl -MCPAN -e 'install Text::Balanced'\" to install it.)\n";
	*extract_codeblock = sub { $_[0],'' };
	}
if (eval { require Storable }) {
	Storable->import('store', 'retrieve');
	}
else {
	warn "Storable module not found; history will not be saved.\n(Try \"perl -MCPAN -e 'install Storable'\" to install it.)\n";
	*store = sub { };
	*retrieve = sub { };
	}

	
use Getopt::Long;

require lib;
Getopt::Long::GetOptions(
	'I=s@' => sub { lib->import($_[1]) },
	'M=s@' => sub { eval "use $_[1]"; die $@ if $@ },
	'W=s@' => sub { main::watch($_[1]) },
	'h|help' => sub {
		die "usage: $0 [ -I include_path ] [ -M module_to_use ] [ -W module_to_watch ]\n";
		},
	);

my @watched;
sub check_watched {
	for my $m (@watched) {
		if (not -e $m->{'file'}) {
			warn $m->{'file'}." has disappeared.\n";
			}
		elsif ((stat $m->{'file'})[9] > $m->{'mtime'}) {
			$m->{'mtime'} = main::reuse($m->{'module'}, @{$m->{'args'}}) ? (stat $m->{'file'})[9] : 0;
			}
		}
	@watched = grep { -e $_->{'file'} } @watched;
	}

my $histfile = $ENV{'HOME'}."/.psh_history";
my $term = Term::ReadLine->new("perl shell");
warn "Install Term::ReadLine::Perl for better line editing support.\n(Try \"perl -MCPAN -e 'install Term::ReadLine::Perl'\" to install it.)\n" if $term->ReadLine =~ /Stub/;
$term->SetHistory(@{retrieve($histfile)}) if -e $histfile and $term->can('SetHistory');

while (defined (my $line = $term->readline('perl> '))) {
	exit if $line eq 'q';
	my ($good, $bad) = extract_codeblock("{$line}", '{');
	if ($bad) {
		my $newline;
		while (defined ($newline = $term->readline('----> '))) {
			$line .= $newline;
			my ($good, $bad) = extract_codeblock("{$line}", '{');
			last unless $bad;
			}
		$line = '' unless defined $newline;
		}
	check_watched;
	my @result = eval "package main;no strict;\n$line";
	(exists $INC{'Coy.pm'} ? Coy::enlighten($@) : warn $@) if $@;
	print Dumper @result if defined @result;
	}

print "\n";

sub finish {
	store([ $term->GetHistory ], $histfile) if $term and $term->can('GetHistory');
	}

END {
	finish();
	}
)