lib/Devel/REPL/Plugin/Turtles.pm

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