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