File Coverage

blib/lib/Carp/REPL.pm
Criterion Covered Total %
statement 36 51 70.5
branch 8 20 40.0
condition 1 6 16.6
subroutine 6 7 85.7
pod 1 1 100.0
total 52 85 61.1


line stmt bran cond sub pod time code
1             package Carp::REPL;
2 2     2   459177 use strict;
  2         4  
  2         69  
3 2     2   7 use warnings;
  2         4  
  2         47  
4 2     2   39 use 5.006000;
  2         8  
  2         449  
5             our $VERSION = '0.17';
6              
7             our $noprofile = 0;
8             our $bottom_frame = 0;
9              
10             sub import {
11 2     2   185 my $nodie = grep { $_ eq 'nodie' } @_;
  3         9  
12 2         4 my $warn = grep { $_ eq 'warn' } @_;
  3         6  
13 2         3 my $test = grep { $_ eq 'test' } @_;
  3         4  
14 2         3 $noprofile = grep { $_ eq 'noprofile'} @_;
  3         5  
15 2         4 my $repl = grep { $_ eq 'repl' } @_;
  3         4  
16              
17 2 50       7 if ($repl) {
18              
19 0         0 require Sub::Exporter;
20 0         0 my $import_repl = Sub::Exporter::build_exporter(
21             {
22             exports => ['repl'],
23             into_level => 1,
24             }
25             );
26              
27             # get option of 'repl'
28 0         0 my $seen;
29 0 0 0     0 my ($maybe_option) = grep { $seen || $_ eq 'repl' && $seen++ } @_;
  0         0  
30              
31             # now do the real 'repl' import
32 0 0       0 $import_repl->( __PACKAGE__, 'repl',
33             ref $maybe_option ? $maybe_option : ()
34             );
35             }
36            
37 2 100       13 $SIG{__DIE__} = \&repl unless $nodie;
38 2 50       5 $SIG{__WARN__} = \&repl if $warn;
39              
40 2 50       1149 if ($test) {
41 0         0 require Test::Builder;
42 0         0 my $ok = \&Test::Builder::ok;
43              
44 2     2   9 no warnings 'redefine';
  2         2  
  2         440  
45             *Test::Builder::ok = sub {
46 0     0   0 local $Test::Builder::Level = $Test::Builder::Level + 1;
47 0         0 my $passed = $ok->(@_);
48 0         0 local $bottom_frame = $Test::Builder::Level;
49 0 0       0 repl("Test failure") if !$passed;
50 0         0 return $passed;
51 0         0 };
52             }
53             }
54              
55             sub repl {
56 2   33 2 1 548 my $quiet = @_ && !defined($_[0]);
57              
58 2 50       172 warn @_, "\n" unless $quiet; # tell the user what blew up
59              
60 2         507 require Devel::REPL::Script;
61              
62 2         270298 my ($runner, $repl);
63 2 50       8 if ($noprofile) {
64 0         0 $repl = $runner = Devel::REPL->new;
65             }
66             else {
67 2         25 $runner = Devel::REPL::Script->new;
68 2         419276 $repl = $runner->_repl;
69             }
70              
71 2         35 $repl->load_plugin('Carp::REPL');
72              
73 2 50       2586 warn $repl->stacktrace unless $quiet;
74              
75 2         1678 $runner->run;
76             }
77              
78             1;
79              
80             __END__
81              
82             =head1 NAME
83              
84             Carp::REPL - read-eval-print-loop on die and/or warn
85              
86             =head1 SYNOPSIS
87              
88             The intended way to use this module is through the command line.
89              
90             perl -MCarp::REPL tps-report.pl
91             Can't call method "cover_sheet" without a package or object reference at tps-report.pl line 6019.
92              
93             # instead of exiting, you get a REPL!
94              
95             $ $form
96             27B/6
97              
98             $ $self->get_form
99             27B/6
100              
101             $ "ah ha! there's my bug, I thought get_form returned an object"
102             ah ha! there's my bug, I thought get_form returned an object
103              
104             =head1 USAGE
105              
106             =head2 C<-MCarp::REPL>
107              
108             =head2 C<-MCarp::REPL=warn>
109              
110             Works as command line argument. This automatically installs the die handler for
111             you, so if you receive a fatal error you get a REPL before the universe
112             explodes. Specifying C<=warn> also installs a warn handler for finding those
113             mysterious warnings.
114              
115             =head2 C<use Carp::REPL;>
116              
117             =head2 C<use Carp::REPL 'warn';>
118              
119             Same as above.
120              
121             =head2 C<use Carp::REPL 'nodie';>
122              
123             Loads the module without installing the die handler. Use this if you just want
124             to run C<Carp::REPL::repl> on your own terms.
125              
126             =head2 C<use Carp::REPL 'test';>
127              
128             =head2 C<-MCarp::REPL=test>
129              
130             Load a REPL on test failure! (as long as it uses L<Test::More/ok>)
131              
132             =head1 FUNCTIONS
133              
134             =head2 repl
135              
136             This module's interface consists of exactly one function: repl. This is
137             provided so you may install your own C<$SIG{__DIE__}> handler if you have no
138             alternatives.
139              
140             It takes the same arguments as die, and returns no useful value. In fact, don't
141             even depend on it returning at all!
142              
143             One useful place for calling this manually is if you just want to check the
144             state of things without having to throw a fake error. You can also change any
145             variables and those changes will be seen by the rest of your program.
146              
147             use Carp::REPL 'repl';
148              
149             sub involved_calculation {
150             # ...
151             $d = maybe_zero();
152             # ...
153             repl(); # $d = 1
154             $sum += $n / $d;
155             # ...
156             }
157              
158             Unfortunately if you instead go with the usual C<-MCarp::REPL>, then
159             C<$SIG{__DIE__}> will be invoked and there's no general way to recover. But you
160             can still change variables to poke at things.
161              
162             =head1 COMMANDS
163              
164             Note that this is not supposed to be a full-fledged debugger. A few commands
165             are provided to aid you in finding out what went awry. See
166             L<Devel::ebug> if you're looking for a serious debugger.
167              
168             =over 4
169              
170             =item * :u
171              
172             Moves one frame up in the stack.
173              
174             =item * :d
175              
176             Moves one frame down in the stack.
177              
178             =item * :top
179              
180             Moves to the top frame of the stack.
181              
182             =item * :bottom
183              
184             Moves to the bottom frame of the stack.
185              
186             =item * :t
187              
188             Redisplay the stack trace.
189              
190             =item * :e
191              
192             Display the current lexical environment.
193              
194             =item * :l
195              
196             List eleven lines of source code of the current frame.
197              
198             =item * :q
199              
200             Close the REPL. (C<^D> also works)
201              
202             =back
203              
204             =head1 VARIABLES
205              
206             =over 4
207              
208             =item * $_REPL
209              
210             This represents the Devel::REPL object.
211              
212             =item * $_a
213              
214             This represents the arguments passed to the subroutine at the current frame in
215             the call stack. Modifications are ignored (how would that work anyway?
216             Re-invoke the sub?)
217              
218             =back
219              
220             =head1 CAVEATS
221              
222             Dynamic scope probably produces unexpected results. I don't see any easy (or
223             even difficult!) solution to this. Therefore it's a caveat and not a bug. :)
224              
225             =head1 SEE ALSO
226              
227             L<Devel::REPL>, L<Devel::ebug>, L<Enbugger>, L<CGI::Inspect>
228              
229             =head1 AUTHOR
230              
231             Shawn M Moore, C<< <sartak at gmail.com> >>
232              
233             =head1 BUGS
234              
235             Please report any bugs or feature requests to
236             C<bug-carp-repl at rt.cpan.org>, or through the web interface at
237             L<http://rt.cpan.org/NoAuth/ReportBug.html?Queue=Carp-REPL>.
238              
239             =head1 ACKNOWLEDGEMENTS
240              
241             Thanks to Nelson Elhage and Jesse Vincent for the idea.
242              
243             Thanks to Matt Trout and Stevan Little for their advice.
244              
245             =head1 COPYRIGHT & LICENSE
246              
247             Copyright 2007-2008 Best Practical Solutions.
248              
249             This program is free software; you can redistribute it and/or modify it
250             under the same terms as Perl itself.
251              
252             =cut
253