lib/Devel/REPL/Plugin/ReadLineHistory.pm

   1 # First cut at using the readline history directly rather than reimplementing
   2 # it. It does save history but it's a little crappy; still playing with it ;)
   3 #
   4 # epitaph, 22nd April 2007
   5
   6 package Devel::REPL::Plugin::ReadLineHistory;
   7
   8 use Devel::REPL::Plugin;
   9 use File::HomeDir;
  10 use File::Spec;
  11
  12 my $hist_file = $ENV{PERLREPL_HISTFILE} ||
  13     File::Spec->catfile(File::HomeDir->my_home, '.perlreplhist');
  14
  15 # HISTLEN should probably be in a config file to stop people accidentally
  16 # truncating their history if they start the program and forget to set
  17 # PERLREPL_HISTLEN
  18 my $hist_len=$ENV{PERLREPL_HISTLEN} || 100;
  19
  20 around 'run' => sub {
  21    my $orig=shift;
  22    my ($self, @args)=@_;
  23    if ($self->term->ReadLine eq 'Term::ReadLine::Gnu') {
  24       $self->term->stifle_history($hist_len);
  25    }
  26    if ($self->term->ReadLine eq 'Term::ReadLine::Perl') {
  27       $self->term->Attribs->{MaxHistorySize} = $hist_len;
  28    }
  29    if (-f($hist_file)) {
  30       if ($self->term->ReadLine eq 'Term::ReadLine::Gnu') {
  31          $self->term->ReadHistory($hist_file);
  32       }
  33       if ($self->term->ReadLine eq 'Term::ReadLine::Perl') {
  34          open HIST, $hist_file or die "ReadLineHistory: could not open $hist_file: $!\n";
  35          while (my $line = <HIST>) {
  36             chomp $line;
  37             $self->term->addhistory($line);
  38          }
  39          close HIST;
  40       }
  41    }
  42
  43    $self->term->Attribs->{do_expand}=1;  # for Term::ReadLine::Gnu
  44    $self->term->MinLine(2);              # don't save one letter commands
  45
  46    # let History plugin know we have Term::ReadLine support
  47    $self->have_readline_history(1) if $self->can('have_readline_history');
  48
  49
  50    $self->$orig(@args);
  51
  52    if ($self->term->ReadLine eq 'Term::ReadLine::Gnu') {
  53       $self->term->WriteHistory($hist_file) ||
  54       $self->print("warning: failed to write history file $hist_file");
  55    }
  56    if ($self->term->ReadLine eq 'Term::ReadLine::Perl') {
  57       my @lines = $self->term->GetHistory() if $self->term->can('GetHistory');
  58       if( open HIST, ">$hist_file" ) {
  59          print HIST join("\n",@lines);
  60          close HIST;
  61       } else {
  62          $self->print("warning: unable to WriteHistory to $hist_file");
  63       }
  64    }
  65 };
  66
  67 1;
  68
  69 __END__
  70
  71 =head1 NAME
  72
  73 Devel::REPL::Plugin::ReadLineHistory - Integrate history with the facilities provided by L<Term::ReadLine>
  74
  75 =head1 DESCRIPTION
  76
  77 This plugin enables loading and saving command line history from
  78 a file as well has history expansion of previous commands using
  79 the !-syntax a la bash.
  80
  81 By default, history expansion is enabled with this plugin when
  82 using L<Term::ReadLine::Gnu|Term::ReadLine::Gnu>. That means that
  83 "loose" '!' characters will be treated as history events which
  84 may not be what you wish.
  85
  86 To avoid this, you need to quote the '!' with '\':
  87
  88   my $var = "foo\!";
  89
  90 or place the arguments in single quotes---but enable the
  91 C<Term::ReadLine> attribute C<history_quotes_inhibit_expansion>:
  92
  93   $_REPL->term->Attribs->{history_quotes_inhibit_expansion} = 1;
  94   my $var = 'foo!';
  95
  96 and to disable history expansion from GNU readline/history do
  97
  98   $_REPL->term->Attribs->{do_expand} = 0;
  99
 100 =head1 CONFLICTS
 101
 102 Note that Term::ReadLine::Perl does not support a history
 103 expansion method.  In that case, you may wish to use the
 104 Devel::REPL History plugin which provides similar functions.
 105 Work is underway to make use of either History or
 106 ReadLineHistory consistent for expansion with either the
 107 Term::ReadLine::Gnu support or Term::ReadLine::Perl.
 108
 109 =cut
 110