Commit | Line | Data |
1716b200 |
1 | use strict; |
2 | use warnings; |
e958cbc6 |
3 | package Devel::REPL::Plugin::Turtles; |
9d2a4940 |
4 | # ABSTRACT: Generic command creation using a read hook |
e22aa835 |
5 | |
c45376f3 |
6 | our $VERSION = '1.003029'; |
54beb05d |
7 | |
6f4f9516 |
8 | use Devel::REPL::Plugin; |
e22aa835 |
9 | use Scalar::Util qw(reftype); |
aa8b7647 |
10 | use namespace::autoclean; |
e958cbc6 |
11 | |
e22aa835 |
12 | has default_command_prefix => ( |
13 | isa => "RegexpRef", |
14 | is => "rw", |
15 | default => sub { qr/\#/ }, |
16 | ); |
17 | |
18 | has 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 | |
29 | around '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 |
54 | sub 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 |
72 | 1; |
cfd1094b |
73 | |
74 | __END__ |
75 | |
9d2a4940 |
76 | =pod |
cfd1094b |
77 | |
79e70b9c |
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 | |
cfd1094b |
92 | =cut |