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