#!/usr/local/bin/perl

# Simple shell for PDL 

unshift @INC, "./blib"; 
print <<'EOD';

perlDL shell v1.02 by Karl Glazebrook [kgb@aaoepp.aao.gov.au] 11 Nov 1996

EOD

$PERLDL_ESCAPE = '#'; # Default shell escape

$Modules = "";

if ($ARGV[0] eq "-oo") {
   shift @ARGV; $OO++;
   print "Starting Object-Oriented perlDL\n";
}

if ($OO) {
   eval "use PDL::OO"; 
}else{
   eval "use PDL";
}
  
if ($@ eq "") {
   $PDL_OK = 1;
   print "Loaded PDL v$PDL::VERSION   ";
}else{
   $PDL_OK = 0;
   warn "WARNING: PDL module not found only plain perl available\n";
}

eval "use Term::ReadLine"; 

$readlines = ($@ eq "");

print "ReadLines enabled" if $readlines;

print "\n";

$prompt = "perldl> ";

$term = new Term::ReadLine 'perlDL', \*STDIN, \*STDOUT if $readlines;

$,=" "; # Default

$PDL::verbose = 1; # Make PDL functions waffle

# Global and local startup

for ($ENV{'HOME'}."/.perldlrc", 'local.perldlrc') {
    next unless -e $_;
    print "Reading $_ ...\n";
    require $_ ;
}

$SIG{'INT'} = sub {print "Ctrl-C detected\n"; goto restart}; # Ctrl-C handler
  
$|=1;
while(1) {

restart:

     $sep = $,; $,=""; # Save

     if ($readlines) {
         $_ = $term->readline($prompt);
     }else{
         print $prompt; $_ = <>;
     }
     $,=$sep; #Restore 

     next if /^\s*$/; # Blank line - do nothing

     if (substr($_,0,1) eq substr($PERLDL_ESCAPE,0,1)) { 
        system(substr($_,1)); # Shell escape
        next;
     }else{
        if ($PDL_OK) {
            $code = eval <<"EOD";  # Create code ref
sub {
   $_;
}
EOD
	    %@ = (); # Workaround to prevent spurious loss of $@
            PDL::Core::myeval( $code ); # Do command with $@ keeping
        }else{
            eval $_;
        }
     }
     if ($@) {
         $mess = $@; 

         # Remove surplus parts

         $mess =~ s/^\s*\(in cleanup\)\s+//;   # 'cleanup ...' from Usage:...
         $mess =~ s/\n\s*\(in cleanup\).*$//;  # 'cleanup...'s at end
         $mess =~ s/\s+at \(eval \d+\) line \d+\.?$//; # at eval ?? line ??.

         warn $mess;  # Report error
     }else{
         print "\n";
     }
}


# Short hand for print

sub p {
    print(@_);
}

