PDL::Perldl2::Plugin::PDLCommands - implement perldl aliases/escapes

package PDL::Perldl2::Plugin::PDLCommands;

use Devel::REPL::Plugin;

use namespace::clean -except => [ 'meta' ];

# The atomic option---need to deconflict Turtle command injection
# using qr{\#} and perldl's usage for command escapes.  Just
# exclude for now to get things working
excludes 'Turtles';

around 'read' => sub {

   my $orig = shift;
   my ($self, @args) = @_;

   # using $lines here because that is the usage from perldl
   # and I want to cut and paste existing code if possible
   my $lines = $self->$orig(@args);

   # Execute the list of auto-code  (TODO)
   ## for my $c (@PERLDL::AUTO) {
   ##     my $mess = eval_and_report($c);
   ##     warn $mess if $mess;
   ## }

   # filter out default PDL shell prompt for easier
   # cut-and-paste of demo code
   $lines =~ s/\s*(?:pdl|perldl)>\s*//i if defined $lines;

   return $lines unless defined $lines;

   # print STDERR "PDLCommands: got '$lines'\n";
   if ( lc $lines eq 'q' || lc $lines eq 'x' || lc $lines eq 'exit' ) { return "quit"; };

   $lines =~ s/^\s*\?\?\s*/apropos /; # Make '??' = 'apropos'
   $lines =~ s/^\s*\?\s*/help /;      # Make lone '?' = 'help'

   if ( $lines =~ /^\s*(help|usage|apropos|sig|badinfo|demo)\s+/) { # Allow help foo (no quotes)
      my @t = split(/\s+/,$lines);
      my $a;
      foreach $a(@t) { $a=~s/^["']+//; $a=~s/['"]+$//; };
      $t[1] = "'".$t[1]."'"  if ($#t == 1 && !($t[1] =~ /^\$/));
      $lines = join(' ',@t);
   }

   $PERLDL::ESCAPE = $PERLDL::ESCAPE if defined $PERLDL::ESCAPE;
   if (substr($lines,0,1) eq substr($PERLDL::ESCAPE,0,1) and
      substr($lines,0,2) ne '#!') {  # Allow escapes, avoid shebang
      my @lines = split /\n/, $lines;
      system(substr(shift @lines,1)); # Shell escape
      $lines = join("\n",@lines);
   }

   return $lines;
};

1;

__END__