history plugin for Devel::REPL

git-svn-id: http://dev.catalyst.perl.org/repos/bast/trunk/Devel-REPL@3194 bd8105ee-0ff8-0310-8827-fb3f25b6796d

diff --git a/lib/Devel/REPL/Plugin/History.pm b/lib/Devel/REPL/Plugin/History.pm
new file mode 100644 (file)
index 0000000..1c51efb
--- /dev/null
+++ b/lib/Devel/REPL/Plugin/History.pm
@@ -0,0 +1,51 @@
+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);
+}
+
+around 'read' => sub {
+  my $orig = shift;
+  my ($self, @args) = @_;
+  my $line = $self->$orig(@args);
+  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);
+    }
+  }
+  return $line;
+};
+
+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;
+};
+
+1;