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