#!/bin/sh /usr/software/bin/perl

package Spinboo;

sub new {
    my $invocant = shift;
    my $class = ref($invocant) || $invocant;
    my $self = {
	GlobalError => 0,
	@_,
	class => $invocant,
    };
    print "Class is $class\n";
    bless($self, $class);
}

sub Print {
    my $self = shift;
    my $key;

    print "$self->{class}:\n";

    foreach $key (@_){
	print $key, "\n";
    }

    foreach $key (sort keys %$self){
	if (defined($self->{$key})){
	    print "\t$key = ", $self->{$key}, ", ", \$self->{$key}, "\n";
	} else {
	    print "\t$key = undef\n";
	}
    }
    print "\n";
}

sub sub1 ($) {
    my $self = shift;
    $self->sub2();
    $self->Print();
    print "In Sub1, args = " . join(', ', @_) . "\r\n";
}
sub sub2 ($$) {
    print "In Sub2, args = " . join(', ', @_) . "\r\n";
}
sub sub3 ($$$) {
    print "In Sub3, args = " . join(', ', @_) . "\r\n";
}

package main;
use lib "/home/systest/sb/export/perl";
use IO::Select;
use Text::ParseWords qw(quotewords);
use IO::Socket;
use IO::Socket::INET;
use Data::Dumper;

#use strict;
#use warnings;

my %Cmds;
my %modules;
my %objects;
my @done;
my @packages;
my @history;
my @clients;
my $oldhandle;
my $ssocket;
my $server_port = 6878;
my $count = 0;
my $pager = 0;
my $breakonerror = 0;
my %state = (
	     input => "",
	     inputcursor => 0,
	     linecursor => 0,
	     prompt => "=> ",
	     buffer => "",
	     lastwrite => 0,
	     );
my $debug = 1;
my $select = IO::Select->new(\*STDIN);
my $stty_state = qx(/bin/stty -g 2>/dev/null);

my $global_object;

my $everything = {
		  Cmds => \%Cmds,
		  Modules => \%modules,
		  Objects => \%objects,
		  Done => \@done,
		  Packages => \@packages,
		  History => \@history,
		  Clients => \@clients,
		  Server => \$ssocket,
		  Port => \$server_port,
		  Count => \$count,
		  Pager => \$pager,
		  BOE => \$breakonerror,
		  State => \%state,
		  Debug => \$debug,
		  Select => \$select,
		  STTY => \$stty_state,
		  GO => \$global_object,
	      };
		  
my %profiles;		  
my %commands;

#use Time::HiRes;
#use SpinServer;

# quotewords is imported into main, but I don't want to see it.
# Perhaps there is a better way around this, but for now make an
# alias and trash the old value.
*_quotewords = *quotewords;
my $a;
*quotewords = *a;

my @Acceptable = ("^main\$", "spin"); #, "spin", "NFS");

sub _Acceptable {
    my $pkg = shift;

    my $retval = 0;
    foreach my $item (@Acceptable){
	if ($pkg =~ /$item/i){
	    $retval = 1;
	    last;
	}
    }
    
    $retval;
}

sub _DumpVar {
    my ($packagename, $ref) = @_;
    local(*alias);
    my @retval;
  
    $packagename =~ s/::$//;
#  print "========================= $packagename =========================\n";
    *stash = *{"${packagename}::"};
    $, = " ";
    while ((my $varName, my $globValue) = each %stash){
#    print "$varName =================================================\n";
	*alias = $globValue;
	my $type = 0;
	if (defined($alias)){
#      print "\t \$$varName $alias \n";
	    $type |= 1;
	}
	if (defined(@alias)){
#      print "\t \@$varName @alias \n";
	    $type |= 2;
	}
	if (defined(%alias)){
#      print "\t \%$varName %alias \n";
	    $type |= 4;
	}
	if (defined(&alias)){
	    if (!($varName =~ /^_/) && !($varName =~ /sock/i) && !($varName =~ /inet/i) && !($varName =~ /af_/i) && (_Acceptable($packagename))){
		push(@retval, "$varName");
	    }
	    $type |= 8;
	}
	if (defined(*alias)){
	    $type |= 16;
	}

	if (!$type){
	    print "unknown: $varName\r\n";
	} else {
#	printf("%s 0x%x\n", $varName, $type);
	}
	if (($type == 0x14) && ($varName =~ /::$/)){
	    if ($varName ne "${packagename}::"){
#	    print "pushing ${packagename}::${varName}\n";
		$varName =~ s/::$//;
		push @$ref, "${packagename}::${varName}";
	    }
	}
    }
    @$ref = sort @$ref;
    @retval;
}

