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