lib/Devel/REPL/Plugin/Turtles.pm

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