lib/Devel/REPL/Plugin/Turtles.pm

   1 package Devel::REPL::Plugin::Turtles;
   2 use Devel::REPL::Plugin;
   3
   4 use Scalar::Util qw(reftype);
   5
   6 use namespace::sweep;
   7 use MooX::Types::MooseLike::Base qw(RegexpRef ArrayRef CodeRef AnyOf);
   8
   9 has default_command_prefix => (
  10   isa => RegexpRef,
  11   is  => "rw",
  12   lazy => 1,
  13   default => sub { qr/\#/ },
  14 );
  15
  16 has turtles_matchers => (
  17   isa => ArrayRef[AnyOf[RegexpRef,CodeRef]],
  18   is  => "rw",
  19   lazy => 1,
  20   default => sub {
  21       my $prefix = shift->default_command_prefix; [qr/^ $prefix (\w+) \s* (.*) /x]
  22   },
  23 );
  24
  25 sub add_turtles_matcher {
  26   my $self = shift;
  27   unshift @{$self->turtles_matchers}, @_;
  28 }
  29
  30 around 'formatted_eval' => sub {
  31   my $next = shift;
  32   my ($self, $line, @args) = @_;
  33
  34   if ( my ( $command, @rest ) = $self->match_turtles($line) ) {
  35     my $method = "command_$command";
  36     my $expr_method = "expr_$method";
  37
  38     if ( my $expr_code = $self->can($expr_method) ) {
  39       if ( my $read_more = $self->can("continue_reading_if_necessary") ) {
  40         push @rest, $self->$read_more(pop @rest);
  41       }
  42       $self->$expr_code($next, @rest);
  43     } elsif ( my $cmd_code = $self->can($method) ) {
  44       return $self->$cmd_code($next, @rest);
  45     } else {
  46       unless ( $line =~ /^\s*#/ ) { # special case for comments
  47         return $self->format($self->error_return("REPL Error", "Command '$command' does not exist"));
  48       }
  49     }
  50   } else {
  51     return $self->$next($line, @args);
  52   }
  53 };
  54
  55 sub match_turtles {
  56   my ( $self, $line ) = @_;
  57
  58   foreach my $thingy ( @{ $self->turtles_matchers } ) {
  59     if ( reftype $thingy eq 'CODE' ) {
  60       if ( my @res = $self->$thingy($line) ) {
  61         return @res;
  62       }
  63     } else {
  64       if ( my @res = ( $line =~ $thingy ) ) {
  65         return @res;
  66       }
  67     }
  68   }
  69
  70   return;
  71 }
  72
  73 1;
  74
  75 __END__
  76
  77 =head1 NAME
  78
  79 Devel::REPL::Plugin::Turtles - Generic command creation using a read hook
  80
  81 =head1 DESCRIPTION
  82
  83 By default, this plugin allows calling commands using a read hook
  84 to detect a default_command_prefix followed by the command name,
  85 say MYCMD as an example.  The actual routine to call for the
  86 command is constructed by looking for subs named 'command_MYCMD'
  87 or 'expr_MYCMD' and executing them.
  88
  89 =head2 NOTE
  90
  91 The C<default_command_prefix> is C<qr/\#/> so care must be taken
  92 if other uses for that character are needed (e.g., '#' for the
  93 shell escape character in the PDL shell.
  94
  95 =cut
  96