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