Add a bit more description of Turtle plugin.
[p5sagit/Devel-REPL.git] / 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   lazy => 1,
21   default => sub { my $prefix = shift->default_command_prefix; [qr/^ $prefix (\w+) \s* (.*) /x] },
22   provides => {
23     unshift => "add_turtles_matcher",
24   },
25 );
26
27 around 'formatted_eval' => sub {
28   my $next = shift;
29   my ($self, $line, @args) = @_;
30
31   if ( my ( $command, @rest ) = $self->match_turtles($line) ) {
32     my $method = "command_$command";
33     my $expr_method = "expr_$method";
34
35     if ( my $expr_code = $self->can($expr_method) ) {
36       if ( my $read_more = $self->can("continue_reading_if_necessary") ) {
37         push @rest, $self->$read_more(pop @rest);
38       }
39       $self->$expr_code($next, @rest);
40     } elsif ( my $cmd_code = $self->can($method) ) {
41       return $self->$cmd_code($next, @rest);
42     } else {
43       unless ( $line =~ /^\s*#/ ) { # special case for comments
44         return $self->format($self->error_return("REPL Error", "Command '$command' does not exist"));
45       }
46     }
47   } else {
48     return $self->$next($line, @args);
49   }
50 };
51
52 sub match_turtles {
53   my ( $self, $line ) = @_;
54
55   foreach my $thingy ( @{ $self->turtles_matchers } ) {
56     if ( reftype $thingy eq 'CODE' ) {
57       if ( my @res = $self->$thingy($line) ) {
58         return @res;
59       }
60     } else {
61       if ( my @res = ( $line =~ $thingy ) ) {
62         return @res;
63       }
64     }
65   }
66
67   return;
68 }
69
70 1;
71
72 __END__
73
74 =head1 NAME
75
76 Devel::REPL::Plugin::Turtles - Generic command creation using a read hook
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
93