lib/Devel/REPL/Plugin/DumpHistory.pm

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