Commit | Line | Data |
1716b200 |
1 | use strict; |
2 | use warnings; |
a2532f46 |
3 | package Devel::REPL::Plugin::DumpHistory; |
4 | |
6a5409bc |
5 | use Devel::REPL::Plugin; |
aa8b7647 |
6 | use namespace::autoclean; |
a2532f46 |
7 | |
8 | ## Seems to be a sequence issue with requires |
afc8677b |
9 | # requires qw{ history }; |
a2532f46 |
10 | |
11 | around 'read' => sub { |
12 | my $orig = shift; |
13 | my ($self, @args) = @_; |
14 | |
15 | my $line = $self->$orig(@args); |
16 | if (defined $line) { |
17 | if ($line =~ m/^:dump ?(.*)$/) { |
18 | my $file = $1; |
19 | $self->print_history($file); |
20 | return ''; |
21 | } |
22 | } |
23 | return $line; |
24 | }; |
25 | |
26 | sub print_history { |
27 | my ( $self, $file ) = @_; |
28 | |
29 | if ($file) { |
30 | open( my $fd, ">>", $file ) |
31 | or do { warn "Couldn't open '$file': $!\n"; return; }; |
32 | print $fd "$_\n" for ( @{ $self->history } ); |
33 | $self->print( sprintf "Dumped %d history lines to '$file'\n", |
34 | scalar @{ $self->history } ); |
35 | close $fd; |
36 | } else { |
37 | $self->print("$_\n") for ( @{ $self->history } ); |
38 | } |
39 | return 1; |
40 | } |
41 | |
42 | 1; |
43 | |
44 | __END__ |
45 | |
46 | =head1 NAME |
47 | |
48 | Devel::REPL::Plugin::DumpHistory - Plugin for Devel::REPL to save or print |
49 | the history. |
50 | |
51 | =head1 SYNOPSIS |
52 | |
a2532f46 |
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 | |
afc8677b |
63 | Plugin that adds the C<:dump> and C<:dump file_name> commands to the |
a2532f46 |
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 |