3 package Devel::REPL::Plugin::Turtles;
4 # ABSTRACT: Generic command creation using a read hook
6 our $VERSION = '1.003028';
8 use Devel::REPL::Plugin;
9 use Scalar::Util qw(reftype);
10 use namespace::autoclean;
12 has default_command_prefix => (
15 default => sub { qr/\#/ },
18 has turtles_matchers => (
20 isa => "ArrayRef[RegexpRef|CodeRef]",
23 default => sub { my $prefix = shift->default_command_prefix; [qr/^ $prefix (\w+) \s* (.*) /x] },
25 add_turtles_matcher => 'unshift',
29 around 'formatted_eval' => sub {
31 my ($self, $line, @args) = @_;
33 if ( my ( $command, @rest ) = $self->match_turtles($line) ) {
34 my $method = "command_$command";
35 my $expr_method = "expr_$method";
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);
41 $self->$expr_code($next, @rest);
42 } elsif ( my $cmd_code = $self->can($method) ) {
43 return $self->$cmd_code($next, @rest);
45 unless ( $line =~ /^\s*#/ ) { # special case for comments
46 return $self->format($self->error_return("REPL Error", "Command '$command' does not exist"));
50 return $self->$next($line, @args);
55 my ( $self, $line ) = @_;
57 foreach my $thingy ( @{ $self->turtles_matchers } ) {
58 if ( reftype $thingy eq 'CODE' ) {
59 if ( my @res = $self->$thingy($line) ) {
63 if ( my @res = ( $line =~ $thingy ) ) {
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.
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.