line |
stmt |
bran |
cond |
sub |
pod |
time |
code |
1
|
|
|
|
|
|
|
package Devel::Dumpvar; |
2
|
|
|
|
|
|
|
|
3
|
|
|
|
|
|
|
# Devel::Dumpvar is a pure-OO re-implementation of the dumpvar.pl |
4
|
|
|
|
|
|
|
# script used with the perl debugger. |
5
|
|
|
|
|
|
|
# This module accepts that this will be slower than the original, |
6
|
|
|
|
|
|
|
# but is designed to be easier to use, more accessible, and more |
7
|
|
|
|
|
|
|
# upgradable without upgrading perl itself. |
8
|
|
|
|
|
|
|
|
9
|
2
|
|
|
2
|
|
27036
|
use 5.006; |
|
2
|
|
|
|
|
8
|
|
|
2
|
|
|
|
|
88
|
|
10
|
2
|
|
|
2
|
|
10
|
use strict; |
|
2
|
|
|
|
|
4
|
|
|
2
|
|
|
|
|
81
|
|
11
|
2
|
|
|
2
|
|
23
|
use Scalar::Util 1.18 (); |
|
2
|
|
|
|
|
48
|
|
|
2
|
|
|
|
|
43
|
|
12
|
|
|
|
|
|
|
|
13
|
2
|
|
|
2
|
|
9
|
use vars qw{$VERSION}; |
|
2
|
|
|
|
|
4
|
|
|
2
|
|
|
|
|
147
|
|
14
|
|
|
|
|
|
|
BEGIN { |
15
|
2
|
|
|
2
|
|
4539
|
$VERSION = '1.06'; |
16
|
|
|
|
|
|
|
} |
17
|
|
|
|
|
|
|
|
18
|
|
|
|
|
|
|
|
19
|
|
|
|
|
|
|
|
20
|
|
|
|
|
|
|
|
21
|
|
|
|
|
|
|
|
22
|
|
|
|
|
|
|
##################################################################### |
23
|
|
|
|
|
|
|
# Constructor and Accessors |
24
|
|
|
|
|
|
|
|
25
|
|
|
|
|
|
|
sub new { |
26
|
2
|
|
|
2
|
1
|
22
|
my $class = shift; |
27
|
2
|
|
|
|
|
5
|
my %options = @_; |
28
|
|
|
|
|
|
|
|
29
|
|
|
|
|
|
|
# Create the basic object |
30
|
2
|
|
|
|
|
6
|
my $self = bless {}, $class; |
31
|
|
|
|
|
|
|
|
32
|
|
|
|
|
|
|
# Handle the various options |
33
|
2
|
50
|
|
|
|
7
|
if ( defined $options{to} ) { |
34
|
2
|
|
|
|
|
6
|
$self->to( $options{to} ); |
35
|
|
|
|
|
|
|
} |
36
|
|
|
|
|
|
|
|
37
|
2
|
|
|
|
|
6
|
$self; |
38
|
|
|
|
|
|
|
} |
39
|
|
|
|
|
|
|
|
40
|
|
|
|
|
|
|
sub to { |
41
|
2
|
|
|
2
|
1
|
3
|
my $self = shift; |
42
|
|
|
|
|
|
|
|
43
|
|
|
|
|
|
|
# Just return if no argument |
44
|
2
|
50
|
|
|
|
5
|
return $self->{to} unless @_; |
45
|
|
|
|
|
|
|
|
46
|
|
|
|
|
|
|
# If passed undef, print to STDOUT |
47
|
2
|
|
|
|
|
2
|
my $to = shift; |
48
|
2
|
50
|
|
|
|
9
|
unless ( defined $to ) { |
49
|
0
|
|
|
|
|
0
|
delete $self->{to}; |
50
|
0
|
|
|
|
|
0
|
delete $self->{return}; |
51
|
0
|
|
|
|
|
0
|
return 1; |
52
|
|
|
|
|
|
|
} |
53
|
|
|
|
|
|
|
|
54
|
|
|
|
|
|
|
# Is it something we can print to |
55
|
2
|
50
|
33
|
|
|
11
|
if ( Scalar::Util::blessed($to) and $to->can('print') ) { |
56
|
0
|
|
|
|
|
0
|
$self->{to} = $to; |
57
|
0
|
|
|
|
|
0
|
return 1; |
58
|
|
|
|
|
|
|
} |
59
|
|
|
|
|
|
|
|
60
|
|
|
|
|
|
|
# Handle the magic 'return' option |
61
|
2
|
50
|
33
|
|
|
11
|
if ( ! ref $to and $to eq 'return' ) { |
62
|
2
|
|
|
|
|
9
|
$self->{to} = 'return'; |
63
|
2
|
|
|
|
|
4
|
return 1; |
64
|
|
|
|
|
|
|
} |
65
|
|
|
|
|
|
|
|
66
|
|
|
|
|
|
|
# Unknown option |
67
|
0
|
|
|
|
|
0
|
die "Unknown value '$to' for 'to' options"; |
68
|
|
|
|
|
|
|
} |
69
|
|
|
|
|
|
|
|
70
|
|
|
|
|
|
|
|
71
|
|
|
|
|
|
|
|
72
|
|
|
|
|
|
|
|
73
|
|
|
|
|
|
|
|
74
|
|
|
|
|
|
|
##################################################################### |
75
|
|
|
|
|
|
|
# Dumping Methods |
76
|
|
|
|
|
|
|
|
77
|
|
|
|
|
|
|
# Single method dumping |
78
|
|
|
|
|
|
|
sub dump { |
79
|
9
|
50
|
|
9
|
1
|
1440
|
my $self = ref $_[0] ? shift : shift->new; |
80
|
|
|
|
|
|
|
|
81
|
|
|
|
|
|
|
# Set up for dumping |
82
|
9
|
|
|
|
|
16
|
$self->{indent} = ''; |
83
|
9
|
|
|
|
|
14
|
$self->{seen} = {}; |
84
|
9
|
50
|
|
|
|
19
|
$self->{return} = '' if $self->_return; |
85
|
|
|
|
|
|
|
|
86
|
9
|
100
|
|
|
|
18
|
if ( @_ ) { |
87
|
|
|
|
|
|
|
# Hand off to the array dumper |
88
|
8
|
|
|
|
|
22
|
$self->_dump_array( [ @_ ] ); |
89
|
|
|
|
|
|
|
} else { |
90
|
|
|
|
|
|
|
# Shortcut the "no arguments" case |
91
|
1
|
|
|
|
|
4
|
$self->_print( " empty array"); |
92
|
|
|
|
|
|
|
} |
93
|
|
|
|
|
|
|
|
94
|
|
|
|
|
|
|
# Clean up and return the data if needed |
95
|
9
|
|
|
|
|
18
|
delete $self->{indent}; |
96
|
9
|
|
|
|
|
20
|
delete $self->{seen}; |
97
|
9
|
50
|
|
|
|
16
|
$self->_return ? delete $self->{return} : 1; |
98
|
|
|
|
|
|
|
} |
99
|
|
|
|
|
|
|
|
100
|
|
|
|
|
|
|
sub _dump_scalar { |
101
|
9
|
|
|
9
|
|
8
|
my $self = shift; |
102
|
9
|
|
|
|
|
9
|
my $value = shift; |
103
|
|
|
|
|
|
|
|
104
|
|
|
|
|
|
|
# Print the printable form of the scalar |
105
|
9
|
|
|
|
|
18
|
$self->_print( "$self->{indent}-> " . $self->_scalar($$value) ); |
106
|
|
|
|
|
|
|
} |
107
|
|
|
|
|
|
|
|
108
|
|
|
|
|
|
|
sub _dump_ref { |
109
|
3
|
|
|
3
|
|
4
|
my $self = shift; |
110
|
3
|
|
|
|
|
4
|
my $value = ${shift()}; |
|
3
|
|
|
|
|
4
|
|
111
|
|
|
|
|
|
|
|
112
|
|
|
|
|
|
|
# Print the current line |
113
|
3
|
|
|
|
|
8
|
$self->_print( "$self->{indent}-> " . $self->_refstring($value) ); |
114
|
|
|
|
|
|
|
|
115
|
|
|
|
|
|
|
# Decend to the child reference |
116
|
3
|
|
|
|
|
7
|
$self->_dump_child( $value ); |
117
|
|
|
|
|
|
|
} |
118
|
|
|
|
|
|
|
|
119
|
|
|
|
|
|
|
sub _dump_array { |
120
|
15
|
|
|
15
|
|
16
|
my $self = shift; |
121
|
15
|
|
|
|
|
13
|
my $array_ref = shift; |
122
|
|
|
|
|
|
|
|
123
|
|
|
|
|
|
|
# Handle the null array |
124
|
15
|
100
|
|
|
|
42
|
unless ( @$array_ref ) { |
125
|
1
|
|
|
|
|
4
|
return $self->_print( $self->{indent} . " empty array" ); |
126
|
|
|
|
|
|
|
} |
127
|
|
|
|
|
|
|
|
128
|
14
|
|
|
|
|
33
|
for ( my $i = 0; $i <= $#$array_ref; $i++ ) { |
129
|
38
|
|
|
|
|
46
|
my $value = $array_ref->[$i]; |
130
|
|
|
|
|
|
|
|
131
|
|
|
|
|
|
|
# Handle scalar values |
132
|
38
|
100
|
|
|
|
63
|
unless ( ref $value ) { |
133
|
|
|
|
|
|
|
# Get the printable form of the scalar |
134
|
28
|
|
|
|
|
72
|
$self->_print( "$self->{indent}$i " . $self->_scalar($value) ); |
135
|
28
|
|
|
|
|
85
|
next; |
136
|
|
|
|
|
|
|
} |
137
|
|
|
|
|
|
|
|
138
|
|
|
|
|
|
|
# Print the array line |
139
|
10
|
|
|
|
|
30
|
$self->_print( "$self->{indent}$i " . $self->_refstring($value) ); |
140
|
|
|
|
|
|
|
|
141
|
|
|
|
|
|
|
# Descend to the child |
142
|
10
|
|
|
|
|
27
|
$self->_dump_child( $value ); |
143
|
|
|
|
|
|
|
} |
144
|
|
|
|
|
|
|
} |
145
|
|
|
|
|
|
|
|
146
|
|
|
|
|
|
|
sub _dump_hash { |
147
|
4
|
|
|
4
|
|
4
|
my $self = shift; |
148
|
4
|
|
|
|
|
3
|
my $hash_ref = shift; |
149
|
|
|
|
|
|
|
|
150
|
4
|
|
|
|
|
21
|
foreach my $key ( sort keys %$hash_ref ) { |
151
|
18
|
|
|
|
|
23
|
my $value = $hash_ref->{$key}; |
152
|
|
|
|
|
|
|
|
153
|
|
|
|
|
|
|
# Handle scalar values |
154
|
18
|
100
|
|
|
|
30
|
unless ( ref $value ) { |
155
|
|
|
|
|
|
|
# Get the printable form of the scalar |
156
|
6
|
|
|
|
|
14
|
$self->_print( "$self->{indent}$key => " . $self->_scalar($value) ); |
157
|
6
|
|
|
|
|
14
|
next; |
158
|
|
|
|
|
|
|
} |
159
|
|
|
|
|
|
|
|
160
|
|
|
|
|
|
|
# Print the array line |
161
|
12
|
|
|
|
|
28
|
$self->_print( "$self->{indent}$key => " . $self->_refstring($value) ); |
162
|
|
|
|
|
|
|
|
163
|
|
|
|
|
|
|
# Decent to the child |
164
|
12
|
|
|
|
|
20
|
$self->_dump_child( $value ); |
165
|
|
|
|
|
|
|
} |
166
|
|
|
|
|
|
|
} |
167
|
|
|
|
|
|
|
|
168
|
|
|
|
|
|
|
sub _dump_code { |
169
|
0
|
|
|
0
|
|
0
|
my $self = shift; |
170
|
0
|
|
|
|
|
0
|
$self->_print( "$self->{indent}-> Sub detail listing unsupported" ); |
171
|
|
|
|
|
|
|
} |
172
|
|
|
|
|
|
|
|
173
|
|
|
|
|
|
|
sub _dump_child { |
174
|
25
|
|
|
25
|
|
22
|
my $self = shift; |
175
|
25
|
50
|
|
|
|
45
|
my $value = ref $_[0] ? shift |
176
|
|
|
|
|
|
|
: die "Bad argument to _dump_child"; |
177
|
|
|
|
|
|
|
|
178
|
|
|
|
|
|
|
# Regexp are a special case, they are immune |
179
|
|
|
|
|
|
|
# from the normal re-used address rules |
180
|
25
|
50
|
|
|
|
46
|
if ( ref $value eq 'Regexp' ) { |
181
|
|
|
|
|
|
|
# Print the pointer to the regexp |
182
|
0
|
|
|
|
|
0
|
return $self->_print( "$self->{indent} -> qr/$value/" ); |
183
|
|
|
|
|
|
|
} |
184
|
|
|
|
|
|
|
|
185
|
|
|
|
|
|
|
# Handle re-used addresses |
186
|
25
|
|
|
|
|
38
|
my $addr = Scalar::Util::refaddr $value; |
187
|
25
|
100
|
|
|
|
74
|
if ( $self->{seen}->{$addr}++ ) { |
188
|
|
|
|
|
|
|
# We've already seen this before |
189
|
2
|
|
|
|
|
5
|
return $self->_print( "$self->{indent} -> REUSED_ADDRESS" ); |
190
|
|
|
|
|
|
|
} |
191
|
|
|
|
|
|
|
|
192
|
|
|
|
|
|
|
# Indent to descend |
193
|
23
|
|
|
|
|
27
|
$self->{indent} .= ' '; |
194
|
|
|
|
|
|
|
|
195
|
|
|
|
|
|
|
# Split by type for the remaining items |
196
|
23
|
|
|
|
|
40
|
my $type = Scalar::Util::reftype $value; |
197
|
23
|
100
|
|
|
|
57
|
if ( $type eq 'REF' ) { |
|
|
100
|
|
|
|
|
|
|
|
100
|
|
|
|
|
|
|
|
50
|
|
|
|
|
|
|
|
0
|
|
|
|
|
|
198
|
3
|
|
|
|
|
6
|
$self->_dump_ref( $value ); |
199
|
|
|
|
|
|
|
} elsif ( $type eq 'SCALAR' ) { |
200
|
9
|
|
|
|
|
15
|
$self->_dump_scalar( $value ); |
201
|
|
|
|
|
|
|
} elsif ( $type eq 'ARRAY' ) { |
202
|
7
|
|
|
|
|
18
|
$self->_dump_array( $value ); |
203
|
|
|
|
|
|
|
} elsif ( $type eq 'HASH' ) { |
204
|
4
|
|
|
|
|
10
|
$self->_dump_hash( $value ); |
205
|
|
|
|
|
|
|
} elsif ( $type eq 'CODE' ) { |
206
|
0
|
|
|
|
|
0
|
$self->_dump_code( $value ); |
207
|
|
|
|
|
|
|
} else { |
208
|
0
|
|
|
|
|
0
|
warn "ARRAY -> $type not supported"; |
209
|
|
|
|
|
|
|
} |
210
|
|
|
|
|
|
|
|
211
|
|
|
|
|
|
|
# Remove indent |
212
|
23
|
|
|
|
|
105
|
$self->{indent} =~ s/ $//; |
213
|
|
|
|
|
|
|
} |
214
|
|
|
|
|
|
|
|
215
|
|
|
|
|
|
|
|
216
|
|
|
|
|
|
|
|
217
|
|
|
|
|
|
|
|
218
|
|
|
|
|
|
|
|
219
|
|
|
|
|
|
|
##################################################################### |
220
|
|
|
|
|
|
|
# Support Methods |
221
|
|
|
|
|
|
|
|
222
|
|
|
|
|
|
|
# Get the display string for a scalar value |
223
|
|
|
|
|
|
|
sub _scalar { |
224
|
43
|
|
|
43
|
|
40
|
my $self = shift; |
225
|
43
|
|
|
|
|
41
|
my $v = shift; |
226
|
|
|
|
|
|
|
|
227
|
|
|
|
|
|
|
# Shortcuts |
228
|
43
|
100
|
|
|
|
75
|
return 'undef' unless defined $v; |
229
|
41
|
50
|
|
|
|
63
|
return "''" unless length $v; |
230
|
|
|
|
|
|
|
|
231
|
|
|
|
|
|
|
# Is it a number? |
232
|
41
|
100
|
|
|
|
90
|
if ( Scalar::Util::looks_like_number($v) ) { |
233
|
|
|
|
|
|
|
# Show as-is |
234
|
28
|
|
|
|
|
106
|
return $v; |
235
|
|
|
|
|
|
|
} |
236
|
|
|
|
|
|
|
|
237
|
|
|
|
|
|
|
# Auto-detect the tick to use |
238
|
13
|
|
|
|
|
15
|
my $tick = "'"; |
239
|
13
|
|
|
|
|
12
|
if ( ord('A') == 193 ) { |
240
|
|
|
|
|
|
|
if ( $v =~ /[\000-\011]/ or $v =~ /[\013-\024\31-\037\177]/ ) { |
241
|
|
|
|
|
|
|
$tick = '"'; |
242
|
|
|
|
|
|
|
} else { |
243
|
|
|
|
|
|
|
$tick = "'"; |
244
|
|
|
|
|
|
|
} |
245
|
|
|
|
|
|
|
} else { |
246
|
13
|
50
|
|
|
|
24
|
if ( $v =~ /[\000-\011\013-\037\177]/ ) { |
247
|
0
|
|
|
|
|
0
|
$tick = '"'; |
248
|
|
|
|
|
|
|
} else { |
249
|
13
|
|
|
|
|
16
|
$tick = "'"; |
250
|
|
|
|
|
|
|
} |
251
|
|
|
|
|
|
|
} |
252
|
|
|
|
|
|
|
|
253
|
|
|
|
|
|
|
# Tick-specific escaping |
254
|
13
|
50
|
|
|
|
18
|
if ( $tick eq "'" ) { |
255
|
13
|
|
|
|
|
17
|
$v =~ s/([\'\\])/\\$1/g; |
256
|
|
|
|
|
|
|
} else { |
257
|
0
|
|
|
|
|
0
|
$v =~ s/([\"\\\$\@])/\\$1/g; |
258
|
0
|
|
|
|
|
0
|
$v =~ s/\033/\\e/g; |
259
|
0
|
|
|
|
|
0
|
if ( ord('A') == 193 ) { # EBCDIC. |
260
|
|
|
|
|
|
|
$v =~ s/([\000-\037\177])/'\\c'.chr(193)/eg; # Unfinished. |
261
|
|
|
|
|
|
|
} else { |
262
|
0
|
|
|
|
|
0
|
$v =~ s/([\000-\037\177])/'\\c'._scalar_ord($1)/eg; |
|
0
|
|
|
|
|
0
|
|
263
|
|
|
|
|
|
|
} |
264
|
|
|
|
|
|
|
} |
265
|
|
|
|
|
|
|
|
266
|
|
|
|
|
|
|
# Unicode and high-bit escaping |
267
|
13
|
|
|
|
|
22
|
$v = _scalar_unicode($v); |
268
|
13
|
|
|
|
|
23
|
$v =~ s/([\200-\377])/'\\'.sprintf('%3o',ord($1))/eg; |
|
0
|
|
|
|
|
0
|
|
269
|
|
|
|
|
|
|
|
270
|
13
|
|
|
|
|
41
|
return "${tick}${v}${tick}"; |
271
|
|
|
|
|
|
|
} |
272
|
|
|
|
|
|
|
|
273
|
|
|
|
|
|
|
sub _scalar_ord { |
274
|
0
|
|
|
0
|
|
0
|
my $chr = shift; |
275
|
0
|
|
|
|
|
0
|
$chr = chr(ord($chr)^64); |
276
|
0
|
|
|
|
|
0
|
$chr =~ s{\\}{\\\\}g; |
277
|
0
|
|
|
|
|
0
|
return $chr; |
278
|
|
|
|
|
|
|
} |
279
|
|
|
|
|
|
|
|
280
|
|
|
|
|
|
|
sub _scalar_unicode { |
281
|
61
|
50
|
|
|
|
127
|
join( "", |
282
|
13
|
|
|
13
|
|
41
|
map { $_ > 255 ? sprintf("\\x{%04X}", $_) : chr($_) } |
283
|
|
|
|
|
|
|
unpack("U*", $_[0])); |
284
|
|
|
|
|
|
|
} |
285
|
|
|
|
|
|
|
|
286
|
|
|
|
|
|
|
sub _refstring { |
287
|
25
|
|
|
25
|
|
546
|
my $self = shift; |
288
|
25
|
50
|
|
|
|
42
|
my $value = ref $_[0] ? shift |
289
|
|
|
|
|
|
|
: die "Bad argument to _refstring"; |
290
|
|
|
|
|
|
|
|
291
|
|
|
|
|
|
|
# Handle regexp |
292
|
25
|
50
|
|
|
|
49
|
if ( ref $value eq 'Regexp' ) { |
293
|
0
|
|
|
|
|
0
|
return "$value"; |
294
|
|
|
|
|
|
|
} |
295
|
|
|
|
|
|
|
|
296
|
25
|
|
|
|
|
68
|
my $addr = sprintf '0x%x', Scalar::Util::refaddr($value); |
297
|
25
|
|
|
|
|
48
|
my $type = Scalar::Util::reftype($value); |
298
|
25
|
50
|
|
|
|
85
|
unless ( $type =~ /^(?:SCALAR|ARRAY|HASH|REF|CODE)$/ ) { |
299
|
0
|
|
|
|
|
0
|
return "UNSUPPORTED($addr)"; |
300
|
|
|
|
|
|
|
} |
301
|
25
|
|
|
|
|
43
|
my $class = Scalar::Util::blessed($value); |
302
|
25
|
100
|
|
|
|
150
|
defined $class |
303
|
|
|
|
|
|
|
? "$class=$type($addr)" |
304
|
|
|
|
|
|
|
: "$type($addr)"; |
305
|
|
|
|
|
|
|
} |
306
|
|
|
|
|
|
|
|
307
|
|
|
|
|
|
|
sub _print { |
308
|
72
|
|
|
72
|
|
74
|
my $self = shift; |
309
|
72
|
50
|
|
|
|
125
|
my $line = defined $_[0] ? "$_[0]\n" : "\n"; |
310
|
|
|
|
|
|
|
|
311
|
|
|
|
|
|
|
# Handle the default case |
312
|
72
|
50
|
|
|
|
124
|
return print $line unless $self->{to}; |
313
|
|
|
|
|
|
|
|
314
|
72
|
50
|
0
|
|
|
105
|
if ( $self->{to} eq 'return' ) { |
|
|
0
|
|
|
|
|
|
315
|
|
|
|
|
|
|
# Handle the "return data" case |
316
|
72
|
|
|
|
|
113
|
$self->{return} .= $line; |
317
|
|
|
|
|
|
|
|
318
|
|
|
|
|
|
|
} elsif ( Scalar::Util::blessed($self->{to}) and $self->{to}->can('print') ) { |
319
|
|
|
|
|
|
|
# If we have a we something we can print to, do so |
320
|
0
|
|
|
|
|
0
|
$self->{to}->print( $line ); |
321
|
|
|
|
|
|
|
|
322
|
|
|
|
|
|
|
} else { |
323
|
|
|
|
|
|
|
# If the dump target is unknown, do nothing |
324
|
|
|
|
|
|
|
} |
325
|
|
|
|
|
|
|
|
326
|
72
|
|
|
|
|
84
|
1; |
327
|
|
|
|
|
|
|
} |
328
|
|
|
|
|
|
|
|
329
|
|
|
|
|
|
|
# Are we returning the dump data |
330
|
|
|
|
|
|
|
sub _return { |
331
|
18
|
|
|
18
|
|
20
|
my $self = shift; |
332
|
18
|
50
|
33
|
|
|
166
|
defined $self->{to} and ! ref $self->{to} and $self->{to} eq 'return'; |
333
|
|
|
|
|
|
|
} |
334
|
|
|
|
|
|
|
|
335
|
|
|
|
|
|
|
1; |
336
|
|
|
|
|
|
|
|
337
|
|
|
|
|
|
|
__END__ |