Profile of /usr/local/lib/perl5/site_perl/5.10.1/Devel/StackTrace.pm

← 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:22 2010

File | /usr/local/lib/perl5/site_perl/5.10.1/Devel/StackTrace.pm
Statements Executed | 552
Statement Execution Time | 2.57ms

Subroutines — ordered by exclusive time
Calls | P | F | Exclusive Time | Inclusive Time | Subroutine
--- | --- | --- | --- | --- | ---
1 | 1 | 1 | 1.69ms | 1.83ms | Devel::StackTrace::::BEGIN@8 Devel::StackTrace::BEGIN@8
5 | 1 | 1 | 702µs | 1.30ms | Devel::StackTrace::::_record_caller_data Devel::StackTrace::_record_caller_data
20 | 1 | 1 | 193µs | 599µs | Devel::StackTrace::::_ref_to_string Devel::StackTrace::_ref_to_string
5 | 1 | 1 | 134µs | 1.43ms | Devel::StackTrace::::new Devel::StackTrace::new
1 | 1 | 1 | 44µs | 44µs | Devel::StackTraceFrame::::BEGIN@251Devel::StackTraceFrame::BEGIN@251
1 | 1 | 1 | 22µs | 22µs | Devel::StackTrace::::BEGIN@3 Devel::StackTrace::BEGIN@3
1 | 1 | 1 | 11µs | 14µs | Devel::StackTrace::::BEGIN@5 Devel::StackTrace::BEGIN@5
1 | 1 | 1 | 11µs | 20µs | Devel::StackTrace::::BEGIN@6 Devel::StackTrace::BEGIN@6
1 | 1 | 1 | 11µs | 50µs | Devel::StackTrace::::BEGIN@12 Devel::StackTrace::BEGIN@12
1 | 1 | 1 | 11µs | 15µs | Devel::StackTraceFrame::::BEGIN@244Devel::StackTraceFrame::BEGIN@244
1 | 1 | 1 | 9µs | 52µs | Devel::StackTrace::::BEGIN@9 Devel::StackTrace::BEGIN@9
1 | 1 | 1 | 8µs | 24µs | Devel::StackTraceFrame::::BEGIN@245Devel::StackTraceFrame::BEGIN@245
1 | 1 | 1 | 7µs | 17µs | Devel::StackTraceFrame::::BEGIN@252Devel::StackTraceFrame::BEGIN@252
0 | 0 | 0 | 0s | 0s | Devel::StackTrace::::__ANON__[:132] Devel::StackTrace::__ANON__[:132]
0 | 0 | 0 | 0s | 0s | Devel::StackTrace::::__ANON__[:96] Devel::StackTrace::__ANON__[:96]
0 | 0 | 0 | 0s | 0s | Devel::StackTrace::::_add_frame Devel::StackTrace::_add_frame
0 | 0 | 0 | 0s | 0s | Devel::StackTrace::::_make_frame_filter Devel::StackTrace::_make_frame_filter
0 | 0 | 0 | 0s | 0s | Devel::StackTrace::::_make_frames Devel::StackTrace::_make_frames
0 | 0 | 0 | 0s | 0s | Devel::StackTrace::::as_string Devel::StackTrace::as_string
0 | 0 | 0 | 0s | 0s | Devel::StackTrace::::frame Devel::StackTrace::frame
0 | 0 | 0 | 0s | 0s | Devel::StackTrace::::frame_count Devel::StackTrace::frame_count
0 | 0 | 0 | 0s | 0s | Devel::StackTrace::::frames Devel::StackTrace::frames
0 | 0 | 0 | 0s | 0s | Devel::StackTrace::::next_frame Devel::StackTrace::next_frame
0 | 0 | 0 | 0s | 0s | Devel::StackTrace::::prev_frame Devel::StackTrace::prev_frame
0 | 0 | 0 | 0s | 0s | Devel::StackTrace::::reset_pointer Devel::StackTrace::reset_pointer
0 | 0 | 0 | 0s | 0s | Devel::StackTraceFrame::::__ANON__[:257]Devel::StackTraceFrame::__ANON__[:257]
0 | 0 | 0 | 0s | 0s | Devel::StackTraceFrame::::argsDevel::StackTraceFrame::args
0 | 0 | 0 | 0s | 0s | Devel::StackTraceFrame::::as_stringDevel::StackTraceFrame::as_string
0 | 0 | 0 | 0s | 0s | Devel::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
--- | --- | --- | --- | --- | ---
1 |  |  |  |  | package Devel::StackTrace;
2 |  |  |  |  |
3 | 3 | 33µs | 1 | 22µ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 |  |  |  |  |
5 | 3 | 21µs | 2 | 17µ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
6 | 3 | 20µs | 2 | 29µ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 |  |  |  |  |
8 | 3 | 113µs | 1 | 1.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
9 | 3 | 32µs | 2 | 95µ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 |  |  |  |  |
11 |  |  |  |  | use 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
13 | 3 | 793µs | 1 | 50µs | fallback => 1; # spent 50µs making 1 call to Devel::StackTrace::BEGIN@12
14 |  |  |  |  |
15 | 1 | 800ns |  |  | our $VERSION = '1.22';
16 |  |  |  |  |
17 |  |  |  |  |
18 |  |  |  |  | sub 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 {
20 | 30 | 126µ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 |  |  |  |  |
40 |  |  |  |  | sub _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 {
42 | 391 | 611µs |  |  | my $self = shift;
43 |  |  |  |  |
44 |  |  |  |  | # We exclude this method by starting one frame back.
45 |  |  |  |  | my $x = 1;
46 |  |  |  |  | while ( my @c =
47 |  |  |  |  | do { package DB; @DB::args = (); caller($x++) } )
48 |  |  |  |  | {
49 |  |  |  |  | my @a = @DB::args;
50 |  |  |  |  |
51 |  |  |  |  | if ( $self->{no_refs} )
52 |  |  |  |  | {
53 |  |  |  |  | @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 |  |  |  |  |
63 |  |  |  |  | sub _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 {
65 | 75 | 231µ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 |  |  |  |  |
81 |  |  |  |  | sub _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 |  |  |  |  |
96 | 1 | 2µs |  |  | my $default_filter = sub { 1 };
97 |  |  |  |  | sub _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 |  |  |  |  |
135 |  |  |  |  | sub _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 |  |  |  |  |
153 |  |  |  |  | sub 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 |  |  |  |  |
172 |  |  |  |  | sub 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 |  |  |  |  |
192 |  |  |  |  | sub reset_pointer
193 |  |  |  |  | {
194 |  |  |  |  | my $self = shift;
195 |  |  |  |  |
196 |  |  |  |  | $self->{index} = undef;
197 |  |  |  |  | }
198 |  |  |  |  |
199 |  |  |  |  | sub frames
200 |  |  |  |  | {
201 |  |  |  |  | my $self = shift;
202 |  |  |  |  |
203 |  |  |  |  | $self->_make_frames() if $self->{raw};
204 |  |  |  |  |
205 |  |  |  |  | return @{ $self->{frames} };
206 |  |  |  |  | }
207 |  |  |  |  |
208 |  |  |  |  | sub frame
209 |  |  |  |  | {
210 |  |  |  |  | my $self = shift;
211 |  |  |  |  | my $i = shift;
212 |  |  |  |  |
213 |  |  |  |  | return unless defined $i;
214 |  |  |  |  |
215 |  |  |  |  | return ( $self->frames() )[$i];
216 |  |  |  |  | }
217 |  |  |  |  |
218 |  |  |  |  | sub frame_count
219 |  |  |  |  | {
220 |  |  |  |  | my $self = shift;
221 |  |  |  |  |
222 |  |  |  |  | return scalar ( $self->frames() );
223 |  |  |  |  | }
224 |  |  |  |  |
225 |  |  |  |  | sub 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
241 |  |  |  |  | package
242 |  |  |  |  | Devel::StackTraceFrame;
243 |  |  |  |  |
244 | 3 | 20µs | 2 | 19µ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
245 | 3 | 35µs | 2 | 39µ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 |  |  |  |  |
247 | 1 | 200ns |  |  | our $VERSION = $Devel::StackTrace::VERSION;
248 |  |  |  |  |
249 |  |  |  |  | # Create accessor routines
250 |  |  |  |  | BEGIN
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 {
252 | 3 | 81µs | 2 | 28µ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
253 | 22 | 42µs |  |  | foreach my $f ( qw( package filename line subroutine hasargs
254 |  |  |  |  | wantarray evaltext is_require hints bitmask args ) )
255 |  |  |  |  | {
256 |  |  |  |  | next if $f eq 'args';
257 |  |  |  |  | *{$f} = sub { my $s = shift; return $s->{$f} };
258 |  |  |  |  | }
259 | 1 | 388µs | 1 | 44µs | } # spent 44µs making 1 call to Devel::StackTraceFrame::BEGIN@251
260 |  |  |  |  |
261 |  |  |  |  | {
262 | 2 | 3µ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 |  |  |  |  |
288 |  |  |  |  | sub args
289 |  |  |  |  | {
290 |  |  |  |  | my $self = shift;
291 |  |  |  |  |
292 |  |  |  |  | return @{ $self->{args} };
293 |  |  |  |  | }
294 |  |  |  |  |
295 |  |  |  |  | sub 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 |  |  |  |  |
378 | 1 | 15µs |  |  | 1;
379 |  |  |  |  |
380 |  |  |  |  |
381 |  |  |  |  | __END__
382 |  |  |  |  |
383 |  |  |  |  | =head1 NAME
384 |  |  |  |  |
385 |  |  |  |  | Devel::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 |  |  |  |  |
409 |  |  |  |  | The Devel::StackTrace module contains two classes, Devel::StackTrace
410 |  |  |  |  | and Devel::StackTraceFrame. The goal of this object is to encapsulate
411 |  |  |  |  | the information that can found through using the caller() function, as
412 |  |  |  |  | well as providing a simple interface to this data.
413 |  |  |  |  |
414 |  |  |  |  | The Devel::StackTrace object contains a set of Devel::StackTraceFrame
415 |  |  |  |  | objects, one for each level of the stack. The frames contain all the
416 |  |  |  |  | data available from C<caller()>.
417 |  |  |  |  |
418 |  |  |  |  | This 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 |  |  |  |  |
423 |  |  |  |  | When describing the methods of the trace object, I use the words 'top'
424 |  |  |  |  | and 'bottom'. In this context, the 'top' frame on the stack is the
425 |  |  |  |  | most recent frame and the 'bottom' is the least recent.
426 |  |  |  |  |
427 |  |  |  |  | Here'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 |  |  |  |  |
447 |  |  |  |  | Returns a new Devel::StackTrace object.
448 |  |  |  |  |
449 |  |  |  |  | Takes the following parameters:
450 |  |  |  |  |
451 |  |  |  |  | =over 8
452 |  |  |  |  |
453 |  |  |  |  | =item * frame_filter => $sub
454 |  |  |  |  |
455 |  |  |  |  | By default, Devel::StackTrace will include all stack frames before the
456 |  |  |  |  | call to its its constructor.
457 |  |  |  |  |
458 |  |  |  |  | However, you may want to filter out some frames with more granularity
459 |  |  |  |  | than 'ignore_package' or 'ignore_class' allow.
460 |  |  |  |  |
461 |  |  |  |  | You can provide a subroutine which is called with the raw frame data
462 |  |  |  |  | for 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
464 |  |  |  |  | raw data as returned by Perl's C<caller()> function, and the "args"
465 |  |  |  |  | key are the subroutine arguments found in C<@DB::args>.
466 |  |  |  |  |
467 |  |  |  |  | The filter should return true if the frame should be included, or
468 |  |  |  |  | false if it should be skipped.
469 |  |  |  |  |
470 |  |  |  |  | =item * ignore_package => $package_name OR \@package_names
471 |  |  |  |  |
472 |  |  |  |  | Any frames where the package is one of these packages will not be on
473 |  |  |  |  | the stack.
474 |  |  |  |  |
475 |  |  |  |  | =item * ignore_class => $package_name OR \@package_names
476 |  |  |  |  |
477 |  |  |  |  | Any 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 |  |  |  |  |
480 |  |  |  |  | Devel::StackTrace internally adds itself to the 'ignore_package'
481 |  |  |  |  | parameter, meaning that the Devel::StackTrace package is B<ALWAYS>
482 |  |  |  |  | ignored. However, if you create a subclass of Devel::StackTrace it
483 |  |  |  |  | will not be ignored.
484 |  |  |  |  |
485 |  |  |  |  | =item * no_refs => $boolean
486 |  |  |  |  |
487 |  |  |  |  | If this parameter is true, then Devel::StackTrace will not store
488 |  |  |  |  | references internally when generating stacktrace frames. This lets
489 |  |  |  |  | your objects go out of scope.
490 |  |  |  |  |
491 |  |  |  |  | Devel::StackTrace replaces any references with their stringified
492 |  |  |  |  | representation.
493 |  |  |  |  |
494 |  |  |  |  | =item * respect_overload => $boolean
495 |  |  |  |  |
496 |  |  |  |  | By default, Devel::StackTrace will call C<overload::AddrRef()> to get
497 |  |  |  |  | the underlying string representation of an object, instead of
498 |  |  |  |  | respecting the object's stringification overloading. If you would
499 |  |  |  |  | prefer to see the overloaded representation of objects in stack
500 |  |  |  |  | traces, then set this parameter to true.
501 |  |  |  |  |
502 |  |  |  |  | =item * max_arg_length => $integer
503 |  |  |  |  |
504 |  |  |  |  | By default, Devel::StackTrace will display the entire argument for
505 |  |  |  |  | each subroutine call. Setting this parameter causes it to truncate the
506 |  |  |  |  | argument's string representation if it is longer than this number of
507 |  |  |  |  | characters.
508 |  |  |  |  |
509 |  |  |  |  | =back
510 |  |  |  |  |
511 |  |  |  |  | =item * $trace->next_frame
512 |  |  |  |  |
513 |  |  |  |  | Returns the next Devel::StackTraceFrame object down on the stack. If
514 |  |  |  |  | it hasn't been called before it returns the first frame. It returns
515 |  |  |  |  | undef when it reaches the bottom of the stack and then resets its
516 |  |  |  |  | pointer so the next call to C<next_frame> or C<prev_frame> will work
517 |  |  |  |  | properly.
518 |  |  |  |  |
519 |  |  |  |  | =item * $trace->prev_frame
520 |  |  |  |  |
521 |  |  |  |  | Returns the next Devel::StackTraceFrame object up on the stack. If it
522 |  |  |  |  | hasn't been called before it returns the last frame. It returns undef
523 |  |  |  |  | when it reaches the top of the stack and then resets its pointer so
524 |  |  |  |  | pointer so the next call to C<next_frame> or C<prev_frame> will work
525 |  |  |  |  | properly.
526 |  |  |  |  |
527 |  |  |  |  | =item * $trace->reset_pointer
528 |  |  |  |  |
529 |  |  |  |  | Resets the pointer so that the next call C<next_frame> or
530 |  |  |  |  | C<prev_frame> will start at the top or bottom of the stack, as
531 |  |  |  |  | appropriate.
532 |  |  |  |  |
533 |  |  |  |  | =item * $trace->frames
534 |  |  |  |  |
535 |  |  |  |  | Returns a list of Devel::StackTraceFrame objects. The order they are
536 |  |  |  |  | returned is from top (most recent) to bottom.
537 |  |  |  |  |
538 |  |  |  |  | =item * $trace->frame ($index)
539 |  |  |  |  |
540 |  |  |  |  | Given an index, returns the relevant frame or undef if there is not
541 |  |  |  |  | frame at that index. The index is exactly like a Perl array. The
542 |  |  |  |  | first frame is 0 and negative indexes are allowed.
543 |  |  |  |  |
544 |  |  |  |  | =item * $trace->frame_count
545 |  |  |  |  |
546 |  |  |  |  | Returns the number of frames in the trace object.
547 |  |  |  |  |
548 |  |  |  |  | =item * $trace->as_string
549 |  |  |  |  |
550 |  |  |  |  | Calls as_string on each frame from top to bottom, producing output
551 |  |  |  |  | quite similar to the Carp module's cluck/confess methods.
552 |  |  |  |  |
553 |  |  |  |  | =back
554 |  |  |  |  |
555 |  |  |  |  | =head1 Devel::StackTraceFrame METHODS
556 |  |  |  |  |
557 |  |  |  |  | See the L<caller> documentation for more information on what these
558 |  |  |  |  | methods 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 |  |  |  |  |
576 |  |  |  |  | Returns undef if the frame was not part of an eval.
577 |  |  |  |  |
578 |  |  |  |  | =item * $frame->is_require
579 |  |  |  |  |
580 |  |  |  |  | Returns undef if the frame was not part of a require.
581 |  |  |  |  |
582 |  |  |  |  | =item * $frame->args
583 |  |  |  |  |
584 |  |  |  |  | Returns the arguments passed to the frame. Note that any arguments
585 |  |  |  |  | that 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 |  |  |  |  |
595 |  |  |  |  | Please submit bugs to the CPAN RT system at
596 |  |  |  |  | http://rt.cpan.org/NoAuth/ReportBug.html?Queue=Devel%3A%3AStackTrace
597 |  |  |  |  | or via email at bug-devel-stacktrace@rt.cpan.org.
598 |  |  |  |  |
599 |  |  |  |  | =head1 AUTHOR
600 |  |  |  |  |
601 |  |  |  |  | Dave Rolsky, <autarch@urth.org>
602 |  |  |  |  |
603 |  |  |  |  | =head1 COPYRIGHT
604 |  |  |  |  |
605 |  |  |  |  | Copyright (c) 2000-2006 David Rolsky. All rights reserved. This
606 |  |  |  |  | program is free software; you can redistribute it and/or modify it
607 |  |  |  |  | under the same terms as Perl itself.
608 |  |  |  |  |
609 |  |  |  |  | The full text of the license can be found in the LICENSE file included
610 |  |  |  |  | with this module.
611 |  |  |  |  |
612 |  |  |  |  | =cut