← 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/Frame.pm
StatementsExecuted 0 statements in 0s
Subroutines
Calls P F Exclusive
Time
Inclusive
Time
Subroutine
0000s0sDevel::StackTrace::Frame::::BEGIN@11Devel::StackTrace::Frame::BEGIN@11
0000s0sDevel::StackTrace::Frame::::BEGIN@3Devel::StackTrace::Frame::BEGIN@3
0000s0sDevel::StackTrace::Frame::::BEGIN@4Devel::StackTrace::Frame::BEGIN@4
0000s0sDevel::StackTrace::Frame::::BEGIN@9Devel::StackTrace::Frame::BEGIN@9
0000s0sDevel::StackTrace::Frame::::__ANON__[:27]Devel::StackTrace::Frame::__ANON__[:27]
0000s0sDevel::StackTrace::Frame::::argsDevel::StackTrace::Frame::args
0000s0sDevel::StackTrace::Frame::::as_stringDevel::StackTrace::Frame::as_string
0000s0sDevel::StackTrace::Frame::::newDevel::StackTrace::Frame::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::Frame;
2
3use strict;
4use warnings;
5
6our $VERSION = '2.04';
7
8# Create accessor routines
9BEGIN {
10 ## no critic (TestingAndDebugging::ProhibitNoStrict)
11 no strict 'refs';
12
13 my @attrs = qw(
14 package
15 filename
16 line
17 subroutine
18 hasargs
19 wantarray
20 evaltext
21 is_require
22 hints
23 bitmask
24 );
25
26 for my $attr (@attrs) {
27 *{$attr} = sub { my $s = shift; return $s->{$attr} };
28 }
29}
30
31{
32 my @args = qw(
33 package
34 filename
35 line
36 subroutine
37 hasargs
38 wantarray
39 evaltext
40 is_require
41 hints
42 bitmask
43 );
44
45 sub new {
46 my $proto = shift;
47 my $class = ref $proto || $proto;
48
49 my $self = bless {}, $class;
50
51 @{$self}{@args} = @{ shift() };
52 $self->{args} = shift;
53 $self->{respect_overload} = shift;
54 $self->{max_arg_length} = shift;
55 $self->{message} = shift;
56 $self->{indent} = shift;
57
58 # fixup unix-style paths on win32
59 $self->{filename} = File::Spec->canonpath( $self->{filename} );
60
61 return $self;
62 }
63}
64
65sub args {
66 my $self = shift;
67
68 return @{ $self->{args} };
69}
70
71sub as_string {
72 my $self = shift;
73 my $first = shift;
74 my $p = shift;
75
76 my $sub = $self->subroutine;
77
78 # This code stolen straight from Carp.pm and then tweaked. All
79 # errors are probably my fault -dave
80 if ($first) {
81 $sub
82 = defined $self->{message}
83 ? $self->{message}
84 : 'Trace begun';
85 }
86 else {
87
88 # Build a string, $sub, which names the sub-routine called.
89 # This may also be "require ...", "eval '...' or "eval {...}"
90 if ( my $eval = $self->evaltext ) {
91 if ( $self->is_require ) {
92 $sub = "require $eval";
93 }
94 else {
95 $eval =~ s/([\\\'])/\\$1/g;
96 $sub = "eval '$eval'";
97 }
98 }
99 elsif ( $sub eq '(eval)' ) {
100 $sub = 'eval {...}';
101 }
102
103 # if there are any arguments in the sub-routine call, format
104 # them according to the format variables defined earlier in
105 # this file and join them onto the $sub sub-routine string
106 #
107 # We copy them because they're going to be modified.
108 #
109 if ( my @a = $self->args ) {
110 for (@a) {
111
112 # set args to the string "undef" if undefined
113 unless ( defined $_ ) {
114 $_ = 'undef';
115 next;
116 }
117
118 # hack!
119 ## no critic (Subroutines::ProtectPrivateSubs)
120 $_ = $self->Devel::StackTrace::_ref_to_string($_)
121 if ref $_;
122 ## use critic;
123
124 ## no critic (Variables::RequireInitializationForLocalVars)
125 local $SIG{__DIE__};
126 local $@;
127 ## use critic;
128
129 ## no critic (ErrorHandling::RequireCheckingReturnValueOfEval)
130 eval {
131 my $max_arg_length
132 = exists $p->{max_arg_length}
133 ? $p->{max_arg_length}
134 : $self->{max_arg_length};
135
136 if ( $max_arg_length
137 && length $_ > $max_arg_length ) {
138 ## no critic (BuiltinFunctions::ProhibitLvalueSubstr)
139 substr( $_, $max_arg_length ) = '...';
140 }
141
142 s/'/\\'/g;
143
144 # 'quote' arg unless it looks like a number
145 $_ = "'$_'" unless /^-?[\d.]+$/;
146
147 # print control/high ASCII chars as 'M-<char>' or '^<char>'
148 s/([\200-\377])/sprintf("M-%c",ord($1)&0177)/eg;
149 s/([\0-\37\177])/sprintf("^%c",ord($1)^64)/eg;
150 };
151 ## use critic
152
153 if ( my $e = $@ ) {
154 $_ = $e =~ /malformed utf-8/i ? '(bad utf-8)' : '?';
155 }
156 }
157
158 # append ('all', 'the', 'arguments') to the $sub string
159 $sub .= '(' . join( ', ', @a ) . ')';
160 $sub .= ' called';
161 }
162 }
163
164 # If the user opted into indentation (a la Carp::confess), pre-add a tab
165 my $tab = $self->{indent} && !$first ? "\t" : q{};
166
167 return "${tab}$sub at " . $self->filename . ' line ' . $self->line;
168}
169
1701;
171
172# ABSTRACT: A single frame in a stack trace
173
174__END__