sub Redirect {
    my ($file) = @_;

    if ($file =~ /stdout/i){
	select STDOUT;
    } else {
	if (open(IF, ">$file")){
	    $oldfilehandle = select IF;
	    $| = 1;
	} else {
	    warn "Could not open $file";
	}
    }
}

sub Quit {
    exit(0);
}

sub Introspect {
    my @recurse = (@_);
    while (@recurse){
	my $cur = shift @recurse;
	if (grep /^$cur$/, @done){
#	    print "Skipping $cur\n";
#	    next;
	}
	my @subs = _DumpVar($cur, \@recurse);
	if (@subs){
	    my $ncur = $cur;
	    $ncur =~ s/main:://;
	    if (1 == 1){ # Only in verbose mode.....
		print "$ncur ==>\r\n";
		print "\t", join(", ", sort @subs), "\r\n";
	    }
	    foreach my $sub (@subs){
		push(@{$Cmds{$sub}}, $ncur) unless grep(/^$ncur$/, @{$Cmds{$sub}});
		push @{$modules{$ncur}}, $sub unless grep(/^$sub$/, @{$modules{$ncur}});; 
	    }
	}
	push @done, $cur;
    }
}

sub Eval {
    print "In Eval: Running (", join(' ', @_), "\n";
    eval join(' ', @_);
}

sub Locate {
    my @list;

    foreach my $dir (@INC){
	if (opendir(DH, $dir)){
	    my @entries = readdir(DH);
	    closedir(DH);

	    push(@list, grep(/.*\.pm$/, @entries));
	}
    }

    print "Module list:\r\n\t";
    print join("\r\n\t", sort @list);
    print "\r\n";
}

sub AddPath {
    if ($_[0] =~ /front/i){
	shift @_;
	unshift(@INC, @_);
    } else {
	push(@INC, @_);
    }
}

sub Use {
    my ($module) = @_;

    eval "use $module";
    if ($@){
	print STDOUT "Error loading $module: $@\r\n\r\n\r\n";
	return 1;
    }
    push(@Acceptable, $module);
    Introspect("main");
    _handleinit($module);
}

sub _uptime {
    my $sec = 0;
    if (open(IH, "/proc/uptime")){
	my $line = <IH>;
	close(IH);
	if ($line =~ /^\s*(\d+\.\d+)/){
	    $sec = $1;
	}
    }
    return $sec;
}

sub StartPT {
    my $pid = shift || 0;
    $commands{$pid} = 0;
    $profiles{$pid} = _uptime();
}

sub StopPT {
    my $pid = shift || 0;
    return -1 unless exists($profiles{$pid});
    my $retval = _uptime() - $profiles{$pid};
    delete $profiles{$pid};
    $commands{$pid}--; # This command doesn't count

    if ($retval > 1){
	printf STDOUT ("%s: $commands{$pid} handled in %.2f\n", scalar localtime, $retval);
    }

    $retval;
}

sub DoOver {
    my $repeat = shift;
    my $cmd = join(' ', @_);
    my $cond;

    if ($repeat =~ /^\d+$/){
	$cond = "\$i < $repeat";
    } elsif ($repeat =~ s/\s*-\s*//) {
	# Must be a file
	$cond = "(-f \"$repeat\")";
    } elsif (defined($repeat)) {
	# Must be a file
	$cond = "!(-f \"$repeat\")";
    }

    return undef unless $cond;
	
    for (my $i = 0; eval $cond; $i++){
	my $retval = _handlecommand($cmd);
	print STDOUT " $i $cmd\r";
    }
}

sub _DPrint {
    foreach my $client (@clients){
	print $client @_;
    }
}
sub _DPrintf {
    foreach my $client (@clients){
	printf $client @_;
    }
}

sub _max {
    my $max;

    foreach my $i (@_){
	if ($max < $i){
	    $max = $i;
	}
    }
#    &_DPrint("Max of " . join(',', @_) . " is $max\n");
    return $max;
}

