← Index
NYTProf Performance Profile   « line view »
For /usr/local/libexec/sympa/task_manager-debug.pl
  Run on Tue Jun 1 22:32:51 2021
Reported on Tue Jun 1 22:35:05 2021

Filename/usr/local/lib/perl5/site_perl/Devel/StackTrace.pm
StatementsExecuted 0 statements in 0s
Subroutines
Calls P F Exclusive
Time
Inclusive
Time
Subroutine
0000s0sDevel::StackTrace::::BEGIN@10Devel::StackTrace::BEGIN@10
0000s0sDevel::StackTrace::::BEGIN@11Devel::StackTrace::BEGIN@11
0000s0sDevel::StackTrace::::BEGIN@12Devel::StackTrace::BEGIN@12
0000s0sDevel::StackTrace::::BEGIN@15Devel::StackTrace::BEGIN@15
0000s0sDevel::StackTrace::::BEGIN@3Devel::StackTrace::BEGIN@3
0000s0sDevel::StackTrace::::BEGIN@5Devel::StackTrace::BEGIN@5
0000s0sDevel::StackTrace::::BEGIN@6Devel::StackTrace::BEGIN@6
0000s0sDevel::StackTrace::::__ANON__Devel::StackTrace::__ANON__ (xsub)
0000s0sDevel::StackTrace::::__ANON__[:142]Devel::StackTrace::__ANON__[:142]
0000s0sDevel::StackTrace::::__ANON__[:181]Devel::StackTrace::__ANON__[:181]
0000s0sDevel::StackTrace::::_add_frameDevel::StackTrace::_add_frame
0000s0sDevel::StackTrace::::_make_frame_filterDevel::StackTrace::_make_frame_filter
0000s0sDevel::StackTrace::::_make_framesDevel::StackTrace::_make_frames
0000s0sDevel::StackTrace::::_record_caller_dataDevel::StackTrace::_record_caller_data
0000s0sDevel::StackTrace::::_ref_to_stringDevel::StackTrace::_ref_to_string
0000s0sDevel::StackTrace::::as_stringDevel::StackTrace::as_string
0000s0sDevel::StackTrace::::frameDevel::StackTrace::frame
0000s0sDevel::StackTrace::::frame_countDevel::StackTrace::frame_count
0000s0sDevel::StackTrace::::framesDevel::StackTrace::frames
0000s0sDevel::StackTrace::::messageDevel::StackTrace::message
0000s0sDevel::StackTrace::::newDevel::StackTrace::new
0000s0sDevel::StackTrace::::next_frameDevel::StackTrace::next_frame
0000s0sDevel::StackTrace::::prev_frameDevel::StackTrace::prev_frame
0000s0sDevel::StackTrace::::reset_pointerDevel::StackTrace::reset_pointer
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
3use 5.006;
4
5use strict;
6use warnings;
7
8our $VERSION = '2.04';
9
10use Devel::StackTrace::Frame;
11use File::Spec;
12use Scalar::Util qw( blessed );
13
14use overload
15 '""' => \&as_string,
16 fallback => 1;
17
18sub new {
19 my $class = shift;
20 my %p = @_;
21
22 $p{unsafe_ref_capture} = !delete $p{no_refs}
23 if exists $p{no_refs};
24
25 my $self = bless {
26 index => undef,
27 frames => [],
28 raw => [],
29 %p,
30 }, $class;
31
32 $self->_record_caller_data;
33
34 return $self;
35}
36
37sub _record_caller_data {
38 my $self = shift;
39
40 my $filter = $self->{filter_frames_early} && $self->_make_frame_filter;
41
42 # We exclude this method by starting at least one frame back.
43 my $x = 1 + ( $self->{skip_frames} || 0 );
44
45 while (
46 my @c
47 = $self->{no_args}
48 ? caller( $x++ )
49 : do {
50 ## no critic (Modules::ProhibitMultiplePackages, Variables::ProhibitPackageVars)
51 package # the newline keeps dzil from adding a version here
52 DB;
53
- -
56 ) {
57
58 my @args;
59
60 ## no critic (Variables::ProhibitPackageVars, BuiltinFunctions::ProhibitComplexMappings)
61 unless ( $self->{no_args} ) {
62
63 # This is the same workaroud as was applied to Carp.pm a little
64 # while back
65 # (https://rt.perl.org/Public/Bug/Display.html?id=131046):
66 #
67 # Guard our serialization of the stack from stack refcounting
68 # bugs NOTE this is NOT a complete solution, we cannot 100%
69 # guard against these bugs. However in many cases Perl *is*
70 # capable of detecting them and throws an error when it
71 # does. Unfortunately serializing the arguments on the stack is
72 # a perfect way of finding these bugs, even when they would not
73 # affect normal program flow that did not poke around inside the
74 # stack. Inside of Carp.pm it makes little sense reporting these
75 # bugs, as Carp's job is to report the callers errors, not the
76 # ones it might happen to tickle while doing so. See:
77 # https://rt.perl.org/Public/Bug/Display.html?id=131046 and:
78 # https://rt.perl.org/Public/Bug/Display.html?id=52610 for more
79 # details and discussion. - Yves
80 @args = map {
81 my $arg;
82 local $@ = $@;
83 eval {
84 $arg = $_;
85 1;
86 } or do {
87 $arg = '** argument not available anymore **';
88 };
89 $arg;
90 } @DB::args;
91 }
92 ## use critic
93
94 my $raw = {
95 caller => \@c,
96 args => \@args,
97 };
98
99 next if $filter && !$filter->($raw);
100
101 unless ( $self->{unsafe_ref_capture} ) {
102 $raw->{args} = [ map { ref $_ ? $self->_ref_to_string($_) : $_ }
103 @{ $raw->{args} } ];
104 }
105
106 push @{ $self->{raw} }, $raw;
107 }
108}
109
110sub _ref_to_string {
111 my $self = shift;
112 my $ref = shift;
113
114 return overload::AddrRef($ref)
115 if blessed $ref && $ref->isa('Exception::Class::Base');
116
117 return overload::AddrRef($ref) unless $self->{respect_overload};
118
119 ## no critic (Variables::RequireInitializationForLocalVars)
120 local $@;
121 local $SIG{__DIE__};
122 ## use critic
123
124 my $str = eval { $ref . q{} };
125
126 return $@ ? overload::AddrRef($ref) : $str;
127}
128
129sub _make_frames {
130 my $self = shift;
131
132 my $filter = !$self->{filter_frames_early} && $self->_make_frame_filter;
133
134 my $raw = delete $self->{raw};
135 for my $r ( @{$raw} ) {
136 next if $filter && !$filter->($r);
137
138 $self->_add_frame( $r->{caller}, $r->{args} );
139 }
140}
141
142my $default_filter = sub {1};
143
144sub _make_frame_filter {
145 my $self = shift;
146
147 my ( @i_pack_re, %i_class );
148 if ( $self->{ignore_package} ) {
149 ## no critic (Variables::RequireInitializationForLocalVars)
150 local $@;
151 local $SIG{__DIE__};
152 ## use critic
153
154 $self->{ignore_package} = [ $self->{ignore_package} ]
155 unless eval { @{ $self->{ignore_package} } };
156
157 @i_pack_re
158 = map { ref $_ ? $_ : qr/^\Q$_\E$/ } @{ $self->{ignore_package} };
159 }
160
161 my $p = __PACKAGE__;
162 push @i_pack_re, qr/^\Q$p\E$/;
163
164 if ( $self->{ignore_class} ) {
165 $self->{ignore_class} = [ $self->{ignore_class} ]
166 unless ref $self->{ignore_class};
167 %i_class = map { $_ => 1 } @{ $self->{ignore_class} };
168 }
169
170 my $user_filter = $self->{frame_filter};
171
172 return sub {
173 return 0 if grep { $_[0]{caller}[0] =~ /$_/ } @i_pack_re;
174 return 0 if grep { $_[0]{caller}[0]->isa($_) } keys %i_class;
175
176 if ($user_filter) {
177 return $user_filter->( $_[0] );
178 }
179
180 return 1;
181 };
182}
183
184sub _add_frame {
185 my $self = shift;
186 my $c = shift;
187 my $p = shift;
188
189 # eval and is_require are only returned when applicable under 5.00503.
190 push @$c, ( undef, undef ) if scalar @$c == 6;
191
192 push @{ $self->{frames} },
193 Devel::StackTrace::Frame->new(
194 $c,
195 $p,
196 $self->{respect_overload},
197 $self->{max_arg_length},
198 $self->{message},
199 $self->{indent}
200 );
201}
202
203sub next_frame {
204 my $self = shift;
205
206 # reset to top if necessary.
207 $self->{index} = -1 unless defined $self->{index};
208
209 my @f = $self->frames;
210 if ( defined $f[ $self->{index} + 1 ] ) {
211 return $f[ ++$self->{index} ];
212 }
213 else {
214 $self->{index} = undef;
215 ## no critic (Subroutines::ProhibitExplicitReturnUndef)
216 return undef;
217 }
218}
219
220sub prev_frame {
221 my $self = shift;
222
223 my @f = $self->frames;
224
225 # reset to top if necessary.
226 $self->{index} = scalar @f unless defined $self->{index};
227
228 if ( defined $f[ $self->{index} - 1 ] && $self->{index} >= 1 ) {
229 return $f[ --$self->{index} ];
230 }
231 else {
232 ## no critic (Subroutines::ProhibitExplicitReturnUndef)
233 $self->{index} = undef;
234 return undef;
235 }
236}
237
238sub reset_pointer {
239 my $self = shift;
240
241 $self->{index} = undef;
242
243 return;
244}
245
246sub frames {
247 my $self = shift;
248
249 if (@_) {
250 die
251 "Devel::StackTrace->frames can only take Devel::StackTrace::Frame args\n"
252 if grep { !$_->isa('Devel::StackTrace::Frame') } @_;
253
254 $self->{frames} = \@_;
255 delete $self->{raw};
256 }
257 else {
258 $self->_make_frames if $self->{raw};
259 }
260
261 return @{ $self->{frames} };
262}
263
264sub frame {
265 my $self = shift;
266 my $i = shift;
267
268 return unless defined $i;
269
270 return ( $self->frames )[$i];
271}
272
273sub frame_count {
274 my $self = shift;
275
276 return scalar( $self->frames );
277}
278
279sub message { $_[0]->{message} }
280
281sub as_string {
282 my $self = shift;
283 my $p = shift;
284
285 my @frames = $self->frames;
286 if (@frames) {
287 my $st = q{};
288 my $first = 1;
289 for my $f (@frames) {
290 $st .= $f->as_string( $first, $p ) . "\n";
291 $first = 0;
292 }
293
294 return $st;
295 }
296
297 my $msg = $self->message;
298 return $msg if defined $msg;
299
300 return 'Trace begun';
301}
302
303{
304 ## no critic (Modules::ProhibitMultiplePackages, ClassHierarchies::ProhibitExplicitISA)
305 package # hide from PAUSE
306 Devel::StackTraceFrame;
307
308 our @ISA = 'Devel::StackTrace::Frame';
309}
310
3111;
312
313# ABSTRACT: An object representing a stack trace
314
315__END__