increment $VERSION after 1.003029 release
[p5sagit/Devel-REPL.git] / lib / Devel / REPL / Plugin / Turtles.pm
CommitLineData
1716b200 1use strict;
2use warnings;
e958cbc6 3package Devel::REPL::Plugin::Turtles;
9d2a4940 4# ABSTRACT: Generic command creation using a read hook
e22aa835 5
77327851 6our $VERSION = '1.003030';
54beb05d 7
6f4f9516 8use Devel::REPL::Plugin;
e22aa835 9use Scalar::Util qw(reftype);
aa8b7647 10use namespace::autoclean;
e958cbc6 11
e22aa835 12has default_command_prefix => (
13 isa => "RegexpRef",
14 is => "rw",
15 default => sub { qr/\#/ },
16);
17
18has turtles_matchers => (
78bc5721 19 traits => ['Array'],
e22aa835 20 isa => "ArrayRef[RegexpRef|CodeRef]",
21 is => "rw",
4ea2c254 22 lazy => 1,
e22aa835 23 default => sub { my $prefix = shift->default_command_prefix; [qr/^ $prefix (\w+) \s* (.*) /x] },
8bf72450 24 handles => {
25 add_turtles_matcher => 'unshift',
e22aa835 26 },
27);
28
29around 'formatted_eval' => sub {
0cbfa921 30 my $next = shift;
e22aa835 31 my ($self, $line, @args) = @_;
0cbfa921 32
e22aa835 33 if ( my ( $command, @rest ) = $self->match_turtles($line) ) {
0cbfa921 34 my $method = "command_$command";
e22aa835 35 my $expr_method = "expr_$method";
0cbfa921 36
e22aa835 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);
40 }
41 $self->$expr_code($next, @rest);
42 } elsif ( my $cmd_code = $self->can($method) ) {
43 return $self->$cmd_code($next, @rest);
0cbfa921 44 } else {
e22aa835 45 unless ( $line =~ /^\s*#/ ) { # special case for comments
46 return $self->format($self->error_return("REPL Error", "Command '$command' does not exist"));
47 }
e958cbc6 48 }
e22aa835 49 } else {
50 return $self->$next($line, @args);
0cbfa921 51 }
e958cbc6 52};
53
e22aa835 54sub match_turtles {
55 my ( $self, $line ) = @_;
56
57 foreach my $thingy ( @{ $self->turtles_matchers } ) {
58 if ( reftype $thingy eq 'CODE' ) {
59 if ( my @res = $self->$thingy($line) ) {
60 return @res;
61 }
62 } else {
63 if ( my @res = ( $line =~ $thingy ) ) {
64 return @res;
65 }
66 }
67 }
68
69 return;
70}
71
48ddfeae 721;
cfd1094b 73
74__END__
75
9d2a4940 76=pod
cfd1094b 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