sub _min {
    my $min = $_[0];

    foreach my $i (@_){
	if ($min > $i){
	    $min = $i;
	}
    }
#    &_DPrint("Min of " . join(',', @_) . " is $min\n");
    return $min;
}

sub _common {
    my $min = 0xffffffff;
    my $start = shift @_;
    foreach my $i (@_){
	$min = _min($min, length($i));
    }
    my $retval = "";
    for (my $j = $start; $j < $min; $j++){
	my $cur = substr($_[0],$j,1);
	foreach my $it (@_){
	    if ($cur ne substr($it, $j, 1)){
		_DPrint "$cur not found at $j in $it\n";
		_DPrint "Returning $retval from _common($start, ".join(',', @_).")\n";
		return $retval;
	    }
	}
	$retval .= $cur;
    }
    _DPrint "Returning $retval from _common($start, ".join(',', @_).")\n";
    $retval;
}

sub _GetInput {
    my ($fh, $sr, $loop) = @_;
    my $retval = 0;


    &_DPrint("\r\nEntering _GetInput with fh - $fh, sr = $sr, loop = $loop\r\n");
  doloop:
    my $char = getc($fh);
    if ($char eq "\033"){
	$char = getc($fh);
	if ($char eq "\133"){
	    $char = getc($fh);
	    if ($char eq "A"){
		$char = "\020";
	    } elsif ($char eq "B"){
		$char = "\016";
	    } elsif ($char eq "C"){
		$char = "\006";
	    } elsif ($char eq "D"){
		$char = "\002";
	    }
	}
    } 
    &_DPrintf("Char 0 = %x\r\n", ord($char)) if $debug;
    if ($char eq "\000"){
	die "Gack!  Got EOF!\n";
    } elsif ($char eq "\007"){ # ^g
	&_DPrint("\r\nInput is ($sr->{input})\r\n");
    } elsif ($char eq "\001"){ # ^a
	$sr->{linecursor} = 0;
    } elsif ($char eq "\005"){ # ^e
	$sr->{linecursor} = length($sr->{input});
    } elsif ($char eq "\003"){ # ^c
	exit(0);
    } elsif ($char eq "\010"){ # ^h
	print STDOUT ("\r\n");
	print STDOUT ("History:\r\n");
	for (my $i = 0; $i < (scalar @history); $i++){
	    print STDOUT ("$i: $history[$i]\r\n");
	}
	print STDOUT ("\r\n");
    } elsif ($char eq "\t"){
	&_DPrint("Would try to do completion ($sr->{input})\r\n");
	my @options;
	my $pre = "";
	my $match;
	if ($sr->{input} =~ /\s*\S+\s+/){
	    $sr->{input} =~ /\s+(\S+)$/;
	    my $dir = $1;
	    &_DPrint("Would try to do directory completion on $dir\r\n");
	    $dir =~ s/^\s*//g;
	    $dir =~ s/\s*$//g;
	    if (!($dir =~ /\//)){
		$dir =~ s/^/.\//;
	    }

	    _DPrint("Dir is $dir\n");
	    my @dirs = split /\//, $dir, -1;
	    _DPrint("Dirs is ".join(',',@dirs)."\n");
	    _DPrint("Dirs length ".(scalar @dirs)."\n");

	    if (@dirs >= 2){
		$match = pop @dirs;
		$dir = join('/',@dirs);
	    } else {
		$match = $dir;
		$dir = ".";
	    }
	    _DPrint("Dir is $dir\n");
	    _DPrint("Match is $match\n");

	    # If the module for the command has a special file completion command, use it

	    my $cmd = (split(/\s+/, $sr->{input}))[0];
	    _DPrint("Cmd is $cmd\n");
	    my $themod = ${$Cmds{$cmd}}[0];
	    _DPrint("Mod is $themod\n");
	    if (grep(/^Readdir$/, @{$modules{$themod}})){
		_DPrint("Found module readdir\n");
		my @dnames = &{"${themod}::Readdir"}("-a", $dir);
		_DPrint("Got ", join(',', @dnames)," back from readdir\n");
		@options = grep !/^(\.|\.\.)/, @dnames;
		if (length $match){
		    @options = grep /^$match/, @options;
		}
	    } elsif (opendir(DH, $dir)){
		_DPrint("Did not find module readdir\n");
		my @dnames = readdir(DH);
		closedir(DH);
		@options = grep !/^(\.|\.\.)/, @dnames;
		if (length $match){
		    @options = grep /^$match/, @options;
		}
	    } else {
		_DPrint("Filename completion failed: $dir\n");
	    }
		
	    if (@options == 1){
		# Need to do the right stat here....
		&_DPrint("Checking $dir/$options[0]\n");
		if (grep(/^Getattr$/, @{$modules{$themod}})){
		    _DPrint("Found module Getattr\n");
		    my $value = &{"${themod}::Getattr"}("-a", "$dir/$options[0]", "-np");
		    _DPrint("Got $value back from Getattr\n");
		    if ($value == 2){
			# Need more stuff here to handle multiple selection
			$sr->{input} .= "/";
			$sr->{linecursor}++;
			$dir .= "/";
			$match .= "/";
			$options[0] .= "/";
			&_DPrint("Added / to input\n");
		    }
		} elsif (-d "$dir/$options[0]"){
		    # Need more stuff here to handle multiple selection
		    $sr->{input} .= "/";
		    $sr->{linecursor}++;
		    $options[0] .= "/";
		    $dir .= "/";
		    $match .= "/";
		    &_DPrint("Added / to input\n");
		}
		if (length($match)){
		    $pre = substr($sr->{input}, 0, -(length $match));
		} else {
		    $pre = $sr->{input};
		}
	    } else {
		$pre = substr($sr->{input}, 0, -(length $match));
	    }
	} else {
	    @options = grep /^$sr->{input}/, keys %Cmds;
#	    $sr->{input} = "";
#	    $sr->{linecursor} = 0;
	    $match = $sr->{input};
	}
	&_DPrint("input = $sr->{input}\n");
	&_DPrint("Pre = $pre\n");
	&_DPrint("Match = $match\n");

	if (@options == 0){
	    print STDOUT "\a";
	} elsif (@options == 1){
	    &_DPrint("Single option\r\n");
	    my $com = _common(length($match), @options);
	    $sr->{input} = $pre . $options[0];
	    $sr->{linecursor} = length($sr->{input});
	} else {
	    # Hairy code follows.....need to think it through......
	    
	    &_DPrint("Options are: ", join(",", sort @options), "\r\n");
#	    &_DPrint("Common is: ", (my $com = _common($sr->{linecursor}, @options)), "\r\n");
	    &_DPrint("Common is: ", (my $com = _common(length($match), @options)), "\r\n");
	    if (length($com)){
		$sr->{input} = substr($sr->{input}, 0, $sr->{linecursor}) . $com . substr($sr->{input},$sr->{linecursor});
		$sr->{linecursor} += length($com);
	    } else {
		print STDOUT "\r\n" . join(', ', sort @options) . "\r\n";
	    }
	}
    } elsif ($char eq "\004"){ # ^d
	my $len = length $sr->{input};
	$sr->{input} = substr($sr->{input}, 0, $sr->{linecursor}) . substr($sr->{input}, $sr->{linecursor}+1);
    } elsif ($char eq "\020"){ # ^p
	&_DPrint("Cursor is $sr->{inputcursor}, history = ". (scalar @history) ."\r\n");
	if ($sr->{inputcursor} == 0){
	    print STDOUT "\a";
	} else {
	    $sr->{inputcursor}--;
	    $sr->{input} = $history[$sr->{inputcursor}];
	}
    } elsif ($char eq "\016"){ # ^n
	&_DPrint("Cursor is $sr->{inputcursor}, history = ". (scalar @history) ."\r\n");
	if ($sr->{inputcursor} < (scalar @history)){
	    $sr->{inputcursor}++;
	    my $len = length $sr->{input};
	    $sr->{input} = "";
	    $sr->{input} = $history[$sr->{inputcursor}];
	} else {
	    print STDOUT "\a";
	}
    } elsif ($char eq "\006"){ # ^f
	if ($sr->{linecursor} < length($sr->{input})){
	    $sr->{linecursor}++;
	} else {
	    print STDOUT "\a";
	}
    } elsif ($char eq "\002"){ # ^b
	if ($sr->{linecursor} > 0){
	    $sr->{linecursor}--;
	} else {
	    print STDOUT "\a";
	}
    } elsif ($char eq "\013"){ # ^k
	_DPrint "Kill remainder\n";
	my $len = length $sr->{input};
	$sr->{buffer} = substr($sr->{input}, $sr->{linecursor}, $len - $sr->{linecursor}, "");
	_DPrint "Buffer = $sr->{buffer}, input = $sr->{input}, lc = $sr->{linecursor}\n";
    } elsif ($char eq "\031"){ # ^y
	_DPrint "Yank buffer\n";
	$sr->{input} = substr($sr->{input}, 0, $sr->{linecursor}) . $sr->{buffer} . substr($sr->{input},$sr->{linecursor});
    } elsif ($char eq "\025"){ # ^u
	&_DPrint("Would kill line\r\n");
	my $len = length $sr->{input};
	$sr->{input} = "";
	$sr->{linecursor} = 0;
    } elsif ($char eq "\177" || $char eq "\010"){ # Delete or backspace
	&_DPrint("Would delete character\r\n");
	if ($sr->{linecursor} > 0){
	    $sr->{input} = substr($sr->{input}, 0, -1);
	    $sr->{linecursor}--;
	} else {
	    print STDOUT "\a";
	}
    } elsif ((ord($char) >= 32) && (ord($char) < 127)) { # Printable character
	if ($sr->{linecursor} >= length($sr->{input})){
	    $sr->{input} .= $char;
	} else {
	    &_DPrint("Input before sub = $sr->{input}\n");
	    &_DPrint("lc = $sr->{linecursor}, ic = $sr->{inputcursor}, ".ord($char)."\n");
	    $sr->{input} = substr($sr->{input}, 0, $sr->{linecursor}) . $char . substr($sr->{input},$sr->{linecursor});
	    &_DPrint("Input after sub = $sr->{input}\n");
	}
	$sr->{linecursor}++;
    } elsif (($char eq "\r") || ($char eq "\n")){
	&_DPrint("\r\n");
	my $cl = length($sr->{input});
	while ($sr->{input} =~ /!(\d+)/){
	    my $rep;
	    my $hoff = $1;
	    &_DPrint("hoff = $hoff\n");
	    if (($hoff >= 0) && ($hoff < (scalar @history))){
		$rep = $history[$hoff];
	    } else {
		$rep = "";
	    }
	    $sr->{input} =~ s/!\d+/$rep/;
	}
	if (scalar @history){
	    while ($sr->{input} =~ /!!/){
		$sr->{input} =~ s/!!/$history[-1]/;
	    }
	    my $lf = (&_quotewords('\s+', 0, $history[-1]))[-1];
	    while ($sr->{input} =~ /!\$/){
		$sr->{input} =~ s/!\$/$lf/;
	    }
	}
	if (length($sr->{input})){
	    if (@history > 100){
		shift @history;
	    }
	    push(@history, $sr->{input});
	    $sr->{inputcursor}++;
	    while ($sr->{input} =~ /\s+(0x[0-9abcdef]+)\s+/i){
		my $value = hex(lc($1));
		$sr->{input} =~ s/$1/$value/;
	    }
	    # Handle octal translation
	    while ($sr->{input} =~ /\s+(0[0-7]+)\s+/i){
		my $value = oct(lc($1));
		$sr->{input} =~ s/$1/$value/;
	    }
    
	    &_DPrint("Translated input: $sr->{input}\r\n");
    
#	    @retval = &_quotewords('\s+', 0, $sr->{input});
	    $retval = 1;

	    # Ready to handle the input line
	    print STDOUT "\r\n";
#	    $sr->{input} = "";
	    $sr->{inputcursor} = (scalar @history);
	}
	$sr->{linecursor} = 0;
    } else {
	&_DPrint("Unhandled char " . ord($char) . "\n");
    }
    &_DPrint("lc = $sr->{linecursor}, ic = $sr->{inputcursor}, ip = $sr->{input}, buf = $sr->{buffer}\n");
    _ShowPrompt($sr, "a");
    if (!$retval && $loop){
	goto doloop;
    }

    $retval;
}

sub _handlecommand {
    my ($cmd, $fh) = @_;

    my $retval = 0;
    &_DPrint("Handling command ($cmd)\n");
    foreach my $key (keys %commands){
	$commands{$key}++;
    }
    
    # Should to comment handling here.....
    # Handle # style comments here
    $cmd =~ s/\s*\#.*$//g;
    &_DPrint("After removing comments command is ($cmd)\n");
    return 0 unless length($cmd);
    my @data = &_quotewords('\s+', 0, $cmd);
    if (scalar @data){
	my $cmd = shift @data;
	my $mod = undef;
	
	if (length($cmd)){
	    if ($cmd =~ /(\S+)::(\S+)/){
		# Explicit calling since there may be dups....
		$cmd = $2;
		$mod = $1;
		print STDOUT "It is $mod -> $cmd\n";
	    } elsif (exists($Cmds{$cmd})){
#		print STDOUT "\rCan run command @{$Cmds{$cmd}}[0]::$cmd\r\n";
		if ((my $noptions = scalar @{$Cmds{$cmd}}) > 1){
		    print STDOUT "Multiple definitions for $cmd\r\n";
		    for (my $i = 0; $i < @{$Cmds{$cmd}}; $i++){
			print "$i: ${$Cmds{$cmd}}[$i]\r\n";
		    }
		  do_over0:
		    {
			my %state = (
				     input => "",
				     inputcursor => 0,
				     linecursor => 0,
				     prompt => "-> ",
				     buffer => "",
				     lastwrite => 0,
				     );
			print STDOUT "\r d- $state{linecursor}$state{inputcursor}$state{prompt}$state{input}";
			if (_GetInput($fh, \%state, 1)){
			    my @data = &_quotewords('\s+', 0, $state{input});
			    _DPrint "Got from _GetInput: " . join(',', @data) . "\n";
			    print STDOUT "\r\n";
			    my $choice = shift @data;
			    chomp $choice;
			    if (($choice < 0) || ($choice >= $noptions)){
				print STDOUT "Invalid choice $choice.  Please pick a number between 0 and " .($noptions - 1)."\n";
				goto do_over0;
			    }
			    if (${$Cmds{$cmd}}[$choice]){
				$mod = ${$Cmds{$cmd}}[$choice];
			    }
			}
		    }
		} else {
		    $mod = ${$Cmds{$cmd}}[0];
		}
	    }
	    if ($mod){
		system("/bin/stty $stty_state");
		my $ofh;
		if ($pager){
		    open(FH, "|less");
		    $ofh = select FH;
		}
		if ($cmd =~ /new/){
		    unshift @data, $mod;
		} else {
		    my $num_objs = @{$objects{$mod}};
#		    print STDOUT "=====> Num objects for $mod = $num_objs\n";
		    if ($num_objs == 0){
			# Nothing to do
		    } elsif ($num_objs == 1){
			unshift @data, $objects{$mod}->[0];
#			print STDOUT Dumper(\@data, $objects{$mod}, \$mod);
		    } else {
			for (my $i = 0; $i < $num_objs; $i++){
			    print STDOUT "$i: $objects{$mod}->[$i]\n";
			}
		      do_over1: {
			  my %state = (
				       input => "",
				       inputcursor => 0,
				       linecursor => 0,
				       prompt => "+> ",
				       buffer => "",
				       lastwrite => 0,
				       );
			  my $num_objs = @{$objects{$mod}};
			  print STDOUT "\r\n z- $state{linecursor}$state{inputcursor}$state{prompt}$state{input} - $num_objs\r\n";
			  
			  if (_GetInput($fh, \%state, 1)){
			      my @qdata = &_quotewords('\s+', 0, $state{input});
			      _DPrint "Got from _GetInput: " . join(',', @data) . "\n";
			      print STDOUT "\r\n";
			      my $choice = shift @qdata;
			      chomp $choice;
			      if (($choice < 0) || ($choice >= $num_objs)){
				  print STDOUT "Invalid choice $choice.  Please pick a number between 0 and " .($num_objs - 1)."\n";
				  goto do_over1;
			      }
			      my $object = ${$objects{$mod}}[$choice];
			      print STDOUT "Object is $object\n";
			      unshift @data, $object;
			  }
		      }
		    }
		}

		# Run the command
		$retval = &{"${mod}::${cmd}"}(@data);
		if ($cmd =~ /new/){
		    print STDOUT "Pushing new object $retval onto \$object{$mod} -> $objects{$mod}\n";
		    push(@{$objects{$mod}}, $retval);
		}
#		print STDOUT "Retval is $retval\n";
		if ($pager){
		    select $ofh;
		}
		system("/bin/stty raw -echo");
	    } else {
		print STDOUT "\r\nUnknown command $cmd\r\n";
	    }
	}
    }
    $retval;
}

sub rf {
    my ($filename) = @_;

    foreach my $command (_readfromfile(undef, $filename)){
#	print STDERR "Handling: $command\n";
	_handlecommand($command);
    }
}
    

sub _readfromfile {
    my ($h, $filename) = @_;
    my @retval;

    if (grep(/\?/, @_)){
        print "Usage: readfromfile filename\n";
        return;
    }

    if (!open(IF, $filename)){
        warn "Error opening file $filename";
        return;
    }
    while (<IF>){
        chomp;
	push @retval, $_;
#	if (1 == 0){
#	    $retval = _handlecommand($_);
#	    if ($retval && $breakonerror){
#		print "Command '$_' returned $retval and breakonerror is set.  Leaving processing loop.\n";
#		last;
#	    }
#	}
    }
    close(IF);
    @retval;
}

sub _handleinit {
    my ($module) = @_;
    my $string = "~/.".$module.".rc";
    my @commands;

    while (my $initfile = glob($string)){
	print "Init file is $initfile\r\n";
	if (-f $initfile){
	    push @commands, _readfromfile(undef, $initfile);
	} else {
	    print "No init file\r\n";
	}
    }

    # Have to process all of the commands after they've been read in since the glob
    # doesn't appear to work when nested and we do that in Use....
    foreach my $command (@commands){
	_handlecommand($command);
    }
}

sub _ShowPrompt {
    my $sr = shift;
    my $id = shift;

    if ($sr->{lastwrite}){
	print STDOUT "\r" . ' 'x$sr->{lastwrite};
    }
    my $write = "\r $id- $sr->{linecursor}$sr->{inputcursor}$sr->{prompt}$sr->{input}";
    $sr->{lastwrite} = length($write);
    print STDOUT $write;
    my $diff = length($sr->{input}) - $sr->{linecursor};
#    &_DPrint("Diff = $diff\n");
    if ($diff){
	print STDOUT "\b"x$diff;
    }
}

# Open up the socket
while (!($ssocket = IO::Socket::INET->new(Proto => 'tcp',
					  Type => SOCK_STREAM,
					  LocalPort => $server_port,
					  ReuseAddr => 1,
					  Listen => 10,
					  Timeout => .1))){
    # Bummer, couldn't open the socket.  Something must have port $server_port open.
    # Try 10 times to open the socket.
    if ($count > 10){
	die "Waited too long for server port to become available...Exiting.\n";
    }
	
    # Increment the try counter.
    $count++;
    
    # Print a message
    warn "Couldn't bind to port $server_port: $OS_ERROR\n";
    $server_port++;
    
    # Wait and go around again.
#    sleep 1;
}

print STDOUT "Server listening on $server_port\n";

Introspect("main");

my $ofh = select STDIN;
$| = 1;
select $ofh;
$| = 1;

system("/bin/stty raw -echo");

_handleinit("main");

_ShowPrompt(\%state, "b");
#if (!@ARGV){
    while ($select->count()){
#	_DPrint "Going around main loop\n";
	if (my $client = $ssocket->accept()){
	    push(@clients, $client);
	}
	
	if (my @fhs = $select->can_read(.2)){
	    foreach my $fh (@fhs){
		if (eof($fh)){
		    $select->remove($fh);
		} else {
		    if (_GetInput($fh, \%state, 0)){
			_DPrint "State is " . Dumper(\%state) . "\n";
			_handlecommand($state{input}, $fh);
			$state{input} = "";
			_ShowPrompt(\%state, "c");
		    } else {
			_DPrint "No data\n";
		    }
		}
	    }
	} else {
#	_DPrint("No handles ready\n");
	}
    }
#} else {
#    while (1){
#	if (my $client = $ssocket->accept()){
#	    push(@clients, $client);
#	}
#	if (_GetInput(STDIN, \%state, 1)){
#	    _DPrint "State is " . Dumper(\%state) . "\n";
#	    _handlecommand($state{input}, $fh);
#	    $state{input} = "";
#	    _ShowPrompt(\%state, "d");
#	}
#    }
#}

system("/bin/stty \"$stty_state\"");
print STDOUT "No more handles to monitor\n";

