lib/Devel/REPL/Plugin/History.pm

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