X-Git-Url: http://git.shadowcat.co.uk/gitweb/gitweb.cgi?p=p5sagit%2FDevel-REPL.git;a=blobdiff_plain;f=lib%2FDevel%2FREPL%2FPlugin%2FHistory.pm;h=2696e191094b820e8bbadaf2d5e4484f13402f5d;hp=e3de1529b309068a369aba810b2fa862104b0bfc;hb=b595a818b1d89dbea55ace1af86d0df91c97ba0c;hpb=6a5409bc859187db7d7553e4c19a559aeeba6430

diff --git a/lib/Devel/REPL/Plugin/History.pm b/lib/Devel/REPL/Plugin/History.pm
index e3de152..2696e19 100644
--- a/lib/Devel/REPL/Plugin/History.pm
+++ b/lib/Devel/REPL/Plugin/History.pm
@@ -1,52 +1,69 @@
 package Devel::REPL::Plugin::History;
 
 use Devel::REPL::Plugin;
-use namespace::clean -except => [ 'meta' ];
+use namespace::autoclean;
 
 has 'history' => (
-  isa => 'ArrayRef', is => 'rw', required => 1, lazy => 1,
-  default => sub { [] }
+   isa => 'ArrayRef', is => 'rw',
+   lazy => 1,
+   default => sub { [] }
+);
+
+# lazy so ReadLineHistory Plugin can set this
+has 'have_readline_history' => (
+   is => 'rw',
+   lazy => 1,
+   default => sub { 0 }
 );
 
 sub push_history {
-  my ($self, $line) = @_;
-  push(@{$self->history}, $line);
+   my ($self, $line) = @_;
+   # Push history is not needed if we have Term::ReadLine
+   # support.  We put the test inside push_history() in case
+   # someone has modified it in their code.
+   if ($self->have_readline_history) {
+      # update history to keep consistent with Term::ReadLine
+      $self->history( [ $self->term->GetHistory ] );
+   } else {
+      # not used with Term::ReadLine history support
+      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'";
+   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);
       }
-    }
-    if ($line =~ m/\S/) {
-      $self->push_history($line);
-    }
-  }
-  return $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;
+   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;