← Index
NYTProf Performance Profile   « block view • line view • sub view »
For 05.Domain_and_Item.t
  Run on Tue May 4 17:21:41 2010
Reported on Tue May 4 17:22:45 2010

File /usr/local/lib/perl5/site_perl/5.10.1/Devel/StackTrace.pm
Statements Executed 553
Statement Execution Time 2.57ms
Subroutines — ordered by exclusive time
Calls P F Exclusive
Time
Inclusive
Time
Subroutine
1111.69ms1.83msDevel::StackTrace::::BEGIN@8 Devel::StackTrace::BEGIN@8
511702µs1.30msDevel::StackTrace::::_record_caller_data Devel::StackTrace::_record_caller_data
2011193µs599µsDevel::StackTrace::::_ref_to_string Devel::StackTrace::_ref_to_string
511134µs1.43msDevel::StackTrace::::new Devel::StackTrace::new
11144µs44µsDevel::StackTraceFrame::::BEGIN@251Devel::StackTraceFrame::BEGIN@251
11122µs22µsDevel::StackTrace::::BEGIN@3 Devel::StackTrace::BEGIN@3
11111µs14µsDevel::StackTrace::::BEGIN@5 Devel::StackTrace::BEGIN@5
11111µs20µsDevel::StackTrace::::BEGIN@6 Devel::StackTrace::BEGIN@6
11111µs50µsDevel::StackTrace::::BEGIN@12 Devel::StackTrace::BEGIN@12
11111µs15µsDevel::StackTraceFrame::::BEGIN@244Devel::StackTraceFrame::BEGIN@244
1119µs52µsDevel::StackTrace::::BEGIN@9 Devel::StackTrace::BEGIN@9
1118µs24µsDevel::StackTraceFrame::::BEGIN@245Devel::StackTraceFrame::BEGIN@245
1117µs17µsDevel::StackTraceFrame::::BEGIN@252Devel::StackTraceFrame::BEGIN@252
0000s0sDevel::StackTrace::::__ANON__[:132] Devel::StackTrace::__ANON__[:132]
0000s0sDevel::StackTrace::::__ANON__[:96] Devel::StackTrace::__ANON__[:96]
0000s0sDevel::StackTrace::::_add_frame Devel::StackTrace::_add_frame
0000s0sDevel::StackTrace::::_make_frame_filter Devel::StackTrace::_make_frame_filter
0000s0sDevel::StackTrace::::_make_frames Devel::StackTrace::_make_frames
0000s0sDevel::StackTrace::::as_string Devel::StackTrace::as_string
0000s0sDevel::StackTrace::::frame Devel::StackTrace::frame
0000s0sDevel::StackTrace::::frame_count Devel::StackTrace::frame_count
0000s0sDevel::StackTrace::::frames Devel::StackTrace::frames
0000s0sDevel::StackTrace::::next_frame Devel::StackTrace::next_frame
0000s0sDevel::StackTrace::::prev_frame Devel::StackTrace::prev_frame
0000s0sDevel::StackTrace::::reset_pointer Devel::StackTrace::reset_pointer
0000s0sDevel::StackTraceFrame::::__ANON__[:257]Devel::StackTraceFrame::__ANON__[:257]
0000s0sDevel::StackTraceFrame::::argsDevel::StackTraceFrame::args
0000s0sDevel::StackTraceFrame::::as_stringDevel::StackTraceFrame::as_string
0000s0sDevel::StackTraceFrame::::newDevel::StackTraceFrame::new
Call graph for these subroutines as a Graphviz dot language file.
Line State
ments
Time
on line
Calls Time
in subs
Code
1package Devel::StackTrace;
2
3333µs122µs
# spent 22µs within Devel::StackTrace::BEGIN@3 which was called # once (22µs+0s) by Exception::Class::Base::BEGIN@9 at line 3
use 5.006;
# spent 22µs making 1 call to Devel::StackTrace::BEGIN@3
4
5321µs217µs
# spent 14µs (11+3) within Devel::StackTrace::BEGIN@5 which was called # once (11µs+3µs) by Exception::Class::Base::BEGIN@9 at line 5
use strict;
# spent 14µs making 1 call to Devel::StackTrace::BEGIN@5 # spent 3µs making 1 call to strict::import
6320µs229µs
# spent 20µs (11+9) within Devel::StackTrace::BEGIN@6 which was called # once (11µs+9µs) by Exception::Class::Base::BEGIN@9 at line 6
use warnings;
# spent 20µs making 1 call to Devel::StackTrace::BEGIN@6 # spent 9µs making 1 call to warnings::import
7
83113µs11.83ms
# spent 1.83ms (1.69+132µs) within Devel::StackTrace::BEGIN@8 which was called # once (1.69ms+132µs) by Exception::Class::Base::BEGIN@9 at line 8
use File::Spec;
# spent 1.83ms making 1 call to Devel::StackTrace::BEGIN@8
9332µs295µs
# spent 52µs (9+43) within Devel::StackTrace::BEGIN@9 which was called # once (9µs+43µs) by Exception::Class::Base::BEGIN@9 at line 9
use Scalar::Util qw( blessed );
# spent 52µs making 1 call to Devel::StackTrace::BEGIN@9 # spent 43µs making 1 call to Exporter::import
10
11use overload
12
# spent 50µs (11+38) within Devel::StackTrace::BEGIN@12 which was called # once (11µs+38µs) by Exception::Class::Base::BEGIN@9 at line 13
'""' => \&as_string,
# spent 38µs making 1 call to overload::import
133793µs150µs fallback => 1;
# spent 50µs making 1 call to Devel::StackTrace::BEGIN@12
14
151800nsour $VERSION = '1.22';
16
17
18sub new
19
# spent 1.43ms (134µs+1.30) within Devel::StackTrace::new which was called 5 times, avg 287µs/call: # 5 times (134µs+1.30ms) by Exception::Class::Base::_initialize at line 133 of Exception/Class/Base.pm, avg 287µs/call
{
2030126µs 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 =
29 bless { index => undef,
30 frames => [],
31 raw => [],
32 %p,
33 }, $class;
34
35 $self->_record_caller_data();
# spent 1.30ms making 5 calls to Devel::StackTrace::_record_caller_data, avg 260µs/call
36
37 return $self;
38}
39
40sub _record_caller_data
41
# spent 1.30ms (702µs+599µs) within Devel::StackTrace::_record_caller_data which was called 5 times, avg 260µs/call: # 5 times (702µs+599µs) by Devel::StackTrace::new at line 35, avg 260µs/call
{
421523µs my $self = shift;
43
44 # We exclude this method by starting one frame back.
45 my $x = 1;
46185292µs while ( my @c =
47 do { package DB; @DB::args = (); caller($x++) } )
48 {
49196µs my @a = @DB::args;
50
5135123µs if ( $self->{no_refs} )
52 {
5315677µs20599µs @a = map { ref $_ ? $self->_ref_to_string($_) : $_ } @a;
# spent 599µs making 20 calls to Devel::StackTrace::_ref_to_string, avg 30µs/call
54 }
55
56 push @{ $self->{raw} },
57 { caller => \@c,
58 args => \@a,
59 };
60 }
61}
62
63sub _ref_to_string
64
# spent 599µs (193+406) within Devel::StackTrace::_ref_to_string which was called 20 times, avg 30µs/call: # 20 times (193µs+406µs) by Devel::StackTrace::_record_caller_data at line 53, avg 30µs/call
{
6575231µs my $self = shift;
66 my $ref = shift;
67
68 return overload::AddrRef($ref)
# spent 74µs making 5 calls to overload::AddrRef, avg 15µs/call # spent 25µs making 10 calls to UNIVERSAL::isa, avg 3µs/call # spent 19µs making 20 calls to Scalar::Util::blessed, avg 950ns/call
69 if blessed $ref && $ref->isa('Exception::Class::Base');
70
71 return overload::AddrRef($ref) unless $self->{respect_overload};
# spent 288µs making 15 calls to overload::AddrRef, avg 19µs/call
72
73 local $@;
74 local $SIG{__DIE__};
75
76 my $str = eval { $ref . '' };
77
78 return $@ ? overload::AddrRef($ref) : $str;
79}
80
81sub _make_frames
82{
83 my $self = shift;
84
85 my $filter = $self->_make_frame_filter;
86
87 my $raw = delete $self->{raw};
88 for my $r ( @{$raw} )
89 {
90 next unless $filter->($r);
91
92 $self->_add_frame( $r->{caller}, $r->{args} );
93 }
94}
95
9612µsmy $default_filter = sub { 1 };
97sub _make_frame_filter
98{
99 my $self = shift;
100
101 my (@i_pack_re, %i_class);
102 if ( $self->{ignore_package} )
103 {
104 $self->{ignore_package} =
105 [ $self->{ignore_package} ] unless UNIVERSAL::isa( $self->{ignore_package}, 'ARRAY' );
106
107 @i_pack_re = map { ref $_ ? $_ : qr/^\Q$_\E$/ } @{ $self->{ignore_package} };
108 }
109
110 my $p = __PACKAGE__;
111 push @i_pack_re, qr/^\Q$p\E$/;
112
113 if ( $self->{ignore_class} )
114 {
115 $self->{ignore_class} = [ $self->{ignore_class} ] unless ref $self->{ignore_class};
116 %i_class = map {$_ => 1} @{ $self->{ignore_class} };
117 }
118
119 my $user_filter = $self->{frame_filter};
120
121 return sub
122 {
123 return 0 if grep { $_[0]{caller}[0] =~ /$_/ } @i_pack_re;
124 return 0 if grep { $_[0]{caller}[0]->isa($_) } keys %i_class;
125
126 if ( $user_filter )
127 {
128 return $user_filter->( $_[0] );
129 }
130
131 return 1;
132 };
133}
134
135sub _add_frame
136{
137 my $self = shift;
138 my $c = shift;
139 my $args = shift;
140
141 # eval and is_require are only returned when applicable under 5.00503.
142 push @$c, (undef, undef) if scalar @$c == 6;
143
144 if ( $self->{no_refs} )
145 {
146 }
147
148 push @{ $self->{frames} },
149 Devel::StackTraceFrame->new( $c, $args,
150 $self->{respect_overload}, $self->{max_arg_length} );
151}
152
153sub next_frame
154{
155 my $self = shift;
156
157 # reset to top if necessary.
158 $self->{index} = -1 unless defined $self->{index};
159
160 my @f = $self->frames();
161 if ( defined $f[ $self->{index} + 1 ] )
162 {
163 return $f[ ++$self->{index} ];
164 }
165 else
166 {
167 $self->{index} = undef;
168 return undef;
169 }
170}
171
172sub prev_frame
173{
174 my $self = shift;
175
176 my @f = $self->frames();
177
178 # reset to top if necessary.
179 $self->{index} = scalar @f unless defined $self->{index};
180
181 if ( defined $f[ $self->{index} - 1 ] && $self->{index} >= 1 )
182 {
183 return $f[ --$self->{index} ];
184 }
185 else
186 {
187 $self->{index} = undef;
188 return undef;
189 }
190}
191
192sub reset_pointer
193{
194 my $self = shift;
195
196 $self->{index} = undef;
197}
198
199sub frames
200{
201 my $self = shift;
202
203 $self->_make_frames() if $self->{raw};
204
205 return @{ $self->{frames} };
206}
207
208sub frame
209{
210 my $self = shift;
211 my $i = shift;
212
213 return unless defined $i;
214
215 return ( $self->frames() )[$i];
216}
217
218sub frame_count
219{
220 my $self = shift;
221
222 return scalar ( $self->frames() );
223}
224
225sub as_string
226{
227 my $self = shift;
228
229 my $st = '';
230 my $first = 1;
231 foreach my $f ( $self->frames() )
232 {
233 $st .= $f->as_string($first) . "\n";
234 $first = 0;
235 }
236
237 return $st;
238}
239
240# Hide from PAUSE
241package
242 Devel::StackTraceFrame;
243
244320µs219µs
# spent 15µs (11+4) within Devel::StackTraceFrame::BEGIN@244 which was called # once (11µs+4µs) by Exception::Class::Base::BEGIN@9 at line 244
use strict;
# spent 15µs making 1 call to Devel::StackTraceFrame::BEGIN@244 # spent 4µs making 1 call to strict::import
245335µs239µs
# spent 24µs (8+15) within Devel::StackTraceFrame::BEGIN@245 which was called # once (8µs+15µs) by Exception::Class::Base::BEGIN@9 at line 245
use warnings;
# spent 24µs making 1 call to Devel::StackTraceFrame::BEGIN@245 # spent 15µs making 1 call to warnings::import
246
2471200nsour $VERSION = $Devel::StackTrace::VERSION;
248
249# Create accessor routines
250BEGIN
251
# spent 44µs within Devel::StackTraceFrame::BEGIN@251 which was called # once (44µs+0s) by Exception::Class::Base::BEGIN@9 at line 259
{
252381µs228µs
# spent 17µs (7+10) within Devel::StackTraceFrame::BEGIN@252 which was called # once (7µs+10µs) by Exception::Class::Base::BEGIN@9 at line 252
no strict 'refs';
# spent 17µs making 1 call to Devel::StackTraceFrame::BEGIN@252 # spent 10µs making 1 call to strict::unimport
25316µs foreach my $f ( qw( package filename line subroutine hasargs
254 wantarray evaltext is_require hints bitmask args ) )
255 {
2562136µs next if $f eq 'args';
257 *{$f} = sub { my $s = shift; return $s->{$f} };
258 }
2591388µs144µs}
# spent 44µs making 1 call to Devel::StackTraceFrame::BEGIN@251
260
261{
26223µs my @fields =
263 ( qw( package filename line subroutine hasargs wantarray
264 evaltext is_require hints bitmask ) );
265
266 sub new
267 {
268 my $proto = shift;
269 my $class = ref $proto || $proto;
270
271 my $self = bless {}, $class;
272
273 @{ $self }{ @fields } = @{$_[0]};
274
275 # fixup unix-style paths on win32
276 $self->{filename} = File::Spec->canonpath( $self->{filename} );
277
278 $self->{args} = $_[1];
279
280 $self->{respect_overload} = $_[2];
281
282 $self->{max_arg_length} = $_[3];
283
284 return $self;
285 }
286}
287
288sub args
289{
290 my $self = shift;
291
292 return @{ $self->{args} };
293}
294
295sub as_string
296{
297 my $self = shift;
298 my $first = shift;
299
300 my $sub = $self->subroutine;
301 # This code stolen straight from Carp.pm and then tweaked. All
302 # errors are probably my fault -dave
303 if ($first)
304 {
305 $sub = 'Trace begun';
306 }
307 else
308 {
309 # Build a string, $sub, which names the sub-routine called.
310 # This may also be "require ...", "eval '...' or "eval {...}"
311 if (my $eval = $self->evaltext)
312 {
313 if ($self->is_require)
314 {
315 $sub = "require $eval";
316 }
317 else
318 {
319 $eval =~ s/([\\\'])/\\$1/g;
320 $sub = "eval '$eval'";
321 }
322 }
323 elsif ($sub eq '(eval)')
324 {
325 $sub = 'eval {...}';
326 }
327
328 # if there are any arguments in the sub-routine call, format
329 # them according to the format variables defined earlier in
330 # this file and join them onto the $sub sub-routine string
331 #
332 # We copy them because they're going to be modified.
333 #
334 if ( my @a = $self->args )
335 {
336 for (@a)
337 {
338 # set args to the string "undef" if undefined
339 $_ = "undef", next unless defined $_;
340
341 # hack!
342 $_ = $self->Devel::StackTrace::_ref_to_string($_)
343 if ref $_;
344
345 eval
346 {
347 if ( $self->{max_arg_length}
348 && length $_ > $self->{max_arg_length} )
349 {
350 substr( $_, $self->{max_arg_length} ) = '...';
351 }
352
353 s/'/\\'/g;
354
355 # 'quote' arg unless it looks like a number
356 $_ = "'$_'" unless /^-?[\d.]+$/;
357
358 # print control/high ASCII chars as 'M-<char>' or '^<char>'
359 s/([\200-\377])/sprintf("M-%c",ord($1)&0177)/eg;
360 s/([\0-\37\177])/sprintf("^%c",ord($1)^64)/eg;
361 };
362
363 if ( my $e = $@ )
364 {
365 $_ = $e =~ /malformed utf-8/i ? '(bad utf-8)' : '?';
366 }
367 }
368
369 # append ('all', 'the', 'arguments') to the $sub string
370 $sub .= '(' . join(', ', @a) . ')';
371 $sub .= ' called';
372 }
373 }
374
375 return "$sub at " . $self->filename . ' line ' . $self->line;
376}
377
378115µs1;
379
380
381__END__
382
383=head1 NAME
384
385Devel::StackTrace - Stack trace and stack trace frame objects
386
387=head1 SYNOPSIS
388
389 use Devel::StackTrace;
390
391 my $trace = Devel::StackTrace->new;
392
393 print $trace->as_string; # like carp
394
395 # from top (most recent) of stack to bottom.
396 while (my $frame = $trace->next_frame)
397 {
398 print "Has args\n" if $frame->hasargs;
399 }
400
401 # from bottom (least recent) of stack to top.
402 while (my $frame = $trace->prev_frame)
403 {
404 print "Sub: ", $frame->subroutine, "\n";
405 }
406
407=head1 DESCRIPTION
408
409The Devel::StackTrace module contains two classes, Devel::StackTrace
410and Devel::StackTraceFrame. The goal of this object is to encapsulate
411the information that can found through using the caller() function, as
412well as providing a simple interface to this data.
413
414The Devel::StackTrace object contains a set of Devel::StackTraceFrame
415objects, one for each level of the stack. The frames contain all the
416data available from C<caller()>.
417
418This code was created to support my L<Exception::Class::Base> class
419(part of Exception::Class) but may be useful in other contexts.
420
421=head1 'TOP' AND 'BOTTOM' OF THE STACK
422
423When describing the methods of the trace object, I use the words 'top'
424and 'bottom'. In this context, the 'top' frame on the stack is the
425most recent frame and the 'bottom' is the least recent.
426
427Here's an example:
428
429 foo(); # bottom frame is here
430
431 sub foo
432 {
433 bar();
434 }
435
436 sub bar
437 {
438 Devel::StackTrace->new; # top frame is here.
439 }
440
441=head1 Devel::StackTrace METHODS
442
443=over 4
444
445=item * Devel::StackTrace->new(%named_params)
446
447Returns a new Devel::StackTrace object.
448
449Takes the following parameters:
450
451=over 8
452
453=item * frame_filter => $sub
454
455By default, Devel::StackTrace will include all stack frames before the
456call to its its constructor.
457
458However, you may want to filter out some frames with more granularity
459than 'ignore_package' or 'ignore_class' allow.
460
461You can provide a subroutine which is called with the raw frame data
462for each frame. This is a hash reference with two keys, "caller", and
463"args", both of which are array references. The "caller" key is the
464raw data as returned by Perl's C<caller()> function, and the "args"
465key are the subroutine arguments found in C<@DB::args>.
466
467The filter should return true if the frame should be included, or
468false if it should be skipped.
469
470=item * ignore_package => $package_name OR \@package_names
471
472Any frames where the package is one of these packages will not be on
473the stack.
474
475=item * ignore_class => $package_name OR \@package_names
476
477Any frames where the package is a subclass of one of these packages
478(or is the same package) will not be on the stack.
479
480Devel::StackTrace internally adds itself to the 'ignore_package'
481parameter, meaning that the Devel::StackTrace package is B<ALWAYS>
482ignored. However, if you create a subclass of Devel::StackTrace it
483will not be ignored.
484
485=item * no_refs => $boolean
486
487If this parameter is true, then Devel::StackTrace will not store
488references internally when generating stacktrace frames. This lets
489your objects go out of scope.
490
491Devel::StackTrace replaces any references with their stringified
492representation.
493
494=item * respect_overload => $boolean
495
496By default, Devel::StackTrace will call C<overload::AddrRef()> to get
497the underlying string representation of an object, instead of
498respecting the object's stringification overloading. If you would
499prefer to see the overloaded representation of objects in stack
500traces, then set this parameter to true.
501
502=item * max_arg_length => $integer
503
504By default, Devel::StackTrace will display the entire argument for
505each subroutine call. Setting this parameter causes it to truncate the
506argument's string representation if it is longer than this number of
507characters.
508
509=back
510
511=item * $trace->next_frame
512
513Returns the next Devel::StackTraceFrame object down on the stack. If
514it hasn't been called before it returns the first frame. It returns
515undef when it reaches the bottom of the stack and then resets its
516pointer so the next call to C<next_frame> or C<prev_frame> will work
517properly.
518
519=item * $trace->prev_frame
520
521Returns the next Devel::StackTraceFrame object up on the stack. If it
522hasn't been called before it returns the last frame. It returns undef
523when it reaches the top of the stack and then resets its pointer so
524pointer so the next call to C<next_frame> or C<prev_frame> will work
525properly.
526
527=item * $trace->reset_pointer
528
529Resets the pointer so that the next call C<next_frame> or
530C<prev_frame> will start at the top or bottom of the stack, as
531appropriate.
532
533=item * $trace->frames
534
535Returns a list of Devel::StackTraceFrame objects. The order they are
536returned is from top (most recent) to bottom.
537
538=item * $trace->frame ($index)
539
540Given an index, returns the relevant frame or undef if there is not
541frame at that index. The index is exactly like a Perl array. The
542first frame is 0 and negative indexes are allowed.
543
544=item * $trace->frame_count
545
546Returns the number of frames in the trace object.
547
548=item * $trace->as_string
549
550Calls as_string on each frame from top to bottom, producing output
551quite similar to the Carp module's cluck/confess methods.
552
553=back
554
555=head1 Devel::StackTraceFrame METHODS
556
557See the L<caller> documentation for more information on what these
558methods return.
559
560=over 4
561
562=item * $frame->package
563
564=item * $frame->filename
565
566=item * $frame->line
567
568=item * $frame->subroutine
569
570=item * $frame->hasargs
571
572=item * $frame->wantarray
573
574=item * $frame->evaltext
575
576Returns undef if the frame was not part of an eval.
577
578=item * $frame->is_require
579
580Returns undef if the frame was not part of a require.
581
582=item * $frame->args
583
584Returns the arguments passed to the frame. Note that any arguments
585that are references are returned as references, not copies.
586
587=item * $frame->hints
588
589=item * $frame->bitmask
590
591=back
592
593=head1 SUPPORT
594
595Please submit bugs to the CPAN RT system at
596http://rt.cpan.org/NoAuth/ReportBug.html?Queue=Devel%3A%3AStackTrace
597or via email at bug-devel-stacktrace@rt.cpan.org.
598
599=head1 AUTHOR
600
601Dave Rolsky, <autarch@urth.org>
602
603=head1 COPYRIGHT
604
605Copyright (c) 2000-2006 David Rolsky. All rights reserved. This
606program is free software; you can redistribute it and/or modify it
607under the same terms as Perl itself.
608
609The full text of the license can be found in the LICENSE file included
610with this module.
611
612=cut