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 MooseX::AttributeHelpers;
   7
   8 use namespace::clean -except => [ 'meta' ];
   9
  10 has default_command_prefix => (
  11   isa => "RegexpRef",
  12   is  => "rw",
  13   default => sub { qr/\#/ },
  14 );
  15
  16 has turtles_matchers => (
  17   metaclass => "Collection::Array",
  18   isa => "ArrayRef[RegexpRef|CodeRef]",
  19   is  => "rw",
  20   default => sub { my $prefix = shift->default_command_prefix; [qr/^ $prefix (\w+) \s* (.*) /x] },
  21   provides => {
  22     unshift => "add_turtles_matcher",
  23   },
  24 );
  25
  26 around 'formatted_eval' => sub {
  27   my $next = shift;
  28   my ($self, $line, @args) = @_;
  29
  30   if ( my ( $command, @rest ) = $self->match_turtles($line) ) {
  31     my $method = "command_$command";
  32     my $expr_method = "expr_$method";
  33
  34     if ( my $expr_code = $self->can($expr_method) ) {
  35       if ( my $read_more = $self->can("continue_reading_if_necessary") ) {
  36         push @rest, $self->$read_more(pop @rest);
  37       }
  38       $self->$expr_code($next, @rest);
  39     } elsif ( my $cmd_code = $self->can($method) ) {
  40       return $self->$cmd_code($next, @rest);
  41     } else {
  42       unless ( $line =~ /^\s*#/ ) { # special case for comments
  43         return $self->format($self->error_return("REPL Error", "Command '$command' does not exist"));
  44       }
  45     }
  46   } else {
  47     return $self->$next($line, @args);
  48   }
  49 };
  50
  51 sub match_turtles {
  52   my ( $self, $line ) = @_;
  53
  54   foreach my $thingy ( @{ $self->turtles_matchers } ) {
  55     if ( reftype $thingy eq 'CODE' ) {
  56       if ( my @res = $self->$thingy($line) ) {
  57         return @res;
  58       }
  59     } else {
  60       if ( my @res = ( $line =~ $thingy ) ) {
  61         return @res;
  62       }
  63     }
  64   }
  65
  66   return;
  67 }
  68
  69 1;
  70
  71 __END__
  72
  73 =head1 NAME
  74
  75 Devel::REPL::Plugin::Turtles - Generic command creation using a read hook
  76
  77 =cut
  78