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