| line |
stmt |
bran |
cond |
sub |
pod |
time |
code |
|
1
|
|
|
|
|
|
|
package Carp::Capture; |
|
2
|
1
|
|
|
1
|
|
1009
|
use 5.010; |
|
|
1
|
|
|
|
|
3
|
|
|
|
1
|
|
|
|
|
51
|
|
|
3
|
1
|
|
|
1
|
|
6
|
use warnings FATAL => 'all'; |
|
|
1
|
|
|
|
|
1
|
|
|
|
1
|
|
|
|
|
56
|
|
|
4
|
1
|
|
|
1
|
|
6
|
use strict; |
|
|
1
|
|
|
|
|
2
|
|
|
|
1
|
|
|
|
|
47
|
|
|
5
|
|
|
|
|
|
|
|
|
6
|
1
|
|
|
1
|
|
317
|
use Carp::Proxy qw( fatal ); |
|
|
0
|
|
|
|
|
|
|
|
|
0
|
|
|
|
|
|
|
|
7
|
|
|
|
|
|
|
use English qw( -no_match_vars ); |
|
8
|
|
|
|
|
|
|
use Moose; |
|
9
|
|
|
|
|
|
|
use Readonly; |
|
10
|
|
|
|
|
|
|
|
|
11
|
|
|
|
|
|
|
our $VERSION = '0.02'; |
|
12
|
|
|
|
|
|
|
|
|
13
|
|
|
|
|
|
|
Readonly::Scalar my $BUG_REPORT |
|
14
|
|
|
|
|
|
|
=> 'http://rt.cpan.org/NoAuth/Bugs.html?Dist=Carp-Capture'; |
|
15
|
|
|
|
|
|
|
|
|
16
|
|
|
|
|
|
|
#----- The Boolean values pushed onto the 'capture_status' stack |
|
17
|
|
|
|
|
|
|
Readonly::Scalar my $ENABLED => 1; |
|
18
|
|
|
|
|
|
|
Readonly::Scalar my $DISABLED => 0; |
|
19
|
|
|
|
|
|
|
|
|
20
|
|
|
|
|
|
|
#----- The magic value returned when capturing has been disabled. |
|
21
|
|
|
|
|
|
|
Readonly::Scalar my $UNCAPTURED => 0; |
|
22
|
|
|
|
|
|
|
|
|
23
|
|
|
|
|
|
|
#----- We pack() uints to represent callstacks. 'I' maps to a C unsigned. |
|
24
|
|
|
|
|
|
|
Readonly::Scalar my $ENCODING => 'I*'; |
|
25
|
|
|
|
|
|
|
|
|
26
|
|
|
|
|
|
|
#----- How many bytes are consumed by encoding a single unsigned? |
|
27
|
|
|
|
|
|
|
Readonly::Scalar my $SIZEOF_UNSIGNED => length pack $ENCODING, 0; |
|
28
|
|
|
|
|
|
|
|
|
29
|
|
|
|
|
|
|
#----- We harvest 3 components (Subr, Line and File) from caller(). |
|
30
|
|
|
|
|
|
|
Readonly::Scalar my $FRAME_COMPONENTS => 3; |
|
31
|
|
|
|
|
|
|
Readonly::Scalar my $STACKFRAME_SIZE => $FRAME_COMPONENTS * $SIZEOF_UNSIGNED; |
|
32
|
|
|
|
|
|
|
|
|
33
|
|
|
|
|
|
|
#----- An association is an annotation id packed with a callstack id. |
|
34
|
|
|
|
|
|
|
Readonly::Scalar my $ASSOCIATION_SIZE => 2 * $SIZEOF_UNSIGNED; |
|
35
|
|
|
|
|
|
|
|
|
36
|
|
|
|
|
|
|
#----- For validation: id values are supposed to be unsigned integers |
|
37
|
|
|
|
|
|
|
Readonly::Scalar my $UNSIGNED_REX => qr{ \A \d+ \z }x; |
|
38
|
|
|
|
|
|
|
|
|
39
|
|
|
|
|
|
|
#----- Loathe Windows |
|
40
|
|
|
|
|
|
|
Readonly::Scalar my $LINE_SEPARATOR => ($OSNAME =~ /MSWin/xi) |
|
41
|
|
|
|
|
|
|
? "\r\n" |
|
42
|
|
|
|
|
|
|
: "\n"; |
|
43
|
|
|
|
|
|
|
|
|
44
|
|
|
|
|
|
|
#----- For indexing the list returned by caller() |
|
45
|
|
|
|
|
|
|
Readonly::Scalar my $CALLER_FILENAME => 1; |
|
46
|
|
|
|
|
|
|
Readonly::Scalar my $CALLER_LINE => 2; |
|
47
|
|
|
|
|
|
|
Readonly::Scalar my $CALLER_SUBROUTINE => 3; |
|
48
|
|
|
|
|
|
|
|
|
49
|
|
|
|
|
|
|
has 'components', |
|
50
|
|
|
|
|
|
|
( |
|
51
|
|
|
|
|
|
|
documentation => q{ 'string => id' mapping for caller() components }, |
|
52
|
|
|
|
|
|
|
is => 'ro', |
|
53
|
|
|
|
|
|
|
isa => 'HashRef', |
|
54
|
|
|
|
|
|
|
default => sub{ {} }, |
|
55
|
|
|
|
|
|
|
); |
|
56
|
|
|
|
|
|
|
|
|
57
|
|
|
|
|
|
|
has 'callstacks', |
|
58
|
|
|
|
|
|
|
( |
|
59
|
|
|
|
|
|
|
documentation => q{ 'string => id' mapping for packed callstacks }, |
|
60
|
|
|
|
|
|
|
is => 'ro', |
|
61
|
|
|
|
|
|
|
isa => 'HashRef', |
|
62
|
|
|
|
|
|
|
default => sub{ {} }, |
|
63
|
|
|
|
|
|
|
); |
|
64
|
|
|
|
|
|
|
|
|
65
|
|
|
|
|
|
|
has 'annotations', |
|
66
|
|
|
|
|
|
|
( |
|
67
|
|
|
|
|
|
|
documentation => q{ 'id => scalar' mapping for annotations }, |
|
68
|
|
|
|
|
|
|
is => 'ro', |
|
69
|
|
|
|
|
|
|
isa => 'ArrayRef', |
|
70
|
|
|
|
|
|
|
default => sub{ [] }, |
|
71
|
|
|
|
|
|
|
traits => [qw( Array )], |
|
72
|
|
|
|
|
|
|
handles => |
|
73
|
|
|
|
|
|
|
{ |
|
74
|
|
|
|
|
|
|
_anno_fetch => 'get', |
|
75
|
|
|
|
|
|
|
_anno_next_id => 'count', |
|
76
|
|
|
|
|
|
|
_anno_store => 'push', |
|
77
|
|
|
|
|
|
|
}, |
|
78
|
|
|
|
|
|
|
); |
|
79
|
|
|
|
|
|
|
|
|
80
|
|
|
|
|
|
|
has 'capture_status', |
|
81
|
|
|
|
|
|
|
( |
|
82
|
|
|
|
|
|
|
documentation => q{ The capturing ENABLED/DISABLED stack }, |
|
83
|
|
|
|
|
|
|
is => 'rw', |
|
84
|
|
|
|
|
|
|
isa => 'ArrayRef', |
|
85
|
|
|
|
|
|
|
default => sub{ [$ENABLED] }, |
|
86
|
|
|
|
|
|
|
traits => [qw( Array )], |
|
87
|
|
|
|
|
|
|
handles => |
|
88
|
|
|
|
|
|
|
{ |
|
89
|
|
|
|
|
|
|
status => [ get => -1 ], |
|
90
|
|
|
|
|
|
|
enable => [ push => $ENABLED ], |
|
91
|
|
|
|
|
|
|
disable => [ push => $DISABLED ], |
|
92
|
|
|
|
|
|
|
_pop_status => 'pop', |
|
93
|
|
|
|
|
|
|
_stack_depth => 'count', |
|
94
|
|
|
|
|
|
|
}, |
|
95
|
|
|
|
|
|
|
); |
|
96
|
|
|
|
|
|
|
|
|
97
|
|
|
|
|
|
|
no Moose; |
|
98
|
|
|
|
|
|
|
__PACKAGE__->meta->make_immutable(); |
|
99
|
|
|
|
|
|
|
|
|
100
|
|
|
|
|
|
|
#----- |
|
101
|
|
|
|
|
|
|
# To capture a callstack we use Perl's caller(), in a loop. Each stackframe |
|
102
|
|
|
|
|
|
|
# reported by caller() contains three values of interest: the subroutine, the |
|
103
|
|
|
|
|
|
|
# filename and the line number. In effect we want to save a list of |
|
104
|
|
|
|
|
|
|
# triplets, one triplet for each stackframe. |
|
105
|
|
|
|
|
|
|
# |
|
106
|
|
|
|
|
|
|
# The obvious choice would be an Array of three-element ArrayRefs, or maybe |
|
107
|
|
|
|
|
|
|
# just a flat Array where the number of elements is a multiple of three. |
|
108
|
|
|
|
|
|
|
# Unfortunately, Arrays of ArrayRefs of Scalars, or even just flat Arrays of |
|
109
|
|
|
|
|
|
|
# Scalars, consume an apalling amount of storage. |
|
110
|
|
|
|
|
|
|
# |
|
111
|
|
|
|
|
|
|
# With an eye on minimizing storage we decide to use a hash (the 'components' |
|
112
|
|
|
|
|
|
|
# attribute) to hold the subroutine name and filename strings returned by |
|
113
|
|
|
|
|
|
|
# caller(). Filenames are likely to be reused within a single callstack, and |
|
114
|
|
|
|
|
|
|
# subroutines are likely to be reused by different callstacks. The hash |
|
115
|
|
|
|
|
|
|
# stores one copy of a string as its key and assigns a unique integer as the |
|
116
|
|
|
|
|
|
|
# value. |
|
117
|
|
|
|
|
|
|
# |
|
118
|
|
|
|
|
|
|
# Using the Components hash to map subroutines and filenames to integers |
|
119
|
|
|
|
|
|
|
# makes all three of our frame components become integers. The entire |
|
120
|
|
|
|
|
|
|
# callstack, in fact, becomes a list of integers. Using pack() we can |
|
121
|
|
|
|
|
|
|
# convert a list of integers into a binary string. The amount of storage |
|
122
|
|
|
|
|
|
|
# required for this string is a small fraction of that required for an Array |
|
123
|
|
|
|
|
|
|
# of Arrays, so we choose to internally represent callstacks as packstrings. |
|
124
|
|
|
|
|
|
|
# |
|
125
|
|
|
|
|
|
|
# We could return the packstring to the user, as the representation of their |
|
126
|
|
|
|
|
|
|
# callstack. Instead, we choose to employ the same strategy of hash-key |
|
127
|
|
|
|
|
|
|
# storage with unique-integer identifier as value. The 'callstacks' |
|
128
|
|
|
|
|
|
|
# attribute is a hash that holds callstack packstrings as keys. This means |
|
129
|
|
|
|
|
|
|
# that the user is given a simple integer to track their callstack. |
|
130
|
|
|
|
|
|
|
# |
|
131
|
|
|
|
|
|
|
# There are two other reasons, besides binary avoidance at the user-level, |
|
132
|
|
|
|
|
|
|
# for mapping packstrings with the Callstacks hash. Repeated callstacks |
|
133
|
|
|
|
|
|
|
# happen whenever capturing is requested from a loop. By mapping callstacks |
|
134
|
|
|
|
|
|
|
# we only have to store a repeated callstack once. We can also help the user |
|
135
|
|
|
|
|
|
|
# identify loop iterations by offering storage for an 'annotation' value. |
|
136
|
|
|
|
|
|
|
# |
|
137
|
|
|
|
|
|
|
# If the user provides an annotation then we will need to save a copy of it, |
|
138
|
|
|
|
|
|
|
# which we do pushing it onto an array - the 'annotations' attribute. The |
|
139
|
|
|
|
|
|
|
# index of the new element becomes the annotation's id. |
|
140
|
|
|
|
|
|
|
# |
|
141
|
|
|
|
|
|
|
# We can't use the same (hash) strategy employed for components and pack |
|
142
|
|
|
|
|
|
|
# strings because annotation values can be any kind of scalar including |
|
143
|
|
|
|
|
|
|
# references and undefs; things that don't survive stringification needed for |
|
144
|
|
|
|
|
|
|
# storage as hash keys. |
|
145
|
|
|
|
|
|
|
# |
|
146
|
|
|
|
|
|
|
# So, there is no redundancy avoidance mechanism for annotations, i.e. |
|
147
|
|
|
|
|
|
|
# storage is not as efficient as it might be. This is not a big deal because |
|
148
|
|
|
|
|
|
|
# we expect that: |
|
149
|
|
|
|
|
|
|
# 1) Most users won't even use annotations in the first place. |
|
150
|
|
|
|
|
|
|
# 2) When annotations are supplied, they are likely to be different. |
|
151
|
|
|
|
|
|
|
# |
|
152
|
|
|
|
|
|
|
# We then combine the annotation_id and the callstack_id together in an |
|
153
|
|
|
|
|
|
|
# Association data structure - another packstring. The Association is then |
|
154
|
|
|
|
|
|
|
# inserted in the 'callstacks' hash. The 'callstacks' attribute stores BOTH |
|
155
|
|
|
|
|
|
|
# callstacks and associations. This is OK, because we can distinguish |
|
156
|
|
|
|
|
|
|
# between callstack packstrings and association packstrings by their |
|
157
|
|
|
|
|
|
|
# lengths. Associations always contain 2 values, callstacks always contain |
|
158
|
|
|
|
|
|
|
# 3N values. |
|
159
|
|
|
|
|
|
|
# |
|
160
|
|
|
|
|
|
|
# If a packstring pulled out of the Callstacks hash is of length 2 then we |
|
161
|
|
|
|
|
|
|
# extract the first value for annotation id, or the second value for a |
|
162
|
|
|
|
|
|
|
# callstack id. The callstack id is then used to fetch another packstring, |
|
163
|
|
|
|
|
|
|
# which will be the real callstack. |
|
164
|
|
|
|
|
|
|
# |
|
165
|
|
|
|
|
|
|
# Fetching a packstring from a hash, given the corresponding identifier |
|
166
|
|
|
|
|
|
|
# value, is a slow, linear search. We have to search through all the values |
|
167
|
|
|
|
|
|
|
# until we find a match. We accept this tradeoff because |
|
168
|
|
|
|
|
|
|
# 1) Providing fast lookup from both directions (string->id AND id->string) |
|
169
|
|
|
|
|
|
|
# would double storage requirements. |
|
170
|
|
|
|
|
|
|
# 2) Each capture would require two insertions and would therefore be slower. |
|
171
|
|
|
|
|
|
|
# 3) If the user is retrieving a callstack for presentation as a |
|
172
|
|
|
|
|
|
|
# stacktrace then some kind of exception has probably happened and |
|
173
|
|
|
|
|
|
|
# performance is no longer that important. |
|
174
|
|
|
|
|
|
|
# |
|
175
|
|
|
|
|
|
|
# If you have followed all the above you may be questioning why not |
|
176
|
|
|
|
|
|
|
# combine the 'components' attribute and 'callstacks' attribute into a single |
|
177
|
|
|
|
|
|
|
# hash - they are both just string->id mappings. You're right, this would |
|
178
|
|
|
|
|
|
|
# work just fine, and it would save a very small amount of storage - one |
|
179
|
|
|
|
|
|
|
# hash. I decided against combining hashes because leaving them separate |
|
180
|
|
|
|
|
|
|
# is somewhat safer. If the user mangles an id they simply get the wrong |
|
181
|
|
|
|
|
|
|
# callstack; they can't crash us by identifying a filename as a callstack. |
|
182
|
|
|
|
|
|
|
#----- |
|
183
|
|
|
|
|
|
|
|
|
184
|
|
|
|
|
|
|
sub capture { |
|
185
|
|
|
|
|
|
|
my $self = shift; |
|
186
|
|
|
|
|
|
|
|
|
187
|
|
|
|
|
|
|
return $UNCAPTURED |
|
188
|
|
|
|
|
|
|
if $self->status == $DISABLED; |
|
189
|
|
|
|
|
|
|
|
|
190
|
|
|
|
|
|
|
#----- |
|
191
|
|
|
|
|
|
|
# undef is a valid annotation. Therefore we need to distinguish between |
|
192
|
|
|
|
|
|
|
# not providing an annotation argument and providing undef. |
|
193
|
|
|
|
|
|
|
#----- |
|
194
|
|
|
|
|
|
|
my( $annotation_provided, $annotation ) = (@_ > 0) |
|
195
|
|
|
|
|
|
|
? ( 1, shift ) |
|
196
|
|
|
|
|
|
|
: ( 0, undef ); |
|
197
|
|
|
|
|
|
|
|
|
198
|
|
|
|
|
|
|
my $callstacks = $self->callstacks; |
|
199
|
|
|
|
|
|
|
my $packstring = _callstack_as_packstring( $self ); |
|
200
|
|
|
|
|
|
|
my $callstack_id = _insert( $callstacks, $packstring ); |
|
201
|
|
|
|
|
|
|
|
|
202
|
|
|
|
|
|
|
return $callstack_id |
|
203
|
|
|
|
|
|
|
if not $annotation_provided; |
|
204
|
|
|
|
|
|
|
|
|
205
|
|
|
|
|
|
|
my $annotation_id = $self->_anno_next_id; |
|
206
|
|
|
|
|
|
|
$self->_anno_store( $annotation ); |
|
207
|
|
|
|
|
|
|
|
|
208
|
|
|
|
|
|
|
#----- |
|
209
|
|
|
|
|
|
|
# Alphabetical name ordering: Annotation_id, Callstack_id in the pack(). |
|
210
|
|
|
|
|
|
|
#----- |
|
211
|
|
|
|
|
|
|
my $association = pack $ENCODING, $annotation_id, $callstack_id; |
|
212
|
|
|
|
|
|
|
my $association_id = _insert( $callstacks, $association ); |
|
213
|
|
|
|
|
|
|
|
|
214
|
|
|
|
|
|
|
return $association_id; |
|
215
|
|
|
|
|
|
|
} |
|
216
|
|
|
|
|
|
|
|
|
217
|
|
|
|
|
|
|
sub stacktrace { |
|
218
|
|
|
|
|
|
|
my( $self, $id ) = @_; |
|
219
|
|
|
|
|
|
|
|
|
220
|
|
|
|
|
|
|
fatal 'missing_identifier' |
|
221
|
|
|
|
|
|
|
if not defined $id; |
|
222
|
|
|
|
|
|
|
|
|
223
|
|
|
|
|
|
|
fatal 'invalid_identifier', $id |
|
224
|
|
|
|
|
|
|
if $id !~ $UNSIGNED_REX; |
|
225
|
|
|
|
|
|
|
|
|
226
|
|
|
|
|
|
|
return wantarray ? () : '' |
|
227
|
|
|
|
|
|
|
if $id == $UNCAPTURED; |
|
228
|
|
|
|
|
|
|
|
|
229
|
|
|
|
|
|
|
my @callstack; |
|
230
|
|
|
|
|
|
|
my $components = $self->components; |
|
231
|
|
|
|
|
|
|
my @ids = unpack $ENCODING, _fetch_callstack_packstring( $self, $id ); |
|
232
|
|
|
|
|
|
|
while( @ids ) { |
|
233
|
|
|
|
|
|
|
|
|
234
|
|
|
|
|
|
|
#----- Alphabetical name order: File Line Subr |
|
235
|
|
|
|
|
|
|
my( $file_id, $line, $subr_id ) = splice @ids, 0, $FRAME_COMPONENTS; |
|
236
|
|
|
|
|
|
|
|
|
237
|
|
|
|
|
|
|
push @callstack, |
|
238
|
|
|
|
|
|
|
{ |
|
239
|
|
|
|
|
|
|
file => _fetch_key_by_id( $components, $file_id ), |
|
240
|
|
|
|
|
|
|
line => $line, |
|
241
|
|
|
|
|
|
|
subr => _fetch_key_by_id( $components, $subr_id ), |
|
242
|
|
|
|
|
|
|
}; |
|
243
|
|
|
|
|
|
|
} |
|
244
|
|
|
|
|
|
|
|
|
245
|
|
|
|
|
|
|
return @callstack |
|
246
|
|
|
|
|
|
|
if wantarray; |
|
247
|
|
|
|
|
|
|
|
|
248
|
|
|
|
|
|
|
my $stacktrace = ''; |
|
249
|
|
|
|
|
|
|
|
|
250
|
|
|
|
|
|
|
foreach my $f ( @callstack ) { |
|
251
|
|
|
|
|
|
|
|
|
252
|
|
|
|
|
|
|
$stacktrace |
|
253
|
|
|
|
|
|
|
.= "\t" |
|
254
|
|
|
|
|
|
|
. $f->{subr} . ' called at ' |
|
255
|
|
|
|
|
|
|
. $f->{file} . ' line ' |
|
256
|
|
|
|
|
|
|
. $f->{line} . $LINE_SEPARATOR; |
|
257
|
|
|
|
|
|
|
} |
|
258
|
|
|
|
|
|
|
|
|
259
|
|
|
|
|
|
|
return $stacktrace; |
|
260
|
|
|
|
|
|
|
} |
|
261
|
|
|
|
|
|
|
|
|
262
|
|
|
|
|
|
|
sub revert { |
|
263
|
|
|
|
|
|
|
my( $self ) = @_; |
|
264
|
|
|
|
|
|
|
|
|
265
|
|
|
|
|
|
|
#----- Guard against excess popping: stack is never empty. |
|
266
|
|
|
|
|
|
|
$self->_pop_status |
|
267
|
|
|
|
|
|
|
if $self->_stack_depth > 1; |
|
268
|
|
|
|
|
|
|
|
|
269
|
|
|
|
|
|
|
return; |
|
270
|
|
|
|
|
|
|
} |
|
271
|
|
|
|
|
|
|
|
|
272
|
|
|
|
|
|
|
sub retrieve_annotation { |
|
273
|
|
|
|
|
|
|
my( $self, $id ) = @_; |
|
274
|
|
|
|
|
|
|
|
|
275
|
|
|
|
|
|
|
fatal 'missing_identifier' |
|
276
|
|
|
|
|
|
|
if not defined $id; |
|
277
|
|
|
|
|
|
|
|
|
278
|
|
|
|
|
|
|
fatal 'invalid_identifier', $id |
|
279
|
|
|
|
|
|
|
if $id !~ $UNSIGNED_REX; |
|
280
|
|
|
|
|
|
|
|
|
281
|
|
|
|
|
|
|
fatal 'uncaptured_annotation' |
|
282
|
|
|
|
|
|
|
if $id == $UNCAPTURED; |
|
283
|
|
|
|
|
|
|
|
|
284
|
|
|
|
|
|
|
my $packstring = _fetch_key_by_id( $self->callstacks, $id ); |
|
285
|
|
|
|
|
|
|
|
|
286
|
|
|
|
|
|
|
fatal 'unannotated_capture', $id |
|
287
|
|
|
|
|
|
|
if $ASSOCIATION_SIZE != length $packstring; |
|
288
|
|
|
|
|
|
|
|
|
289
|
|
|
|
|
|
|
my( $annotation_id, $callstack_id ) = unpack $ENCODING, $packstring; |
|
290
|
|
|
|
|
|
|
|
|
291
|
|
|
|
|
|
|
return $self->_anno_fetch( $annotation_id ); |
|
292
|
|
|
|
|
|
|
} |
|
293
|
|
|
|
|
|
|
|
|
294
|
|
|
|
|
|
|
sub uncaptured { return $UNCAPTURED; } |
|
295
|
|
|
|
|
|
|
|
|
296
|
|
|
|
|
|
|
#----- |
|
297
|
|
|
|
|
|
|
# <$cache> is expected to be a HashRef, by string, with unique integers for |
|
298
|
|
|
|
|
|
|
# values. Both the 'components' and 'callstacks' attributes fit this |
|
299
|
|
|
|
|
|
|
# description, so we factored out the common functionality into this |
|
300
|
|
|
|
|
|
|
# subroutine. |
|
301
|
|
|
|
|
|
|
# |
|
302
|
|
|
|
|
|
|
# Our task here is to return the integer corresponding to <$entry>. If |
|
303
|
|
|
|
|
|
|
# <$entry> does not exist then it is inserted using a value of one more than |
|
304
|
|
|
|
|
|
|
# the previous number of elements in the hash. In other words integers start |
|
305
|
|
|
|
|
|
|
# at one and increment upwards. |
|
306
|
|
|
|
|
|
|
#----- |
|
307
|
|
|
|
|
|
|
sub _insert { |
|
308
|
|
|
|
|
|
|
my( $cache, $entry ) = @_; |
|
309
|
|
|
|
|
|
|
|
|
310
|
|
|
|
|
|
|
return $cache->{ $entry } |
|
311
|
|
|
|
|
|
|
if exists $cache->{ $entry }; |
|
312
|
|
|
|
|
|
|
|
|
313
|
|
|
|
|
|
|
#----- Start at 1; We reserve the id of 0 to represent 'Uncaptured' |
|
314
|
|
|
|
|
|
|
my $id = 1 + keys %{ $cache }; |
|
315
|
|
|
|
|
|
|
|
|
316
|
|
|
|
|
|
|
$cache->{ $entry } = $id; |
|
317
|
|
|
|
|
|
|
|
|
318
|
|
|
|
|
|
|
return $id; |
|
319
|
|
|
|
|
|
|
} |
|
320
|
|
|
|
|
|
|
|
|
321
|
|
|
|
|
|
|
sub _fetch_key_by_id { |
|
322
|
|
|
|
|
|
|
my( $cache, $id ) = @_; |
|
323
|
|
|
|
|
|
|
|
|
324
|
|
|
|
|
|
|
#----- Void-context keys() resets each() traversal. |
|
325
|
|
|
|
|
|
|
keys %{ $cache }; |
|
326
|
|
|
|
|
|
|
|
|
327
|
|
|
|
|
|
|
my $match; |
|
328
|
|
|
|
|
|
|
my( $key, $val ); |
|
329
|
|
|
|
|
|
|
while( ($key,$val) = each %{ $cache } ) { #----- Yup, linear search |
|
330
|
|
|
|
|
|
|
|
|
331
|
|
|
|
|
|
|
next |
|
332
|
|
|
|
|
|
|
if $val != $id; |
|
333
|
|
|
|
|
|
|
|
|
334
|
|
|
|
|
|
|
$match = $key; |
|
335
|
|
|
|
|
|
|
last; |
|
336
|
|
|
|
|
|
|
} |
|
337
|
|
|
|
|
|
|
|
|
338
|
|
|
|
|
|
|
fatal 'no_such_id', $cache, $id |
|
339
|
|
|
|
|
|
|
if not defined $match; |
|
340
|
|
|
|
|
|
|
|
|
341
|
|
|
|
|
|
|
return $match; |
|
342
|
|
|
|
|
|
|
} |
|
343
|
|
|
|
|
|
|
|
|
344
|
|
|
|
|
|
|
sub _callstack_as_packstring { |
|
345
|
|
|
|
|
|
|
my( $self ) = @_; |
|
346
|
|
|
|
|
|
|
|
|
347
|
|
|
|
|
|
|
#----- Hash for subroutine and filename strings |
|
348
|
|
|
|
|
|
|
my $components = $self->components; |
|
349
|
|
|
|
|
|
|
|
|
350
|
|
|
|
|
|
|
my $triplets = ''; |
|
351
|
|
|
|
|
|
|
|
|
352
|
|
|
|
|
|
|
#----- |
|
353
|
|
|
|
|
|
|
# What we really want is the callstack as seen from _our_ caller. |
|
354
|
|
|
|
|
|
|
# Start with frame #1 |
|
355
|
|
|
|
|
|
|
#----- |
|
356
|
|
|
|
|
|
|
for( my $frame=1; 1; ++$frame ) { |
|
357
|
|
|
|
|
|
|
|
|
358
|
|
|
|
|
|
|
my( $filename, $line, $subr ) = |
|
359
|
|
|
|
|
|
|
(caller $frame)[ $CALLER_FILENAME, |
|
360
|
|
|
|
|
|
|
$CALLER_LINE, |
|
361
|
|
|
|
|
|
|
$CALLER_SUBROUTINE ]; |
|
362
|
|
|
|
|
|
|
|
|
363
|
|
|
|
|
|
|
#----- caller() returns an empty list at the end of the callstack |
|
364
|
|
|
|
|
|
|
last |
|
365
|
|
|
|
|
|
|
if not defined $filename; |
|
366
|
|
|
|
|
|
|
|
|
367
|
|
|
|
|
|
|
#----- Alphabetic name order: Filename, Line, Subroutine |
|
368
|
|
|
|
|
|
|
$triplets .= |
|
369
|
|
|
|
|
|
|
pack $ENCODING, |
|
370
|
|
|
|
|
|
|
_insert( $components, $filename ), |
|
371
|
|
|
|
|
|
|
$line, |
|
372
|
|
|
|
|
|
|
_insert( $components, $subr ); |
|
373
|
|
|
|
|
|
|
} |
|
374
|
|
|
|
|
|
|
|
|
375
|
|
|
|
|
|
|
return $triplets; |
|
376
|
|
|
|
|
|
|
} |
|
377
|
|
|
|
|
|
|
|
|
378
|
|
|
|
|
|
|
sub _fetch_callstack_packstring { |
|
379
|
|
|
|
|
|
|
my( $self, $id ) = @_; |
|
380
|
|
|
|
|
|
|
|
|
381
|
|
|
|
|
|
|
my $callstacks = $self->callstacks; |
|
382
|
|
|
|
|
|
|
my $packstring = _fetch_key_by_id( $callstacks, $id ); |
|
383
|
|
|
|
|
|
|
my $len = length $packstring; |
|
384
|
|
|
|
|
|
|
|
|
385
|
|
|
|
|
|
|
#----- |
|
386
|
|
|
|
|
|
|
# The 'callstacks' attribute stores two types of pack() strings in its |
|
387
|
|
|
|
|
|
|
# keys: 2-value associations, OR 3*N - value callstacks. If the |
|
388
|
|
|
|
|
|
|
# retrieved key is a multiple of three unsigneds in length then this must |
|
389
|
|
|
|
|
|
|
# be a callstack. |
|
390
|
|
|
|
|
|
|
#----- |
|
391
|
|
|
|
|
|
|
return $packstring |
|
392
|
|
|
|
|
|
|
if 0 == $len % $STACKFRAME_SIZE; |
|
393
|
|
|
|
|
|
|
|
|
394
|
|
|
|
|
|
|
#----- Something is deeply wrong if this doesn't look like an association. |
|
395
|
|
|
|
|
|
|
fatal 'incorrect_entry_size', $len, $id |
|
396
|
|
|
|
|
|
|
if $len != $ASSOCIATION_SIZE; |
|
397
|
|
|
|
|
|
|
|
|
398
|
|
|
|
|
|
|
#----- |
|
399
|
|
|
|
|
|
|
# As association is just an annotation id and a callstack id packed |
|
400
|
|
|
|
|
|
|
# together. This means we need to unpack to get the callstack id |
|
401
|
|
|
|
|
|
|
# out of the pair, then perform another lookup to get the callstack. |
|
402
|
|
|
|
|
|
|
#----- |
|
403
|
|
|
|
|
|
|
my( $annotation_id, $callstack_id ) = unpack $ENCODING, $packstring; |
|
404
|
|
|
|
|
|
|
|
|
405
|
|
|
|
|
|
|
return _fetch_key_by_id( $callstacks, $callstack_id ); |
|
406
|
|
|
|
|
|
|
} |
|
407
|
|
|
|
|
|
|
|
|
408
|
|
|
|
|
|
|
#----- Fatal handlers |
|
409
|
|
|
|
|
|
|
|
|
410
|
|
|
|
|
|
|
sub _cp_incorrect_entry_size { |
|
411
|
|
|
|
|
|
|
my( $cp, $len ) = @_; |
|
412
|
|
|
|
|
|
|
|
|
413
|
|
|
|
|
|
|
$cp->filled(<<"EOF"); |
|
414
|
|
|
|
|
|
|
The system has encountered corruption in the data structure used to capture |
|
415
|
|
|
|
|
|
|
stacktraces. The lookup was successful, but the entry has an unexpected |
|
416
|
|
|
|
|
|
|
length. This is a defect; you should complain! |
|
417
|
|
|
|
|
|
|
EOF |
|
418
|
|
|
|
|
|
|
|
|
419
|
|
|
|
|
|
|
$cp->fixed( $BUG_REPORT, 'Defect reporting URL' ); |
|
420
|
|
|
|
|
|
|
|
|
421
|
|
|
|
|
|
|
$cp->fixed(<<"EOF", 'Details' ); |
|
422
|
|
|
|
|
|
|
length $len |
|
423
|
|
|
|
|
|
|
sizeof_unsigned $SIZEOF_UNSIGNED |
|
424
|
|
|
|
|
|
|
EOF |
|
425
|
|
|
|
|
|
|
return; |
|
426
|
|
|
|
|
|
|
} |
|
427
|
|
|
|
|
|
|
|
|
428
|
|
|
|
|
|
|
sub _cp_invalid_identifier { |
|
429
|
|
|
|
|
|
|
my( $cp, $id ) = @_; |
|
430
|
|
|
|
|
|
|
|
|
431
|
|
|
|
|
|
|
$cp->filled( <<"EOF" ); |
|
432
|
|
|
|
|
|
|
The '\$id' argument, '$id', is not of the correct form for a callstack |
|
433
|
|
|
|
|
|
|
identifier. Identifiers are expected to be integers. |
|
434
|
|
|
|
|
|
|
EOF |
|
435
|
|
|
|
|
|
|
$cp->usage; |
|
436
|
|
|
|
|
|
|
return; |
|
437
|
|
|
|
|
|
|
} |
|
438
|
|
|
|
|
|
|
|
|
439
|
|
|
|
|
|
|
sub _cp_missing_identifier { |
|
440
|
|
|
|
|
|
|
my( $cp, $id ) = @_; |
|
441
|
|
|
|
|
|
|
|
|
442
|
|
|
|
|
|
|
$cp->filled( 'The identifier argument, $id, is missing or undef.' ); |
|
443
|
|
|
|
|
|
|
$cp->usage; |
|
444
|
|
|
|
|
|
|
return; |
|
445
|
|
|
|
|
|
|
} |
|
446
|
|
|
|
|
|
|
|
|
447
|
|
|
|
|
|
|
sub _cp_no_such_id { |
|
448
|
|
|
|
|
|
|
my( $cp, $cache, $id ) = @_; |
|
449
|
|
|
|
|
|
|
|
|
450
|
|
|
|
|
|
|
my $count = keys %{ $cache }; |
|
451
|
|
|
|
|
|
|
|
|
452
|
|
|
|
|
|
|
my $msg = <<"EOF"; |
|
453
|
|
|
|
|
|
|
The callstack capturing database does not contain an identifier |
|
454
|
|
|
|
|
|
|
matching '$id'. |
|
455
|
|
|
|
|
|
|
EOF |
|
456
|
|
|
|
|
|
|
|
|
457
|
|
|
|
|
|
|
$msg .= $count > 0 |
|
458
|
|
|
|
|
|
|
? "The database has $count other entries." |
|
459
|
|
|
|
|
|
|
: 'The database is empty.'; |
|
460
|
|
|
|
|
|
|
|
|
461
|
|
|
|
|
|
|
$cp->filled( $msg ); |
|
462
|
|
|
|
|
|
|
return; |
|
463
|
|
|
|
|
|
|
} |
|
464
|
|
|
|
|
|
|
|
|
465
|
|
|
|
|
|
|
sub _cp_unannotated_capture { |
|
466
|
|
|
|
|
|
|
my( $cp, $id ) = @_; |
|
467
|
|
|
|
|
|
|
|
|
468
|
|
|
|
|
|
|
$cp->filled(<<"EOF"); |
|
469
|
|
|
|
|
|
|
The identifier '$id' corresponds to a callstack that was captured |
|
470
|
|
|
|
|
|
|
WITHOUT an annotation. You can still obtain a stacktrace, but there |
|
471
|
|
|
|
|
|
|
is no annotation to retrieve. |
|
472
|
|
|
|
|
|
|
EOF |
|
473
|
|
|
|
|
|
|
return; |
|
474
|
|
|
|
|
|
|
} |
|
475
|
|
|
|
|
|
|
|
|
476
|
|
|
|
|
|
|
|
|
477
|
|
|
|
|
|
|
sub _cp_uncaptured_annotation { |
|
478
|
|
|
|
|
|
|
my( $cp ) = @_; |
|
479
|
|
|
|
|
|
|
|
|
480
|
|
|
|
|
|
|
$cp->filled(<<"EOF"); |
|
481
|
|
|
|
|
|
|
The callstack identifier indicates that capturing was currently |
|
482
|
|
|
|
|
|
|
DISABLED when callstack_capture() was invoked. Neither the callstack |
|
483
|
|
|
|
|
|
|
nor the annotation was stored, so there is nothing to retrieve. |
|
484
|
|
|
|
|
|
|
EOF |
|
485
|
|
|
|
|
|
|
return; |
|
486
|
|
|
|
|
|
|
} |
|
487
|
|
|
|
|
|
|
|
|
488
|
|
|
|
|
|
|
sub _cp_usage_retrieve_annotation { |
|
489
|
|
|
|
|
|
|
my( $cp ) = @_; |
|
490
|
|
|
|
|
|
|
|
|
491
|
|
|
|
|
|
|
$cp->synopsis( -verbose => 99, |
|
492
|
|
|
|
|
|
|
-sections => ['METHODS/retrieve_annotation'], |
|
493
|
|
|
|
|
|
|
); |
|
494
|
|
|
|
|
|
|
|
|
495
|
|
|
|
|
|
|
return; |
|
496
|
|
|
|
|
|
|
} |
|
497
|
|
|
|
|
|
|
|
|
498
|
|
|
|
|
|
|
sub _cp_usage_stacktrace { |
|
499
|
|
|
|
|
|
|
my( $cp ) = @_; |
|
500
|
|
|
|
|
|
|
|
|
501
|
|
|
|
|
|
|
$cp->synopsis( -verbose => 99, |
|
502
|
|
|
|
|
|
|
-sections => ['METHODS/stacktrace'], |
|
503
|
|
|
|
|
|
|
); |
|
504
|
|
|
|
|
|
|
|
|
505
|
|
|
|
|
|
|
return; |
|
506
|
|
|
|
|
|
|
} |
|
507
|
|
|
|
|
|
|
|
|
508
|
|
|
|
|
|
|
|
|
509
|
|
|
|
|
|
|
1; # End of Carp::Capture |
|
510
|
|
|
|
|
|
|
|
|
511
|
|
|
|
|
|
|
__END__ |
|
512
|
|
|
|
|
|
|
|
|
513
|
|
|
|
|
|
|
=pod |
|
514
|
|
|
|
|
|
|
|
|
515
|
|
|
|
|
|
|
=begin stopwords |
|
516
|
|
|
|
|
|
|
|
|
517
|
|
|
|
|
|
|
AnnoCPAN |
|
518
|
|
|
|
|
|
|
API |
|
519
|
|
|
|
|
|
|
callstack |
|
520
|
|
|
|
|
|
|
CPAN |
|
521
|
|
|
|
|
|
|
filename |
|
522
|
|
|
|
|
|
|
HashRef |
|
523
|
|
|
|
|
|
|
Hashrefs |
|
524
|
|
|
|
|
|
|
HashRefs |
|
525
|
|
|
|
|
|
|
initializer |
|
526
|
|
|
|
|
|
|
Liebert |
|
527
|
|
|
|
|
|
|
multi |
|
528
|
|
|
|
|
|
|
perldoc |
|
529
|
|
|
|
|
|
|
stackframe |
|
530
|
|
|
|
|
|
|
stacktrace |
|
531
|
|
|
|
|
|
|
subr |
|
532
|
|
|
|
|
|
|
uncaptured |
|
533
|
|
|
|
|
|
|
|
|
534
|
|
|
|
|
|
|
=end stopwords |
|
535
|
|
|
|
|
|
|
|
|
536
|
|
|
|
|
|
|
=head1 NAME |
|
537
|
|
|
|
|
|
|
|
|
538
|
|
|
|
|
|
|
Carp::Capture - Capture callstacks for later presentation. |
|
539
|
|
|
|
|
|
|
|
|
540
|
|
|
|
|
|
|
=head1 SYNOPSIS |
|
541
|
|
|
|
|
|
|
|
|
542
|
|
|
|
|
|
|
use Carp::Capture; |
|
543
|
|
|
|
|
|
|
|
|
544
|
|
|
|
|
|
|
my $cc = Carp::Capture->new(); |
|
545
|
|
|
|
|
|
|
my $id = $cc->capture; |
|
546
|
|
|
|
|
|
|
... |
|
547
|
|
|
|
|
|
|
print scalar $cc->stacktrace( $id ); |
|
548
|
|
|
|
|
|
|
|
|
549
|
|
|
|
|
|
|
=head1 DESCRIPTION |
|
550
|
|
|
|
|
|
|
|
|
551
|
|
|
|
|
|
|
Perl's standard library module B<Carp> provides the B<confess()> |
|
552
|
|
|
|
|
|
|
function. B<Carp::confess()> throws an exception containing a |
|
553
|
|
|
|
|
|
|
stacktrace. Stacktraces can be valuable debugging aids by describing |
|
554
|
|
|
|
|
|
|
where an exception happened and how the program got there. |
|
555
|
|
|
|
|
|
|
B<Carp::Capture> does not throw exceptions. Instead, it separates the |
|
556
|
|
|
|
|
|
|
capturing of a callstack, from its presentation as a stacktrace. |
|
557
|
|
|
|
|
|
|
|
|
558
|
|
|
|
|
|
|
A B<Carp::Capture> object holds compact representations of captured |
|
559
|
|
|
|
|
|
|
callstacks. An integer identifier is returned each time capturing is |
|
560
|
|
|
|
|
|
|
requested. The identifier can be used to produce a stacktrace. |
|
561
|
|
|
|
|
|
|
|
|
562
|
|
|
|
|
|
|
The need for callstack capturing came about during the development of |
|
563
|
|
|
|
|
|
|
a compiler application. Several types of user errors could not be |
|
564
|
|
|
|
|
|
|
detected at specification time (during API calls). Conflicts revealed |
|
565
|
|
|
|
|
|
|
themselves only after the specifications began to execute. By tagging |
|
566
|
|
|
|
|
|
|
each specification with a captured callstack we were able to pinpoint |
|
567
|
|
|
|
|
|
|
conflict origins, back in user code. |
|
568
|
|
|
|
|
|
|
|
|
569
|
|
|
|
|
|
|
=head1 CALLSTACK-CAPTURING |
|
570
|
|
|
|
|
|
|
|
|
571
|
|
|
|
|
|
|
Invoking L<capture()|/capture> initiates stack traversal, using Perl's |
|
572
|
|
|
|
|
|
|
B<caller()>. The subroutine, line number and filename components of |
|
573
|
|
|
|
|
|
|
each stackframe are harvested from the B<caller()> result. The chain |
|
574
|
|
|
|
|
|
|
of harvested frames is stored in the B<Carp::Capture> object. An |
|
575
|
|
|
|
|
|
|
integer identifier is returned for future reference of the captured |
|
576
|
|
|
|
|
|
|
callstack. |
|
577
|
|
|
|
|
|
|
|
|
578
|
|
|
|
|
|
|
=head1 SELECTIVE-CAPTURE |
|
579
|
|
|
|
|
|
|
|
|
580
|
|
|
|
|
|
|
The module attempts to be fast and to use minimal storage. That being |
|
581
|
|
|
|
|
|
|
said, each capture takes time and consumes space. Sections of code |
|
582
|
|
|
|
|
|
|
that are not under suspicion can disable capturing. |
|
583
|
|
|
|
|
|
|
|
|
584
|
|
|
|
|
|
|
B<Carp::Capture> provides a stack mechanism for enabling and disabling |
|
585
|
|
|
|
|
|
|
callstack captures. When the top of the stack indicates that |
|
586
|
|
|
|
|
|
|
capturing is disabled, calls to L<capture()|/capture> return |
|
587
|
|
|
|
|
|
|
immediately. In this case, the returned identifier is a constant that |
|
588
|
|
|
|
|
|
|
indicates an 'uncaptured' callstack. |
|
589
|
|
|
|
|
|
|
|
|
590
|
|
|
|
|
|
|
Capturing can be dynamically enabled and disabled with |
|
591
|
|
|
|
|
|
|
L<enable()|/enable> and L<disable()|/disable>. These methods push new |
|
592
|
|
|
|
|
|
|
values onto an internal stack. The L<revert()|/revert> method pops |
|
593
|
|
|
|
|
|
|
the stack, restoring capture status to whatever it was before the most |
|
594
|
|
|
|
|
|
|
recent push. |
|
595
|
|
|
|
|
|
|
|
|
596
|
|
|
|
|
|
|
Capture status is B<enabled> when the object is first constructed. |
|
597
|
|
|
|
|
|
|
|
|
598
|
|
|
|
|
|
|
=head1 STACKTRACE-RENDERING |
|
599
|
|
|
|
|
|
|
|
|
600
|
|
|
|
|
|
|
A stacktrace, in string form, can be produced by invoking |
|
601
|
|
|
|
|
|
|
L<stacktrace()|/stacktrace> in a scalar context. The result is a |
|
602
|
|
|
|
|
|
|
string, with one line for each stackframe, similar to |
|
603
|
|
|
|
|
|
|
B<Carp::confess()>: |
|
604
|
|
|
|
|
|
|
|
|
605
|
|
|
|
|
|
|
<TAB><subr1>() called at <file1> line <line1> |
|
606
|
|
|
|
|
|
|
<TAB><subr2>() called at <file2> line <line2> |
|
607
|
|
|
|
|
|
|
... |
|
608
|
|
|
|
|
|
|
|
|
609
|
|
|
|
|
|
|
The data fields of B<subr>, B<file> and B<line> are also available in |
|
610
|
|
|
|
|
|
|
raw form to support user-designed formatting. In list context, the |
|
611
|
|
|
|
|
|
|
L<stacktrace()|/stacktrace> method returns a list of HashRefs. Each |
|
612
|
|
|
|
|
|
|
HashRef has three keys: B<subr>, B<file> and B<line>. There is one |
|
613
|
|
|
|
|
|
|
HashRef for each stackframe, with the first HashRef corresponding to |
|
614
|
|
|
|
|
|
|
the innermost subroutine call. |
|
615
|
|
|
|
|
|
|
|
|
616
|
|
|
|
|
|
|
Attempting to produce a stacktrace from an 'uncaptured' identifier |
|
617
|
|
|
|
|
|
|
results in an empty string from L<stacktrace()|/stacktrace>, or an |
|
618
|
|
|
|
|
|
|
empty list from L<stacktrace()|/stacktrace>. |
|
619
|
|
|
|
|
|
|
|
|
620
|
|
|
|
|
|
|
=head1 DISAMBIGUATION |
|
621
|
|
|
|
|
|
|
|
|
622
|
|
|
|
|
|
|
If L<capture()|/capture> is invoked from within a loop then the |
|
623
|
|
|
|
|
|
|
callstack is the same for each iteration and hence the returned |
|
624
|
|
|
|
|
|
|
identifiers will all be the same as well. |
|
625
|
|
|
|
|
|
|
|
|
626
|
|
|
|
|
|
|
my $cc = Carp::Capture->new; |
|
627
|
|
|
|
|
|
|
my @ids; |
|
628
|
|
|
|
|
|
|
|
|
629
|
|
|
|
|
|
|
foreach my $letter (qw( a b c d )) { |
|
630
|
|
|
|
|
|
|
|
|
631
|
|
|
|
|
|
|
push @ids, $cc->capture; |
|
632
|
|
|
|
|
|
|
} |
|
633
|
|
|
|
|
|
|
|
|
634
|
|
|
|
|
|
|
# Prints "1 1 1 1" |
|
635
|
|
|
|
|
|
|
say "@ids"; |
|
636
|
|
|
|
|
|
|
|
|
637
|
|
|
|
|
|
|
L<capture()|/capture> accepts an optional argument, called an |
|
638
|
|
|
|
|
|
|
B<annotation>, to help distinguish one iteration from another. |
|
639
|
|
|
|
|
|
|
|
|
640
|
|
|
|
|
|
|
A common tactic is to provide the loop iteration value as the |
|
641
|
|
|
|
|
|
|
annotation, but any scalar is acceptable. |
|
642
|
|
|
|
|
|
|
|
|
643
|
|
|
|
|
|
|
If an annotation is provided to L<capture()|/capture> then a copy of |
|
644
|
|
|
|
|
|
|
the annotation will be stored inside the B<Carp::Capture> object. |
|
645
|
|
|
|
|
|
|
Returned identifiers will be always be unique when an annotation is |
|
646
|
|
|
|
|
|
|
provided. |
|
647
|
|
|
|
|
|
|
|
|
648
|
|
|
|
|
|
|
Use L<retrieve_annotation()|/retrieve_annotation> to fetch the stored |
|
649
|
|
|
|
|
|
|
annotation. |
|
650
|
|
|
|
|
|
|
|
|
651
|
|
|
|
|
|
|
my $cc = Carp::Capture->new; |
|
652
|
|
|
|
|
|
|
my @ids; |
|
653
|
|
|
|
|
|
|
|
|
654
|
|
|
|
|
|
|
foreach my $letter (qw( a b c d )) { |
|
655
|
|
|
|
|
|
|
|
|
656
|
|
|
|
|
|
|
push @ids, $cc->capture( $letter ); |
|
657
|
|
|
|
|
|
|
} |
|
658
|
|
|
|
|
|
|
|
|
659
|
|
|
|
|
|
|
# Prints "2 3 4 5" |
|
660
|
|
|
|
|
|
|
say "@ids"; |
|
661
|
|
|
|
|
|
|
|
|
662
|
|
|
|
|
|
|
# Prints "True" |
|
663
|
|
|
|
|
|
|
say "True" |
|
664
|
|
|
|
|
|
|
if $cc->stacktrace( $ids[0] ) eq |
|
665
|
|
|
|
|
|
|
$cc->stacktrace( $ids[1] ); |
|
666
|
|
|
|
|
|
|
|
|
667
|
|
|
|
|
|
|
# Prints "c" |
|
668
|
|
|
|
|
|
|
say $cc->retrieve_annotation( $ids[2] ); |
|
669
|
|
|
|
|
|
|
|
|
670
|
|
|
|
|
|
|
=head1 EXPORTS |
|
671
|
|
|
|
|
|
|
|
|
672
|
|
|
|
|
|
|
None. |
|
673
|
|
|
|
|
|
|
|
|
674
|
|
|
|
|
|
|
=head1 METHODS |
|
675
|
|
|
|
|
|
|
|
|
676
|
|
|
|
|
|
|
In the descriptions below, B<$cc> refers to a B<Carp::Capture> object |
|
677
|
|
|
|
|
|
|
returned by L<new()|/new>. B<$id> refers to the identifier returned |
|
678
|
|
|
|
|
|
|
by L<capture()|/capture>. Return value types are shown in angle |
|
679
|
|
|
|
|
|
|
brackets, like B<E<lt>voidE<gt>>. |
|
680
|
|
|
|
|
|
|
|
|
681
|
|
|
|
|
|
|
=head2 new |
|
682
|
|
|
|
|
|
|
|
|
683
|
|
|
|
|
|
|
Usage: |
|
684
|
|
|
|
|
|
|
$cc = Carp::Capture->new(); |
|
685
|
|
|
|
|
|
|
|
|
686
|
|
|
|
|
|
|
B<new()> creates the object that holds stackframe components, callstack |
|
687
|
|
|
|
|
|
|
representations and the capture-status stack. All attributes are |
|
688
|
|
|
|
|
|
|
private so there are no initializer arguments. |
|
689
|
|
|
|
|
|
|
|
|
690
|
|
|
|
|
|
|
=head2 capture |
|
691
|
|
|
|
|
|
|
|
|
692
|
|
|
|
|
|
|
Usage: |
|
693
|
|
|
|
|
|
|
$id = $cc->capture; |
|
694
|
|
|
|
|
|
|
-or- |
|
695
|
|
|
|
|
|
|
$id = $cc->capture( $annotation ); |
|
696
|
|
|
|
|
|
|
|
|
697
|
|
|
|
|
|
|
The B<capture()> method traverses the current callstack and harvests |
|
698
|
|
|
|
|
|
|
stackframe components along the way. The data is stored in the I<$cc> |
|
699
|
|
|
|
|
|
|
object. The return value, an integer, identifies the internal |
|
700
|
|
|
|
|
|
|
representation of the captured callstack. |
|
701
|
|
|
|
|
|
|
|
|
702
|
|
|
|
|
|
|
If capturing has been disabled (See |
|
703
|
|
|
|
|
|
|
L<SELECTIVE-CAPTURE|/SELECTIVE-CAPTURE>) then the returned integer |
|
704
|
|
|
|
|
|
|
is a constant that represents an uncaptured stack. |
|
705
|
|
|
|
|
|
|
|
|
706
|
|
|
|
|
|
|
The I<$annotation> argument is optional. If I<$annotation> is |
|
707
|
|
|
|
|
|
|
provided then I<$annotation> is captured along with the callstack. |
|
708
|
|
|
|
|
|
|
The intent is to distinguish similar callstacks, such as might be |
|
709
|
|
|
|
|
|
|
captured from within a loop. See L<DISAMBIGUATION|/DISAMBIGUATION>. |
|
710
|
|
|
|
|
|
|
|
|
711
|
|
|
|
|
|
|
=head2 stacktrace |
|
712
|
|
|
|
|
|
|
|
|
713
|
|
|
|
|
|
|
Usage: |
|
714
|
|
|
|
|
|
|
<String> = $cc->stacktrace( $id ); |
|
715
|
|
|
|
|
|
|
-or- |
|
716
|
|
|
|
|
|
|
<ListOfHashRefs> = $cc->stacktrace( $id ); |
|
717
|
|
|
|
|
|
|
|
|
718
|
|
|
|
|
|
|
In Scalar Context, B<stacktrace()> returns a string representation |
|
719
|
|
|
|
|
|
|
of the callstack corresponding to the callstack identified by |
|
720
|
|
|
|
|
|
|
I<$id>. |
|
721
|
|
|
|
|
|
|
|
|
722
|
|
|
|
|
|
|
There is one line in the returned string for each stackframe in the |
|
723
|
|
|
|
|
|
|
captured callstack. Stack frames are ordered from the innermost outward, |
|
724
|
|
|
|
|
|
|
just like B<Carp::confess>. Lines are of the form: |
|
725
|
|
|
|
|
|
|
|
|
726
|
|
|
|
|
|
|
<TAB><subroutine> called at <file> line <line> |
|
727
|
|
|
|
|
|
|
|
|
728
|
|
|
|
|
|
|
In List Context, B<stacktrace()> returns callstack components as a |
|
729
|
|
|
|
|
|
|
data structure. The callstack identified by I<$id>, is returned as a |
|
730
|
|
|
|
|
|
|
list of HashRefs. There is one element in the list for each frame in |
|
731
|
|
|
|
|
|
|
the captured callstack. Stack frames are ordered from the innermost |
|
732
|
|
|
|
|
|
|
outward, just like B<Carp::confess>. Each HashRef element has three |
|
733
|
|
|
|
|
|
|
keys: B<'file'>, B<'line'> and B<'subr'>. |
|
734
|
|
|
|
|
|
|
|
|
735
|
|
|
|
|
|
|
If I<$id> identifies the 'uncaptured' callstack (See |
|
736
|
|
|
|
|
|
|
L<SELECTIVE-CAPTURING|/SELECTIVE-CAPTURING>) then nothing was captured. |
|
737
|
|
|
|
|
|
|
In Scalar Context, the empty string will be returned. In List Context |
|
738
|
|
|
|
|
|
|
an empty list will be returned. |
|
739
|
|
|
|
|
|
|
|
|
740
|
|
|
|
|
|
|
=head2 enable |
|
741
|
|
|
|
|
|
|
|
|
742
|
|
|
|
|
|
|
Usage: |
|
743
|
|
|
|
|
|
|
<void> $cc->enable; |
|
744
|
|
|
|
|
|
|
|
|
745
|
|
|
|
|
|
|
B<Carp::Capture> objects maintain an internal stack that controls whether |
|
746
|
|
|
|
|
|
|
capturing is performed. B<enable()> pushes a new 'Enabled' value on top |
|
747
|
|
|
|
|
|
|
of the stack. |
|
748
|
|
|
|
|
|
|
|
|
749
|
|
|
|
|
|
|
Invoking L<revert()|/revert> restores capture status to |
|
750
|
|
|
|
|
|
|
whatever it was before the last push. Capturing starts out as 'Enabled'. |
|
751
|
|
|
|
|
|
|
|
|
752
|
|
|
|
|
|
|
=head2 disable |
|
753
|
|
|
|
|
|
|
|
|
754
|
|
|
|
|
|
|
Usage: |
|
755
|
|
|
|
|
|
|
<void> $cc->disable; |
|
756
|
|
|
|
|
|
|
|
|
757
|
|
|
|
|
|
|
B<Carp::Capture> objects maintain an internal stack that controls |
|
758
|
|
|
|
|
|
|
whether capturing is performed. B<disable()> pushes a new 'Disabled' |
|
759
|
|
|
|
|
|
|
value on top of the stack. |
|
760
|
|
|
|
|
|
|
|
|
761
|
|
|
|
|
|
|
Invoking L<revert()|/revert> restores capture status to whatever it |
|
762
|
|
|
|
|
|
|
was before the last push. Capturing starts out as 'Enabled'. |
|
763
|
|
|
|
|
|
|
|
|
764
|
|
|
|
|
|
|
=head2 revert |
|
765
|
|
|
|
|
|
|
|
|
766
|
|
|
|
|
|
|
Usage: |
|
767
|
|
|
|
|
|
|
<void> $cc->revert; |
|
768
|
|
|
|
|
|
|
|
|
769
|
|
|
|
|
|
|
B<Carp::Capture> objects maintain an internal stack that controls |
|
770
|
|
|
|
|
|
|
whether capturing is performed. B<revert()> pops and discards the |
|
771
|
|
|
|
|
|
|
current capture status. The previous status is restored. |
|
772
|
|
|
|
|
|
|
|
|
773
|
|
|
|
|
|
|
=head2 retrieve_annotation |
|
774
|
|
|
|
|
|
|
|
|
775
|
|
|
|
|
|
|
Usage: |
|
776
|
|
|
|
|
|
|
<Scalar> = $cc->retrieve_annotation( $id ); |
|
777
|
|
|
|
|
|
|
|
|
778
|
|
|
|
|
|
|
If an annotation value was provided in the call to |
|
779
|
|
|
|
|
|
|
L<capture()|/capture> then it can be retrieved with the |
|
780
|
|
|
|
|
|
|
same identifier used to generate stacktraces. |
|
781
|
|
|
|
|
|
|
|
|
782
|
|
|
|
|
|
|
An exception is thrown if I<$id> originated from a capture that was disabled, |
|
783
|
|
|
|
|
|
|
or from one in which no annotation was provided. |
|
784
|
|
|
|
|
|
|
|
|
785
|
|
|
|
|
|
|
=head2 uncaptured |
|
786
|
|
|
|
|
|
|
|
|
787
|
|
|
|
|
|
|
Usage: |
|
788
|
|
|
|
|
|
|
<Integer> = $cc->uncaptured; |
|
789
|
|
|
|
|
|
|
|
|
790
|
|
|
|
|
|
|
The magic value used to indicate that no callstack was captured, is returned |
|
791
|
|
|
|
|
|
|
by B<uncaptured()>. Testing an identifier for equality with the Uncaptured |
|
792
|
|
|
|
|
|
|
value is a way to query the identifier's status. |
|
793
|
|
|
|
|
|
|
|
|
794
|
|
|
|
|
|
|
my $cc = Carp::Capture->new; |
|
795
|
|
|
|
|
|
|
my $uncaptured = $cc->uncaptured; |
|
796
|
|
|
|
|
|
|
|
|
797
|
|
|
|
|
|
|
# Prints "On" |
|
798
|
|
|
|
|
|
|
say $uncaptured == $cc->capture ? 'Off' : 'On'; |
|
799
|
|
|
|
|
|
|
|
|
800
|
|
|
|
|
|
|
$cc->disable; |
|
801
|
|
|
|
|
|
|
|
|
802
|
|
|
|
|
|
|
# Prints "Off" |
|
803
|
|
|
|
|
|
|
say $uncaptured == $cc->capture ? 'Off' : 'On'; |
|
804
|
|
|
|
|
|
|
|
|
805
|
|
|
|
|
|
|
The Uncaptured value might also be useful as a default in a data structure. |
|
806
|
|
|
|
|
|
|
Capturing can be gated with a conditional that overwrites the default when |
|
807
|
|
|
|
|
|
|
active. |
|
808
|
|
|
|
|
|
|
|
|
809
|
|
|
|
|
|
|
=head1 BUGS AND LIMITATIONS |
|
810
|
|
|
|
|
|
|
|
|
811
|
|
|
|
|
|
|
Please report any bugs or feature requests to C<bug-carp-capture at |
|
812
|
|
|
|
|
|
|
rt.cpan.org>, or through the web interface at |
|
813
|
|
|
|
|
|
|
|
|
814
|
|
|
|
|
|
|
L<http://rt.cpan.org/NoAuth/ReportBug.html?Queue=Carp-Capture>. |
|
815
|
|
|
|
|
|
|
|
|
816
|
|
|
|
|
|
|
I will be notified, and then you'll automatically be notified of |
|
817
|
|
|
|
|
|
|
progress on your bug as I make changes. |
|
818
|
|
|
|
|
|
|
|
|
819
|
|
|
|
|
|
|
=head1 SUPPORT |
|
820
|
|
|
|
|
|
|
|
|
821
|
|
|
|
|
|
|
You can find documentation for this module with the perldoc command. |
|
822
|
|
|
|
|
|
|
|
|
823
|
|
|
|
|
|
|
perldoc Carp::Capture |
|
824
|
|
|
|
|
|
|
|
|
825
|
|
|
|
|
|
|
You can also look for information at: |
|
826
|
|
|
|
|
|
|
|
|
827
|
|
|
|
|
|
|
=over 4 |
|
828
|
|
|
|
|
|
|
|
|
829
|
|
|
|
|
|
|
=item * RT: CPAN's request tracker (report bugs here) |
|
830
|
|
|
|
|
|
|
|
|
831
|
|
|
|
|
|
|
L<http://rt.cpan.org/NoAuth/Bugs.html?Dist=Carp-Capture> |
|
832
|
|
|
|
|
|
|
|
|
833
|
|
|
|
|
|
|
=item * AnnoCPAN: Annotated CPAN documentation |
|
834
|
|
|
|
|
|
|
|
|
835
|
|
|
|
|
|
|
L<http://annocpan.org/dist/Carp-Capture> |
|
836
|
|
|
|
|
|
|
|
|
837
|
|
|
|
|
|
|
=item * CPAN Ratings |
|
838
|
|
|
|
|
|
|
|
|
839
|
|
|
|
|
|
|
L<http://cpanratings.perl.org/d/Carp-Capture> |
|
840
|
|
|
|
|
|
|
|
|
841
|
|
|
|
|
|
|
=item * Search CPAN |
|
842
|
|
|
|
|
|
|
|
|
843
|
|
|
|
|
|
|
L<http://search.cpan.org/dist/Carp-Capture/> |
|
844
|
|
|
|
|
|
|
|
|
845
|
|
|
|
|
|
|
=back |
|
846
|
|
|
|
|
|
|
|
|
847
|
|
|
|
|
|
|
=head1 DEPENDENCIES |
|
848
|
|
|
|
|
|
|
|
|
849
|
|
|
|
|
|
|
All of these are available from CPAN: |
|
850
|
|
|
|
|
|
|
|
|
851
|
|
|
|
|
|
|
Moose |
|
852
|
|
|
|
|
|
|
Carp::Proxy |
|
853
|
|
|
|
|
|
|
|
|
854
|
|
|
|
|
|
|
=head1 SEE ALSO |
|
855
|
|
|
|
|
|
|
|
|
856
|
|
|
|
|
|
|
=over 4 |
|
857
|
|
|
|
|
|
|
|
|
858
|
|
|
|
|
|
|
=item * |
|
859
|
|
|
|
|
|
|
|
|
860
|
|
|
|
|
|
|
See 'perldoc -f caller' for information on accessing the current callstack |
|
861
|
|
|
|
|
|
|
from Perl. |
|
862
|
|
|
|
|
|
|
|
|
863
|
|
|
|
|
|
|
=item * |
|
864
|
|
|
|
|
|
|
|
|
865
|
|
|
|
|
|
|
See 'perldoc Carp' for documentation on B<confess()> |
|
866
|
|
|
|
|
|
|
|
|
867
|
|
|
|
|
|
|
=back |
|
868
|
|
|
|
|
|
|
|
|
869
|
|
|
|
|
|
|
=head1 LICENSE AND COPYRIGHT |
|
870
|
|
|
|
|
|
|
|
|
871
|
|
|
|
|
|
|
Copyright 2014-2015 Paul Liebert. |
|
872
|
|
|
|
|
|
|
|
|
873
|
|
|
|
|
|
|
This program is free software; you can redistribute it and/or modify it |
|
874
|
|
|
|
|
|
|
under the terms of either: the GNU General Public License as published |
|
875
|
|
|
|
|
|
|
by the Free Software Foundation; or the Artistic License. |
|
876
|
|
|
|
|
|
|
|
|
877
|
|
|
|
|
|
|
See L<http://dev.perl.org/licenses/> for more information. |
|
878
|
|
|
|
|
|
|
|
|
879
|
|
|
|
|
|
|
=cut |