Commit | Line | Data |
a2532f46 |
1 | package Devel::REPL::Plugin::DumpHistory; |
2 | |
6a5409bc |
3 | use Devel::REPL::Plugin; |
aa8b7647 |
4 | use namespace::autoclean; |
a2532f46 |
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 |