lib/Devel/REPL/Plugin/History.pm

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