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    $self->term->Attribs->{do_expand}=1;
  43    $self->$orig(@args);
  44    if ($self->term->ReadLine eq 'Term::ReadLine::Gnu') {
  45       $self->term->WriteHistory($hist_file) ||
  46       $self->print("warning: failed to write history file $hist_file");
  47    }
  48    if ($self->term->ReadLine eq 'Term::ReadLine::Perl') {
  49       my @lines = $self->term->GetHistory() if $self->term->can('GetHistory');
  50       if( open HIST, ">$hist_file" ) {
  51          print HIST join("\n",@lines);
  52          close HIST;
  53       } else {
  54          $self->print("warning: unable to WriteHistory to $hist_file");
  55       }
  56    }
  57 };
  58
  59 1;
  60
  61 __END__
  62
  63 =head1 NAME
  64
  65 Devel::REPL::Plugin::ReadLineHistory - Integrate history with the facilities provided by L<Term::ReadLine>
  66
  67 =cut
  68