lib/Devel/REPL/Plugin/DumpHistory.pm

   1 package Devel::REPL::Plugin::DumpHistory;
   2
   3 use Devel::REPL::Plugin;
   4 use namespace::autoclean;
   5
   6 ## Seems to be a sequence issue with requires
   7 # requires qw{ history };
   8
   9 around 'read' => sub {
  10   my $orig = shift;
  11   my ($self, @args) = @_;
  12
  13   my $line = $self->$orig(@args);
  14   if (defined $line) {
  15     if ($line =~ m/^:dump ?(.*)$/) {
  16       my $file = $1;
  17       $self->print_history($file);
  18       return '';
  19     }
  20   }
  21   return $line;
  22 };
  23
  24 sub print_history {
  25     my ( $self, $file ) = @_;
  26
  27     if ($file) {
  28         open( my $fd, ">>", $file )
  29             or do { warn "Couldn't open '$file': $!\n"; return; };
  30         print $fd "$_\n" for ( @{ $self->history } );
  31         $self->print( sprintf "Dumped %d history lines to '$file'\n",
  32             scalar @{ $self->history } );
  33         close $fd;
  34     } else {
  35         $self->print("$_\n") for ( @{ $self->history } );
  36     }
  37     return 1;
  38 }
  39
  40 1;
  41
  42 __END__
  43
  44 =head1 NAME
  45
  46 Devel::REPL::Plugin::DumpHistory - Plugin for Devel::REPL to save or print
  47 the history.
  48
  49 =head1 SYNOPSIS
  50
  51     #!/usr/bin/perl
  52
  53     use lib './lib';
  54     use Devel::REPL;
  55
  56     my $repl = Devel::REPL->new;
  57     $repl->load_plugin('LexEnv');
  58     $repl->load_plugin('History');
  59     $repl->load_plugin('DumpHistory');
  60     $repl->run;
  61
  62 =head1 DESCRIPTION
  63
  64 Plugin that adds the C<:dump> and C<:dump file_name> commands to the
  65 repl which will print the history to STDOUT or append the history to the
  66 file given.
  67
  68 =head1 SEE ALSO
  69
  70 C<Devel::REPL>
  71
  72 =head1 AUTHOR
  73
  74 mgrimes, E<lt>mgrimes at cpan dot org<gt>
  75
  76 =head1 COPYRIGHT AND LICENSE
  77
  78 Copyright (C) 2007 by mgrimes
  79
  80 This library is free software; you can redistribute it and/or modify
  81 it under the same terms as Perl itself, either Perl version 5.8.2 or,
  82 at your option, any later version of Perl 5 you may have available.
  83
  84 =cut