#!/usr/local/bin/perl

## ksoze perl shell

use Getopt::Std;

my $kps_VERSION = '0.0';
my $kps_PREDEF_SYMS = 'BEGIN INC SIG ARGV ENV STDIN stdin STDOUT stdout STDERR stderr getopt getopts';

# process command line and setup settings
getopts('p:e:s:w:', \%kps_args);
# defaults
my %kps_setup = (
	prompt => 'Perl> ',
	extra_cr => 0,
	show_predef_symbols => 1,
	warnings => 1
);
$kps_setup{'prompt'} = $kps_args{'p'} if defined($kps_args{'p'});
$kps_setup{'extra_cr'} = $kps_args{'e'} if defined($kps_args{'e'});
$kps_setup{'show_predef_symbols'} = $kps_args{'s'} if defined($kps_args{'s'});
$kps_setup{'warnings'} = $kps_args{'w'} if defined($kps_args{'w'});

# title
print "# -= ksoze perl shell =- v$kps_VERSION -= type h for help =-\n";

# do the job
do { 
	# set warnings
	if ($kps_setup{'warnings'}) { $^W = 1 } else { $^W = 0 }
	# display prompt, get and parse input
	print $kps_setup{'prompt'};
	chomp(my $kps_line = <STDIN>); 
	my ($kps_command,$kps_params) = $kps_line =~ /^(.)(.*)/;
	# process input
	if ($kps_command eq 'q' && $kps_params eq '') { 
		# quit shell
		print '# goodbay !';
		exit;
	} elsif ($kps_command eq 'h' && $kps_params eq '') {
		# display available commands
		&kps_show_commands
	} elsif ($kps_command eq 's' && $kps_params eq '') {
		# setup
		print '# entering setup, valid commands are :
#   a) num<space>newvalue -> assign newvalue to setting at index num
#      num      = index of the setting to be changed
#      <space>  = one or more space(s)
#      newvalue = new value to be assigned (spaces inside allowed)
#   b) q -> quit setup

';
		my @kps_setup_keys = sort keys %kps_setup;
		my $kps_set_command = '';
		while ($kps_set_command ne 'q') {
			# show settings
			for (my $kps_c=0;$kps_c<=$#kps_setup_keys;$kps_c++) { 
				print "$kps_c) $kps_setup_keys[$kps_c] = '$kps_setup{$kps_setup_keys[$kps_c]}'\n";
			}
			# show prompt
			print 'Setup> ';
			#get command
			chomp($kps_set_command = <STDIN>);
			my ($kps_set_id) = ($kps_set_command =~ /^(\w)/);
			my ($kps_set_newvalue) = ($kps_set_command =~ /^\w\s+(.*)$/);
			# assign dummy value just in case we have undef
			$kps_set_id = $#kps_setup_keys + 1 unless defined($kps_set_id);
			# user is quitting, exit loop
			if ($kps_set_id ne 'q') {
				if ((0 <= $kps_set_id) && ($kps_set_id <= $#kps_setup_keys) && defined($kps_set_newvalue)) {
					# valid index, update new value
					$kps_setup{$kps_setup_keys[$kps_set_id]} = $kps_set_newvalue;
				} else { 
					print "# invalid command.\n# format is num<space>new_value or q to exit setup\n"
				}
			}
		}
		print "# quitting setup\n";
	} elsif ($kps_command eq 'm' && $kps_params eq '') {
		# switch to multi-line mode
		$kps_line = '';
		print "# multi-line mode on\n".$kps_setup{'prompt'};
		chomp(my $kps_line2 = <STDIN>);
		while ($kps_line2 ne 'm') {
			$kps_line .= $kps_line2."\n";
			print $kps_setup{'prompt'};
			chomp($kps_line2 = <STDIN>);
		}
		print "# multi-line mode off\n";
		eval "$kps_line";
	} elsif ($kps_command eq '!') {
		# evaluate as system call
		print "# system exec : $kps_params\n";
		eval("system \"$kps_params\"");
	} elsif ($kps_command eq '?') {
		# lookup symbols
		# load current symbols in @kps_symtable
		&kps_get_current_symbols;
		# format input
		$kps_params =~ s!^\s+(\s+).*!$1!;
		# display symbols if they match request
		print "# listing symbols that match $kps_params :\n";
		foreach my $kps_symbol (@kps_symtable) {
			if ($kps_symbol =~ /\Q$kps_params\E/) {
				my ($kps_type) = ($kps_symbol =~ /^(.).*$/);
				if ($kps_type eq '$') {
					# scalar
					print "$kps_symbol = ".eval("$kps_symbol || 'undef'")."\n";
				} elsif ($kps_type eq '@') {
					# array
					print "$kps_symbol = (".eval("join ',',$kps_symbol").")\n";
				} elsif ($kps_type eq '%') {
					# hash
					print "$kps_symbol = (\n";
					eval "foreach (sort keys $kps_symbol) { print \"\t\$_ -> \".(\${$kps_symbol}{\$_} || 'undef') .\"\n\" }";
					print ")\n";
				} elsif ($kps_type eq '&') {
					# sub
					print "$kps_symbol is sub\n";
			        } elsif ($kps_type eq 'f') {
			        	# filehandle
					$kps_symbol =~ s!^f!!;
					print "$kps_symbol is filehandle\n";
				}
			}
		}
	} else {
		#evaluate as perl code
		eval $kps_line;
		print "\n" if $kps_setup{'extra_cr'}
	} 
} until $@;

# report final error
print $@;
exit;

sub kps_get_current_symbols {
	# clean symtable
	@kps_symtable = ();
	# get symbols
	foreach my $kps_symbol (sort keys %::) {
		# skip kps own vars
		next if $kps_symbol =~ /^kps_/;
		# skip special variables
		next unless $kps_symbol =~ /^[a-zA-Z]/;
		# skip packages
		next if $kps_symbol =~ /::$/;
		# skip predefined symbols if required
		if (! $kps_setup{'show_predef_symbols'}) {
			next if $kps_PREDEF_SYMS =~ /$kps_symbol/
		}
		push (@kps_symtable,"\$$kps_symbol") if defined(*{"::$kps_symbol"}{SCALAR});
		push (@kps_symtable,"\@$kps_symbol") if defined(*{"::$kps_symbol"}{ARRAY});
		push (@kps_symtable,"\%$kps_symbol") if defined(*{"::$kps_symbol"}{HASH});
		push (@kps_symtable,"\&$kps_symbol") if defined(*{"::$kps_symbol"}{CODE});
		push (@kps_symtable,"f$kps_symbol") if defined(*{"::$kps_symbol"}{FILEHANDLE});
	}
}

sub kps_show_commands {
  print <<'EOF'
# available commands (sorted by priority)
# q -> quit kps immediately;
# h -> show this help, duh;
# s -> enter shell setup;
# m -> multi-line mode (on off), in this mode other commands are disabled;
# !commands -> "commands" are directly passed to system shell
#              but var interpolation is allowed;
# ?($|@|#|&|f)varname -> report value(s) of "varname" symbol by given context;
# perl code -> executes "perl code"
# ---------------------------------------------------
# -VARIABLES MUST BE DECLARED AS GLOBAL (no "my")
# -SYMBOLS CANT START WITH kps_ (it will fool script)
# -REFER TO kps_help.txt FOR FURTHER HELP
# -@ fravia's REFER TO kso_kps0.htm FOR FURTHER HELP

EOF
}