Fixed History to work with ReadLineHistory

This now works with *both* Term::ReadLine::Gnu (pretty much a no-op since TR::Gnu does the expansion itself before the History plugin sees the input pattern) and Term::ReadLine::Perl. At this point, I believe that History and ReadLineHistory are fully operational and hope for an official release soon.
andrefs · Jun 13, 2010 · 7845301 · 7845301
1 parent 73d11b2
commit 7845301
Show file tree

Hide file tree

Showing 4 changed files with 60 additions and 35 deletions.
diff --git a/Changes b/Changes
@@ -1,3 +1,5 @@
+1.003010_02
+  - History plugin now works for Term::ReadLine::Perl
 1.003010_01
   - Add ReadLine file completion if no other matches, fixes rt.cpan#58351
   - Add a bit more description of Turtle plugin to its POD

diff --git a/lib/Devel/REPL.pm b/lib/Devel/REPL.pm
@@ -5,7 +5,7 @@ use Moose;
 use namespace::clean -except => [ 'meta' ];
 use 5.008001; # backwards compat, doesn't warn like 5.8.1
 
-our $VERSION = '1.003010_01';
+our $VERSION = '1.003010_02';
 
 with 'MooseX::Object::Pluggable';
 

diff --git a/lib/Devel/REPL/Plugin/History.pm b/lib/Devel/REPL/Plugin/History.pm
@@ -4,49 +4,64 @@ use Devel::REPL::Plugin;
 use namespace::clean -except => [ 'meta' ];
 
 has 'history' => (
-  isa => 'ArrayRef', is => 'rw', required => 1, lazy => 1,
-  default => sub { [] }
+   isa => 'ArrayRef', is => 'rw', required => 1, lazy => 1,
+   default => sub { [] }
+);
+
+# lazy so ReadLineHistory Plugin can set this
+has 'have_readline_history' => (
+   is => 'rw', required => 1, 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;

diff --git a/lib/Devel/REPL/Plugin/ReadLineHistory.pm b/lib/Devel/REPL/Plugin/ReadLineHistory.pm
@@ -39,8 +39,16 @@ around 'run' => sub {
          close HIST;
       }
    }
-   $self->term->Attribs->{do_expand}=1;
+
+   $self->term->Attribs->{do_expand}=1;  # for Term::ReadLine::Gnu
+   $self->term->MinLine(2);              # don't save one letter commands
+
+   # let History plugin know we have Term::ReadLine support
+   $self->have_readline_history(1) if $self->can('have_readline_history');
+
+
    $self->$orig(@args);
+
    if ($self->term->ReadLine eq 'Term::ReadLine::Gnu') {
       $self->term->WriteHistory($hist_file) ||
       $self->print("warning: failed to write history file $hist_file");