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 |