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