Filename | /home/ss5/perl5/perlbrew/perls/perl-5.14.1/lib/site_perl/5.14.1/Devel/StackTrace.pm |
Statements | Executed 19 statements in 6.57ms |
Calls | P | F | Exclusive Time |
Inclusive Time |
Subroutine |
---|---|---|---|---|---|
1 | 1 | 1 | 8.71ms | 9.32ms | BEGIN@12 | Devel::StackTrace::
1 | 1 | 1 | 3.53ms | 3.93ms | BEGIN@11 | Devel::StackTrace::
1 | 1 | 1 | 74µs | 74µs | BEGIN@6 | Devel::StackTrace::
1 | 1 | 1 | 48µs | 177µs | BEGIN@16 | Devel::StackTrace::
1 | 1 | 1 | 43µs | 305µs | BEGIN@13 | Devel::StackTrace::
1 | 1 | 1 | 34µs | 34µs | BEGIN@2 | Devel::StackTrace::
1 | 1 | 1 | 27µs | 43µs | BEGIN@8 | Devel::StackTrace::
1 | 1 | 1 | 27µs | 55µs | BEGIN@9 | Devel::StackTrace::
0 | 0 | 0 | 0s | 0s | __ANON__[:127] | Devel::StackTrace::
0 | 0 | 0 | 0s | 0s | __ANON__[:93] | Devel::StackTrace::
0 | 0 | 0 | 0s | 0s | _add_frame | Devel::StackTrace::
0 | 0 | 0 | 0s | 0s | _make_frame_filter | Devel::StackTrace::
0 | 0 | 0 | 0s | 0s | _make_frames | Devel::StackTrace::
0 | 0 | 0 | 0s | 0s | _record_caller_data | Devel::StackTrace::
0 | 0 | 0 | 0s | 0s | _ref_to_string | Devel::StackTrace::
0 | 0 | 0 | 0s | 0s | as_string | Devel::StackTrace::
0 | 0 | 0 | 0s | 0s | frame | Devel::StackTrace::
0 | 0 | 0 | 0s | 0s | frame_count | Devel::StackTrace::
0 | 0 | 0 | 0s | 0s | frames | Devel::StackTrace::
0 | 0 | 0 | 0s | 0s | new | Devel::StackTrace::
0 | 0 | 0 | 0s | 0s | next_frame | Devel::StackTrace::
0 | 0 | 0 | 0s | 0s | prev_frame | Devel::StackTrace::
0 | 0 | 0 | 0s | 0s | reset_pointer | Devel::StackTrace::
Line | State ments |
Time on line |
Calls | Time in subs |
Code |
---|---|---|---|---|---|
1 | package Devel::StackTrace; | ||||
2 | # spent 34µs within Devel::StackTrace::BEGIN@2 which was called:
# once (34µs+0s) by Exception::Class::Base::BEGIN@10 at line 4 | ||||
3 | 1 | 19µs | $Devel::StackTrace::VERSION = '1.27'; | ||
4 | 1 | 86µs | 1 | 34µs | } # spent 34µs making 1 call to Devel::StackTrace::BEGIN@2 |
5 | |||||
6 | 2 | 186µs | 1 | 74µs | # spent 74µs within Devel::StackTrace::BEGIN@6 which was called:
# once (74µs+0s) by Exception::Class::Base::BEGIN@10 at line 6 # spent 74µs making 1 call to Devel::StackTrace::BEGIN@6 |
7 | |||||
8 | 2 | 89µs | 2 | 59µs | # spent 43µs (27+16) within Devel::StackTrace::BEGIN@8 which was called:
# once (27µs+16µs) by Exception::Class::Base::BEGIN@10 at line 8 # spent 43µs making 1 call to Devel::StackTrace::BEGIN@8
# spent 16µs making 1 call to strict::import |
9 | 2 | 93µs | 2 | 82µs | # spent 55µs (27+28) within Devel::StackTrace::BEGIN@9 which was called:
# once (27µs+28µs) by Exception::Class::Base::BEGIN@10 at line 9 # spent 55µs making 1 call to Devel::StackTrace::BEGIN@9
# spent 28µs making 1 call to warnings::import |
10 | |||||
11 | 2 | 453µs | 1 | 3.93ms | # spent 3.93ms (3.53+406µs) within Devel::StackTrace::BEGIN@11 which was called:
# once (3.53ms+406µs) by Exception::Class::Base::BEGIN@10 at line 11 # spent 3.93ms making 1 call to Devel::StackTrace::BEGIN@11 |
12 | 2 | 489µs | 1 | 9.32ms | # spent 9.32ms (8.71+618µs) within Devel::StackTrace::BEGIN@12 which was called:
# once (8.71ms+618µs) by Exception::Class::Base::BEGIN@10 at line 12 # spent 9.32ms making 1 call to Devel::StackTrace::BEGIN@12 |
13 | 2 | 158µs | 2 | 567µs | # spent 305µs (43+262) within Devel::StackTrace::BEGIN@13 which was called:
# once (43µs+262µs) by Exception::Class::Base::BEGIN@10 at line 13 # spent 305µs making 1 call to Devel::StackTrace::BEGIN@13
# spent 262µs making 1 call to Exporter::import |
14 | |||||
15 | use overload | ||||
16 | 1 | 39µs | 1 | 129µs | # spent 177µs (48+129) within Devel::StackTrace::BEGIN@16 which was called:
# once (48µs+129µs) by Exception::Class::Base::BEGIN@10 at line 17 # spent 129µs making 1 call to overload::import |
17 | 1 | 4.89ms | 1 | 177µs | fallback => 1; # spent 177µs making 1 call to Devel::StackTrace::BEGIN@16 |
18 | |||||
19 | sub new { | ||||
20 | my $class = shift; | ||||
21 | my %p = @_; | ||||
22 | |||||
23 | # Backwards compatibility - this parameter was renamed to no_refs | ||||
24 | # ages ago. | ||||
25 | $p{no_refs} = delete $p{no_object_refs} | ||||
26 | if exists $p{no_object_refs}; | ||||
27 | |||||
28 | my $self = bless { | ||||
29 | index => undef, | ||||
30 | frames => [], | ||||
31 | raw => [], | ||||
32 | %p, | ||||
33 | }, $class; | ||||
34 | |||||
35 | $self->_record_caller_data(); | ||||
36 | |||||
37 | return $self; | ||||
38 | } | ||||
39 | |||||
40 | sub _record_caller_data { | ||||
41 | my $self = shift; | ||||
42 | |||||
43 | # We exclude this method by starting one frame back. | ||||
44 | my $x = 1; | ||||
45 | while ( | ||||
46 | my @c | ||||
47 | = do { package # the newline keeps dzil from adding a version here | ||||
48 | DB; @DB::args = (); caller( $x++ ) } | ||||
49 | ) { | ||||
50 | my @args = @DB::args; | ||||
51 | |||||
52 | if ( $self->{no_refs} ) { | ||||
53 | @args = map { ref $_ ? $self->_ref_to_string($_) : $_ } @args; | ||||
54 | } | ||||
55 | |||||
56 | push @{ $self->{raw} }, { | ||||
57 | caller => \@c, | ||||
58 | args => \@args, | ||||
59 | }; | ||||
60 | } | ||||
61 | } | ||||
62 | |||||
63 | sub _ref_to_string { | ||||
64 | my $self = shift; | ||||
65 | my $ref = shift; | ||||
66 | |||||
67 | return overload::AddrRef($ref) | ||||
68 | if blessed $ref && $ref->isa('Exception::Class::Base'); | ||||
69 | |||||
70 | return overload::AddrRef($ref) unless $self->{respect_overload}; | ||||
71 | |||||
72 | local $@; | ||||
73 | local $SIG{__DIE__}; | ||||
74 | |||||
75 | my $str = eval { $ref . '' }; | ||||
76 | |||||
77 | return $@ ? overload::AddrRef($ref) : $str; | ||||
78 | } | ||||
79 | |||||
80 | sub _make_frames { | ||||
81 | my $self = shift; | ||||
82 | |||||
83 | my $filter = $self->_make_frame_filter; | ||||
84 | |||||
85 | my $raw = delete $self->{raw}; | ||||
86 | for my $r ( @{$raw} ) { | ||||
87 | next unless $filter->($r); | ||||
88 | |||||
89 | $self->_add_frame( $r->{caller}, $r->{args} ); | ||||
90 | } | ||||
91 | } | ||||
92 | |||||
93 | 1 | 12µs | my $default_filter = sub {1}; | ||
94 | |||||
95 | sub _make_frame_filter { | ||||
96 | my $self = shift; | ||||
97 | |||||
98 | my ( @i_pack_re, %i_class ); | ||||
99 | if ( $self->{ignore_package} ) { | ||||
100 | $self->{ignore_package} = [ $self->{ignore_package} ] | ||||
101 | unless UNIVERSAL::isa( $self->{ignore_package}, 'ARRAY' ); | ||||
102 | |||||
103 | @i_pack_re | ||||
104 | = map { ref $_ ? $_ : qr/^\Q$_\E$/ } @{ $self->{ignore_package} }; | ||||
105 | } | ||||
106 | |||||
107 | my $p = __PACKAGE__; | ||||
108 | push @i_pack_re, qr/^\Q$p\E$/; | ||||
109 | |||||
110 | if ( $self->{ignore_class} ) { | ||||
111 | $self->{ignore_class} = [ $self->{ignore_class} ] | ||||
112 | unless ref $self->{ignore_class}; | ||||
113 | %i_class = map { $_ => 1 } @{ $self->{ignore_class} }; | ||||
114 | } | ||||
115 | |||||
116 | my $user_filter = $self->{frame_filter}; | ||||
117 | |||||
118 | return sub { | ||||
119 | return 0 if grep { $_[0]{caller}[0] =~ /$_/ } @i_pack_re; | ||||
120 | return 0 if grep { $_[0]{caller}[0]->isa($_) } keys %i_class; | ||||
121 | |||||
122 | if ($user_filter) { | ||||
123 | return $user_filter->( $_[0] ); | ||||
124 | } | ||||
125 | |||||
126 | return 1; | ||||
127 | }; | ||||
128 | } | ||||
129 | |||||
130 | sub _add_frame { | ||||
131 | my $self = shift; | ||||
132 | my $c = shift; | ||||
133 | my $args = shift; | ||||
134 | |||||
135 | # eval and is_require are only returned when applicable under 5.00503. | ||||
136 | push @$c, ( undef, undef ) if scalar @$c == 6; | ||||
137 | |||||
138 | if ( $self->{no_refs} ) { | ||||
139 | } | ||||
140 | |||||
141 | push @{ $self->{frames} }, | ||||
142 | Devel::StackTrace::Frame->new( | ||||
143 | $c, | ||||
144 | $args, | ||||
145 | $self->{respect_overload}, | ||||
146 | $self->{max_arg_length}, | ||||
147 | $self->{message}, | ||||
148 | $self->{indent} | ||||
149 | ); | ||||
150 | } | ||||
151 | |||||
152 | sub next_frame { | ||||
153 | my $self = shift; | ||||
154 | |||||
155 | # reset to top if necessary. | ||||
156 | $self->{index} = -1 unless defined $self->{index}; | ||||
157 | |||||
158 | my @f = $self->frames(); | ||||
159 | if ( defined $f[ $self->{index} + 1 ] ) { | ||||
160 | return $f[ ++$self->{index} ]; | ||||
161 | } | ||||
162 | else { | ||||
163 | $self->{index} = undef; | ||||
164 | return undef; | ||||
165 | } | ||||
166 | } | ||||
167 | |||||
168 | sub prev_frame { | ||||
169 | my $self = shift; | ||||
170 | |||||
171 | my @f = $self->frames(); | ||||
172 | |||||
173 | # reset to top if necessary. | ||||
174 | $self->{index} = scalar @f unless defined $self->{index}; | ||||
175 | |||||
176 | if ( defined $f[ $self->{index} - 1 ] && $self->{index} >= 1 ) { | ||||
177 | return $f[ --$self->{index} ]; | ||||
178 | } | ||||
179 | else { | ||||
180 | $self->{index} = undef; | ||||
181 | return undef; | ||||
182 | } | ||||
183 | } | ||||
184 | |||||
185 | sub reset_pointer { | ||||
186 | my $self = shift; | ||||
187 | |||||
188 | $self->{index} = undef; | ||||
189 | } | ||||
190 | |||||
191 | sub frames { | ||||
192 | my $self = shift; | ||||
193 | |||||
194 | $self->_make_frames() if $self->{raw}; | ||||
195 | |||||
196 | return @{ $self->{frames} }; | ||||
197 | } | ||||
198 | |||||
199 | sub frame { | ||||
200 | my $self = shift; | ||||
201 | my $i = shift; | ||||
202 | |||||
203 | return unless defined $i; | ||||
204 | |||||
205 | return ( $self->frames() )[$i]; | ||||
206 | } | ||||
207 | |||||
208 | sub frame_count { | ||||
209 | my $self = shift; | ||||
210 | |||||
211 | return scalar( $self->frames() ); | ||||
212 | } | ||||
213 | |||||
214 | sub as_string { | ||||
215 | my $self = shift; | ||||
216 | |||||
217 | my $st = ''; | ||||
218 | my $first = 1; | ||||
219 | foreach my $f ( $self->frames() ) { | ||||
220 | $st .= $f->as_string($first) . "\n"; | ||||
221 | $first = 0; | ||||
222 | } | ||||
223 | |||||
224 | return $st; | ||||
225 | } | ||||
226 | |||||
227 | { | ||||
228 | 1 | 2µs | package | ||
229 | Devel::StackTraceFrame; | ||||
230 | |||||
231 | 1 | 29µs | our @ISA = 'Devel::StackTrace::Frame'; | ||
232 | } | ||||
233 | |||||
234 | 1 | 21µs | 1; | ||
235 | |||||
236 | # ABSTRACT: An object representing a stack trace | ||||
237 | |||||
- - | |||||
240 | =pod | ||||
241 | |||||
242 | =head1 NAME | ||||
243 | |||||
244 | Devel::StackTrace - An object representing a stack trace | ||||
245 | |||||
246 | =head1 VERSION | ||||
247 | |||||
248 | version 1.27 | ||||
249 | |||||
250 | =head1 SYNOPSIS | ||||
251 | |||||
252 | use Devel::StackTrace; | ||||
253 | |||||
254 | my $trace = Devel::StackTrace->new; | ||||
255 | |||||
256 | print $trace->as_string; # like carp | ||||
257 | |||||
258 | # from top (most recent) of stack to bottom. | ||||
259 | while (my $frame = $trace->next_frame) { | ||||
260 | print "Has args\n" if $frame->hasargs; | ||||
261 | } | ||||
262 | |||||
263 | # from bottom (least recent) of stack to top. | ||||
264 | while (my $frame = $trace->prev_frame) { | ||||
265 | print "Sub: ", $frame->subroutine, "\n"; | ||||
266 | } | ||||
267 | |||||
268 | =head1 DESCRIPTION | ||||
269 | |||||
270 | The Devel::StackTrace module contains two classes, Devel::StackTrace | ||||
271 | and Devel::StackTrace::Frame. The goal of this object is to encapsulate | ||||
272 | the information that can found through using the caller() function, as | ||||
273 | well as providing a simple interface to this data. | ||||
274 | |||||
275 | The Devel::StackTrace object contains a set of Devel::StackTrace::Frame | ||||
276 | objects, one for each level of the stack. The frames contain all the | ||||
277 | data available from C<caller()>. | ||||
278 | |||||
279 | This code was created to support my L<Exception::Class::Base> class | ||||
280 | (part of Exception::Class) but may be useful in other contexts. | ||||
281 | |||||
282 | =head1 'TOP' AND 'BOTTOM' OF THE STACK | ||||
283 | |||||
284 | When describing the methods of the trace object, I use the words 'top' | ||||
285 | and 'bottom'. In this context, the 'top' frame on the stack is the | ||||
286 | most recent frame and the 'bottom' is the least recent. | ||||
287 | |||||
288 | Here's an example: | ||||
289 | |||||
290 | foo(); # bottom frame is here | ||||
291 | |||||
292 | sub foo { | ||||
293 | bar(); | ||||
294 | } | ||||
295 | |||||
296 | sub bar { | ||||
297 | Devel::StackTrace->new; # top frame is here. | ||||
298 | } | ||||
299 | |||||
300 | =head1 Devel::StackTrace METHODS | ||||
301 | |||||
302 | =over 4 | ||||
303 | |||||
304 | =item * Devel::StackTrace->new(%named_params) | ||||
305 | |||||
306 | Returns a new Devel::StackTrace object. | ||||
307 | |||||
308 | Takes the following parameters: | ||||
309 | |||||
310 | =over 8 | ||||
311 | |||||
312 | =item * frame_filter => $sub | ||||
313 | |||||
314 | By default, Devel::StackTrace will include all stack frames before the | ||||
315 | call to its its constructor. | ||||
316 | |||||
317 | However, you may want to filter out some frames with more granularity | ||||
318 | than 'ignore_package' or 'ignore_class' allow. | ||||
319 | |||||
320 | You can provide a subroutine which is called with the raw frame data | ||||
321 | for each frame. This is a hash reference with two keys, "caller", and | ||||
322 | "args", both of which are array references. The "caller" key is the | ||||
323 | raw data as returned by Perl's C<caller()> function, and the "args" | ||||
324 | key are the subroutine arguments found in C<@DB::args>. | ||||
325 | |||||
326 | The filter should return true if the frame should be included, or | ||||
327 | false if it should be skipped. | ||||
328 | |||||
329 | =item * ignore_package => $package_name OR \@package_names | ||||
330 | |||||
331 | Any frames where the package is one of these packages will not be on | ||||
332 | the stack. | ||||
333 | |||||
334 | =item * ignore_class => $package_name OR \@package_names | ||||
335 | |||||
336 | Any frames where the package is a subclass of one of these packages | ||||
337 | (or is the same package) will not be on the stack. | ||||
338 | |||||
339 | Devel::StackTrace internally adds itself to the 'ignore_package' | ||||
340 | parameter, meaning that the Devel::StackTrace package is B<ALWAYS> | ||||
341 | ignored. However, if you create a subclass of Devel::StackTrace it | ||||
342 | will not be ignored. | ||||
343 | |||||
344 | =item * no_refs => $boolean | ||||
345 | |||||
346 | If this parameter is true, then Devel::StackTrace will not store | ||||
347 | references internally when generating stacktrace frames. This lets | ||||
348 | your objects go out of scope. | ||||
349 | |||||
350 | Devel::StackTrace replaces any references with their stringified | ||||
351 | representation. | ||||
352 | |||||
353 | =item * respect_overload => $boolean | ||||
354 | |||||
355 | By default, Devel::StackTrace will call C<overload::AddrRef()> to get | ||||
356 | the underlying string representation of an object, instead of | ||||
357 | respecting the object's stringification overloading. If you would | ||||
358 | prefer to see the overloaded representation of objects in stack | ||||
359 | traces, then set this parameter to true. | ||||
360 | |||||
361 | =item * max_arg_length => $integer | ||||
362 | |||||
363 | By default, Devel::StackTrace will display the entire argument for | ||||
364 | each subroutine call. Setting this parameter causes it to truncate the | ||||
365 | argument's string representation if it is longer than this number of | ||||
366 | characters. | ||||
367 | |||||
368 | =item * message => $string | ||||
369 | |||||
370 | By default, Devel::StackTrace will use 'Trace begun' as the message for the | ||||
371 | first stack frame when you call C<as_string>. You can supply an alternative | ||||
372 | message using this option. | ||||
373 | |||||
374 | =item * indent => $boolean | ||||
375 | |||||
376 | If this parameter is true, each stack frame after the first will start with a | ||||
377 | tab character, just like C<Carp::confess()>. | ||||
378 | |||||
379 | =back | ||||
380 | |||||
381 | =item * $trace->next_frame | ||||
382 | |||||
383 | Returns the next Devel::StackTrace::Frame object down on the stack. If | ||||
384 | it hasn't been called before it returns the first frame. It returns | ||||
385 | undef when it reaches the bottom of the stack and then resets its | ||||
386 | pointer so the next call to C<next_frame> or C<prev_frame> will work | ||||
387 | properly. | ||||
388 | |||||
389 | =item * $trace->prev_frame | ||||
390 | |||||
391 | Returns the next Devel::StackTrace::Frame object up on the stack. If it | ||||
392 | hasn't been called before it returns the last frame. It returns undef | ||||
393 | when it reaches the top of the stack and then resets its pointer so | ||||
394 | pointer so the next call to C<next_frame> or C<prev_frame> will work | ||||
395 | properly. | ||||
396 | |||||
397 | =item * $trace->reset_pointer | ||||
398 | |||||
399 | Resets the pointer so that the next call C<next_frame> or | ||||
400 | C<prev_frame> will start at the top or bottom of the stack, as | ||||
401 | appropriate. | ||||
402 | |||||
403 | =item * $trace->frames | ||||
404 | |||||
405 | Returns a list of Devel::StackTrace::Frame objects. The order they are | ||||
406 | returned is from top (most recent) to bottom. | ||||
407 | |||||
408 | =item * $trace->frame ($index) | ||||
409 | |||||
410 | Given an index, returns the relevant frame or undef if there is not | ||||
411 | frame at that index. The index is exactly like a Perl array. The | ||||
412 | first frame is 0 and negative indexes are allowed. | ||||
413 | |||||
414 | =item * $trace->frame_count | ||||
415 | |||||
416 | Returns the number of frames in the trace object. | ||||
417 | |||||
418 | =item * $trace->as_string | ||||
419 | |||||
420 | Calls as_string on each frame from top to bottom, producing output | ||||
421 | quite similar to the Carp module's cluck/confess methods. | ||||
422 | |||||
423 | =back | ||||
424 | |||||
425 | =head1 SUPPORT | ||||
426 | |||||
427 | Please submit bugs to the CPAN RT system at | ||||
428 | http://rt.cpan.org/NoAuth/ReportBug.html?Queue=Devel%3A%3AStackTrace | ||||
429 | or via email at bug-devel-stacktrace@rt.cpan.org. | ||||
430 | |||||
431 | =head1 AUTHOR | ||||
432 | |||||
433 | Dave Rolsky <autarch@urth.org> | ||||
434 | |||||
435 | =head1 COPYRIGHT AND LICENSE | ||||
436 | |||||
437 | This software is Copyright (c) 2011 by Dave Rolsky. | ||||
438 | |||||
439 | This is free software, licensed under: | ||||
440 | |||||
441 | The Artistic License 2.0 (GPL Compatible) | ||||
442 | |||||
443 | =cut | ||||
444 | |||||
445 | |||||
446 | __END__ |