1 package Devel::REPL::Plugin::Turtles;
2 use Devel::REPL::Plugin;
4 use Scalar::Util qw(reftype);
6 use MooseX::AttributeHelpers;
8 use namespace::clean -except => [ 'meta' ];
10 has default_command_prefix => (
13 default => sub { qr/\#/ },
16 has turtles_matchers => (
17 metaclass => "Collection::Array",
18 isa => "ArrayRef[RegexpRef|CodeRef]",
20 default => sub { my $prefix = shift->default_command_prefix; [qr/^ $prefix (\w+) \s* (.*) /x] },
22 unshift => "add_turtles_matcher",
26 around 'formatted_eval' => sub {
28 my ($self, $line, @args) = @_;
30 if ( my ( $command, @rest ) = $self->match_turtles($line) ) {
31 my $method = "command_$command";
32 my $expr_method = "expr_$method";
34 if ( my $expr_code = $self->can($expr_method) ) {
35 if ( my $read_more = $self->can("continue_reading_if_necessary") ) {
36 push @rest, $self->$read_more(pop @rest);
38 $self->$expr_code($next, @rest);
39 } elsif ( my $cmd_code = $self->can($method) ) {
40 return $self->$cmd_code($next, @rest);
42 unless ( $line =~ /^\s*#/ ) { # special case for comments
43 return $self->format($self->error_return("REPL Error", "Command '$command' does not exist"));
47 return $self->$next($line, @args);
52 my ( $self, $line ) = @_;
54 foreach my $thingy ( @{ $self->turtles_matchers } ) {
55 if ( reftype $thingy eq 'CODE' ) {
56 if ( my @res = $self->$thingy($line) ) {
60 if ( my @res = ( $line =~ $thingy ) ) {
75 Devel::REPL::Plugin::Turtles - Generic command creation using a read hook