lib/Devel/REPL/Plugin/History.pm

   1 use strict;
   2 use warnings;
   3 package Devel::REPL::Plugin::History;
   4 # ABSTRACT: Keep track of all input, provide shortcuts !1, !-1
   5
   6 our $VERSION = '1.003029';
   7
   8 use Devel::REPL::Plugin;
   9 use namespace::autoclean;
  10
  11 has 'history' => (
  12    isa => 'ArrayRef', is => 'rw',
  13    lazy => 1,
  14    default => sub { [] }
  15 );
  16
  17 # lazy so ReadLineHistory Plugin can set this
  18 has 'have_readline_history' => (
  19    is => 'rw',
  20    lazy => 1,
  21    default => sub { 0 }
  22 );
  23
  24 sub push_history {
  25    my ($self, $line) = @_;
  26    # Push history is not needed if we have Term::ReadLine
  27    # support.  We put the test inside push_history() in case
  28    # someone has modified it in their code.
  29    if ($self->have_readline_history) {
  30       # update history to keep consistent with Term::ReadLine
  31       $self->history( [ $self->term->GetHistory ] );
  32    } else {
  33       # not used with Term::ReadLine history support
  34       push(@{$self->history}, $line);
  35    }
  36 }
  37
  38 around 'read' => sub {
  39    my $orig = shift;
  40    my ($self, @args) = @_;
  41    my $line = $self->$orig(@args);
  42    if (defined $line) {
  43       if ($line =~ m/^!(.*)$/) {
  44          my $call = $1;
  45          $line = $self->history_call($call);
  46          if (defined $line) {
  47             $self->print($line."\n");
  48          } else {
  49             return "'Unable to find ${call} in history'";
  50          }
  51       }
  52       if ($line =~ m/\S/) {
  53          $self->push_history($line);
  54       }
  55    }
  56    return $line;
  57 };
  58
  59 sub history_call {
  60    my ($self, $call) = @_;
  61    if ($call =~ m/^(-?\d+)$/) { # handle !1 or !-1
  62       my $idx = $1;
  63       $idx-- if ($idx > 0); # !1 gets history element 0
  64       my $line = $self->history->[$idx];
  65       return $line;
  66    }
  67    my $re = qr/^\Q${call}\E/;
  68    foreach my $line (reverse @{$self->history}) {
  69       return $line if ($line =~ $re);
  70    }
  71    return;
  72 };
  73
  74 1;