Writing a perl REPL part 2 - a history plugin
So, last time we got from scratch to a basically working simple perl REPL. So now it's time to start writing plugins, since currently it's disturbingly basic and only really useful for ... well, for making a blog post about how it works at all :)
First, we should probably provide some history so we take advantage of the readline goodness available. This is, fortunately, going to be trivially simple, but I'm going to digress slightly before that and explain how our plugin system works. When you call the ->load_plugin method on the repl object with a plugin name, it searches for an installed module called Devel::REPL::Plugin::NameOfPlugin, which it expects to be a Moose Role. The basic concept of a role is 'a mixin on steroids' - not only can you provide methods but method modifiers, which are AOP-style before/after/around advice functions. If none of that made any sense, you'll see it in action in a moment.
Once the plugin has been loaded, it's composed into the current -object-, not the current class. Devel::REPL itself is unchanged, what MooseX::Object::Pluggable does is automatically create an anonymous subclass and move the Devel::REPL object into that (similar to ruby's singleton objects, I believe), then adds the role to that. This means we can have more than one object of our class with different plugins attached - probably not that useful just yet for a REPL but a nice feature to have, especially since I plan to start doing Devel::REPL development from within Devel::REPL as soon as I can.
Now, Term::Readline gives you automagic history handling, but it'd be really nice to have a way to display history lines ourselves and to fire previous commands quickly without hammering the up key. So, without further ado, it's time for Devel::REPL::Plugin::History. Here's lib/Devel/REPL/Plugin/History.pm -
package Devel::REPL::Plugin::History;
use Moose::Role;
has 'history' => (
isa => 'ArrayRef', is => 'rw', required => 1, lazy => 1,
default => sub { [] }
);sub push_history {
my ($self, $line) = @_;
push(@{$self->history}, $line);
}
Again, 'use Moose::Role' saves us needing strict and warnings. Roles can add attributes too, so we define our history attribute here to hold the history line list.
This time we -do- set a type constraint because it's important that everything can assume the history is an array reference - although there's no need to specify what the array contains. The one interesting part is specifying lazy on the attribute - were this a normal class or role there'd be no reason for it since the default value isn't dependent on anything else, but since this is a plugin designed to be added to an object -after- new() (construction) time the default wouldn't fire, so instead we make it lazy so it gets called on first get, just like out_fh in Devel::REPL itself.
The push_history method is pretty trivial, the @{$self->history} deferences the arrayref so 'push' can shove the line onto the end. The principle reason for making this a standalone method is to provide a hook for other plugin authors to use to wrap the process - maybe they'll want to log the history to a file as well, or throw away lines once there's 500 in the history (which bash does in most default configs).
Now we need to hook this method into the processing, and add a little magic for some extra syntax -
around 'read' => sub {
my $orig = shift;
my ($self, @args) = @_;
my $line = $self->$orig(@args);
The 'around' type of method modifier wraps all calls to the method of the same name in the class itself (there's also an 'override' type which provides some extra sugar but is designed for classes, not roles). It's special in that it provides an extra argument on the front which is a reference to the original method, so we shift that off the argument list first (list operations in perl default to @_ to save us typing for this sort of thing). Then, we grab the object and any arguments, pulling them into an @args list since we neither know nor care what they are, and call the original method to get the line. The $self->$orig trick is one of the beauties of perl - you can provide a variable containing -either- a method name or a reference to the sub implementing the method and perl Does The Right Thing (tm).
if (defined $line) {
if ($line =~ m/^!(.*)$/) {
my $call = $1;
$line = $self->history_call($call);
if (defined $line) {
$self->print($line."\n");
} else {
return "'Unable to find ${call} in history'";
}
}
if ($line =~ m/\S/) {
$self->push_history($line);
}
}
if ($line =~ m/\S/) {
$self->push_history($line);
}
}
return $line;
};
If the line's undef we're about to leave the repl, so we skip our processing. Then we check for !-style history requests and if so we filter the line -without- the ! through the history_call method and print the line that's been substituted from the history for reference if present, or return an error string if not. Next, if the line contains anything but whitespace (\S inverts the \s whitespace regexp match group) we add it to the history before returning it.
Note the semicolon after the closing } - this is required with method modifier declarations to end the statement since they aren't normal perl sub definitions - in fact they're implemented in terms of a sub call, so theoretically could take extra arguments albeit those provided by Moose don't.
Finally, we need to implement history_call -
sub history_call {
my ($self, $call) = @_;
if ($call =~ m/^(-?\d+)$/) { # handle !1 or !-1
my $idx = $1;
$idx-- if ($idx > 0); # !1 gets history element 0
my $line = $self->history->[$idx];
return $line;
}
my $re = qr/^\Q${call}\E/;
foreach my $line (reverse @{$self->history}) {
return $line if ($line =~ $re);
}
return;
}
The only interesting bit in the first part is the $idx-- if ($idx > 0) statement, since perl arrays can already handle
$x[2]; # third element
$x[-2]; # last but one element
but of course the tradition in shells is !1 should be the first history line rather than !0. $self->history->[$idx] then uses this, taking advantage of arrayref derefence via -> along the way.
Then the second part handles the !search style (I could have put this in an else but I prefer to have something for a sub to fall through to in case of weirdness and at least one return to be at top level - stylistic only); qr is 'quote regex' which makes $re a re-usable compiled regex object, done here for clarity rather than the usual performance reasons, \Q and \E disable and then enable regex metacharacters so a . or * in $call isn't misinterpreted.
So, not bothering to document the final 1; for a second time, here's a session with the plugin -
cain$ perl -Ilib -MDevel::REPL -e 'my $repl = Devel::REPL->new; $repl->load_plugin("History"); $repl->run;'
$ 1;
1
$ int(1.5);
1
$ (1..3);
1 2 3
$ !-1
(1..3);
1 2 3
$ !1
1;
1
$ !-30
Unable to find -30 in history
$ !int
int(1.5);
1
$ !foo
Unable to find foo in history
... so, check in the completed code, and I think we're about done for this iteration. Next time we'll look at adding lexical persistence so 'my' variables persist between calls. And maybe I'll finally get as far as sorting out my e-mail :)