X-Git-Url: http://git.shadowcat.co.uk/gitweb/gitweb.cgi?p=p5sagit%2FDevel-REPL.git;a=blobdiff_plain;f=lib%2FDevel%2FREPL%2FPlugin%2FTurtles.pm;h=5f323fe6e595704fee0dc7e34c2cf9a692711bdb;hp=4ab7eab72506b4c9cc5271a1b5f126c95183e9f9;hb=78bc57212a47f1f64aa47ea8fd25b6f91b809bf3;hpb=0cbfa9217cbe7714e72b92abc05ed8b21bc46f00

diff --git a/lib/Devel/REPL/Plugin/Turtles.pm b/lib/Devel/REPL/Plugin/Turtles.pm
index 4ab7eab..5f323fe 100644
--- a/lib/Devel/REPL/Plugin/Turtles.pm
+++ b/lib/Devel/REPL/Plugin/Turtles.pm
@@ -1,26 +1,91 @@
 package Devel::REPL::Plugin::Turtles;
-use Moose::Role;
-use namespace::clean -except => [ 'meta' ];
+use Devel::REPL::Plugin;
 
-around 'eval' => sub {
+use Scalar::Util qw(reftype);
+
+use namespace::autoclean;
+
+has default_command_prefix => (
+  isa => "RegexpRef",
+  is  => "rw",
+  default => sub { qr/\#/ },
+);
+
+has turtles_matchers => (
+  traits => ['Array'],
+  isa => "ArrayRef[RegexpRef|CodeRef]",
+  is  => "rw",
+  lazy => 1,
+  default => sub { my $prefix = shift->default_command_prefix; [qr/^ $prefix (\w+) \s* (.*) /x] },
+  handles => {
+    add_turtles_matcher => 'unshift',
+  },
+);
+
+around 'formatted_eval' => sub {
   my $next = shift;
-  my ($self, $line) = @_;
-  if ( my ( $command, $rest ) = ( $line =~ /^#(\w+)\s*(.*)/ ) ) {
-    if ( my $cont = $self->can("continue_reading_if_necessary") ) {
-      $rest = $self->$cont($rest);
-    }
+  my ($self, $line, @args) = @_;
 
+  if ( my ( $command, @rest ) = $self->match_turtles($line) ) {
     my $method = "command_$command";
+    my $expr_method = "expr_$method";
 
-    if ( $self->can($method) ) {
-      return $self->$method($rest);
+    if ( my $expr_code = $self->can($expr_method) ) {
+      if ( my $read_more = $self->can("continue_reading_if_necessary") ) {
+        push @rest, $self->$read_more(pop @rest);
+      }
+      $self->$expr_code($next, @rest);
+    } elsif ( my $cmd_code = $self->can($method) ) {
+      return $self->$cmd_code($next, @rest);
     } else {
-      return $self->error_return("REPL error", "Command '$command' does not exist");
+      unless ( $line =~ /^\s*#/ ) { # special case for comments
+        return $self->format($self->error_return("REPL Error", "Command '$command' does not exist"));
+      }
     }
-  }
-  else {
-    return $next->($self, $line);
+  } else {
+    return $self->$next($line, @args);
   }
 };
 
+sub match_turtles {
+  my ( $self, $line ) = @_;
+
+  foreach my $thingy ( @{ $self->turtles_matchers } ) {
+    if ( reftype $thingy eq 'CODE' ) {
+      if ( my @res = $self->$thingy($line) ) {
+        return @res;
+      }
+    } else {
+      if ( my @res = ( $line =~ $thingy ) ) {
+        return @res;
+      }
+    }
+  }
+
+  return;
+}
+
 1;
+
+__END__
+
+=head1 NAME
+
+Devel::REPL::Plugin::Turtles - Generic command creation using a read hook
+
+=head1 DESCRIPTION
+
+By default, this plugin allows calling commands using a read hook
+to detect a default_command_prefix followed by the command name,
+say MYCMD as an example.  The actual routine to call for the
+command is constructed by looking for subs named 'command_MYCMD'
+or 'expr_MYCMD' and executing them.
+
+=head2 NOTE
+
+The C<default_command_prefix> is C<qr/\#/> so care must be taken
+if other uses for that character are needed (e.g., '#' for the
+shell escape character in the PDL shell.
+
+=cut
+