line |
stmt |
bran |
cond |
sub |
pod |
time |
code |
1
|
1
|
|
|
1
|
|
4
|
use strict; |
|
1
|
|
|
|
|
1
|
|
|
1
|
|
|
|
|
23
|
|
2
|
1
|
|
|
1
|
|
2
|
use warnings FATAL => 'all'; |
|
1
|
|
|
|
|
1
|
|
|
1
|
|
|
|
|
49
|
|
3
|
|
|
|
|
|
|
|
4
|
|
|
|
|
|
|
package Data::Scan::Impl::Printer; |
5
|
|
|
|
|
|
|
|
6
|
|
|
|
|
|
|
# ABSTRACT: Data::Scan printer implementation |
7
|
|
|
|
|
|
|
|
8
|
|
|
|
|
|
|
our $VERSION = '0.007'; # VERSION |
9
|
|
|
|
|
|
|
|
10
|
|
|
|
|
|
|
our $AUTHORITY = 'cpan:JDDPAUSE'; # AUTHORITY |
11
|
|
|
|
|
|
|
|
12
|
|
|
|
|
|
|
|
13
|
1
|
|
|
1
|
|
421
|
use Moo; |
|
1
|
|
|
|
|
8884
|
|
|
1
|
|
|
|
|
4
|
|
14
|
|
|
|
|
|
|
|
15
|
1
|
|
|
1
|
|
1319
|
use B::Deparse; |
|
1
|
|
|
|
|
2
|
|
|
1
|
|
|
|
|
21
|
|
16
|
1
|
|
|
1
|
|
391
|
use Class::Inspector; |
|
1
|
|
|
|
|
3069
|
|
|
1
|
|
|
|
|
33
|
|
17
|
1
|
|
|
1
|
|
383
|
use Perl::OSType qw/is_os_type/; |
|
1
|
|
|
|
|
266
|
|
|
1
|
|
|
|
|
54
|
|
18
|
|
|
|
|
|
|
my $_HAVE_Win32__Console__ANSI; |
19
|
|
|
|
|
|
|
BEGIN { |
20
|
|
|
|
|
|
|
# |
21
|
|
|
|
|
|
|
# Will/Should success only on Win32 |
22
|
|
|
|
|
|
|
# |
23
|
1
|
|
|
1
|
|
67
|
$_HAVE_Win32__Console__ANSI = eval 'use Win32::Console::ANSI; 1;' ## no critic qw/BuiltinFunctions::ProhibitStringyEval/ |
|
1
|
|
|
1
|
|
162
|
|
|
0
|
|
|
|
|
0
|
|
|
0
|
|
|
|
|
0
|
|
24
|
|
|
|
|
|
|
} |
25
|
1
|
|
|
1
|
|
3
|
use Scalar::Util 1.26 qw/reftype refaddr looks_like_number/; |
|
1
|
|
|
|
|
18
|
|
|
1
|
|
|
|
|
66
|
|
26
|
1
|
|
|
1
|
|
492
|
use Term::ANSIColor; |
|
1
|
|
|
|
|
4605
|
|
|
1
|
|
|
|
|
95
|
|
27
|
1
|
|
|
1
|
|
567
|
use Types::Standard -all; |
|
1
|
|
|
|
|
46056
|
|
|
1
|
|
|
|
|
9
|
|
28
|
1
|
|
|
1
|
|
24546
|
use Types::Common::Numeric -all; |
|
1
|
|
|
|
|
7533
|
|
|
1
|
|
|
|
|
7
|
|
29
|
|
|
|
|
|
|
# |
30
|
|
|
|
|
|
|
# My way of matching only printable ASCII characters |
31
|
|
|
|
|
|
|
# |
32
|
|
|
|
|
|
|
my $_ASCII_PRINT = quotemeta(join('', map { chr } (32,33..126))); |
33
|
|
|
|
|
|
|
my $_NON_ASCII_PRINT_RE = qr/[^$_ASCII_PRINT]/; |
34
|
|
|
|
|
|
|
# |
35
|
|
|
|
|
|
|
# Avoid calls to arybase and predictible results |
36
|
|
|
|
|
|
|
# |
37
|
1
|
|
|
1
|
|
3836
|
my $ARRAY_START_INDICE = $[; |
|
1
|
|
|
|
|
264
|
|
|
1
|
|
|
|
|
2320
|
|
38
|
|
|
|
|
|
|
my $ARRAY_START_INDICE_PLUS_1 = $ARRAY_START_INDICE + 1; |
39
|
|
|
|
|
|
|
my $ARRAY_START_INDICE_PLUS_2 = $ARRAY_START_INDICE_PLUS_1 + 1; |
40
|
|
|
|
|
|
|
my $ARRAY_START_INDICE_PLUS_3 = $ARRAY_START_INDICE_PLUS_2 + 1; |
41
|
|
|
|
|
|
|
my $ARRAY_START_INDICE_MINUS_1 = $ARRAY_START_INDICE - 1; |
42
|
|
|
|
|
|
|
|
43
|
|
|
|
|
|
|
|
44
|
|
|
|
|
|
|
|
45
|
|
|
|
|
|
|
has handle => (is => 'ro', isa => FileHandle, default => sub { return \*STDOUT }); |
46
|
|
|
|
|
|
|
|
47
|
|
|
|
|
|
|
|
48
|
|
|
|
|
|
|
has indent => (is => 'ro', isa => Str, default => sub { return ' ' }); |
49
|
|
|
|
|
|
|
|
50
|
|
|
|
|
|
|
|
51
|
|
|
|
|
|
|
has max_depth => (is => 'ro', isa => PositiveOrZeroInt, default => sub { return 0 }); |
52
|
|
|
|
|
|
|
|
53
|
|
|
|
|
|
|
|
54
|
|
|
|
|
|
|
has undef => (is => 'ro', isa => Str, default => sub { return 'undef' }); |
55
|
|
|
|
|
|
|
|
56
|
|
|
|
|
|
|
|
57
|
|
|
|
|
|
|
has unknown => (is => 'ro', isa => Str, default => sub { return '???' }); |
58
|
|
|
|
|
|
|
|
59
|
|
|
|
|
|
|
|
60
|
|
|
|
|
|
|
has newline => (is => 'ro', isa => Str, default => sub { return "\n" }); |
61
|
|
|
|
|
|
|
|
62
|
|
|
|
|
|
|
|
63
|
|
|
|
|
|
|
has with_ansicolor => (is => 'ro', isa => Bool, default => sub { return __PACKAGE__->_canColor }); |
64
|
|
|
|
|
|
|
|
65
|
|
|
|
|
|
|
|
66
|
|
|
|
|
|
|
has array_start => (is => 'ro', isa => Str, default => sub { return '[' }); |
67
|
|
|
|
|
|
|
|
68
|
|
|
|
|
|
|
|
69
|
|
|
|
|
|
|
has array_next => (is => 'ro', isa => Str, default => sub { return ',' }); |
70
|
|
|
|
|
|
|
|
71
|
|
|
|
|
|
|
|
72
|
|
|
|
|
|
|
has array_end => (is => 'ro', isa => Str, default => sub { return ']' }); |
73
|
|
|
|
|
|
|
|
74
|
|
|
|
|
|
|
|
75
|
|
|
|
|
|
|
has hash_start => (is => 'ro', isa => Str, default => sub { return ' {' }); |
76
|
|
|
|
|
|
|
|
77
|
|
|
|
|
|
|
|
78
|
|
|
|
|
|
|
has hash_next => (is => 'ro', isa => Str, default => sub { return ',' }); |
79
|
|
|
|
|
|
|
|
80
|
|
|
|
|
|
|
|
81
|
|
|
|
|
|
|
has hash_end => (is => 'ro', isa => Str, default => sub { return '}' }); |
82
|
|
|
|
|
|
|
|
83
|
|
|
|
|
|
|
|
84
|
|
|
|
|
|
|
has hash_separator => (is => 'ro', isa => Str, default => sub { return ' => ' }); |
85
|
|
|
|
|
|
|
|
86
|
|
|
|
|
|
|
|
87
|
|
|
|
|
|
|
has indice_start => (is => 'ro', isa => Str, default => sub { return '[' }); |
88
|
|
|
|
|
|
|
|
89
|
|
|
|
|
|
|
|
90
|
|
|
|
|
|
|
has indice_end => (is => 'ro', isa => Str, default => sub { return '] ' }); |
91
|
|
|
|
|
|
|
|
92
|
|
|
|
|
|
|
|
93
|
|
|
|
|
|
|
has with_indices_full => (is => 'ro', isa => Bool, default => sub { return !!0 }); |
94
|
|
|
|
|
|
|
|
95
|
|
|
|
|
|
|
|
96
|
|
|
|
|
|
|
has address_start => (is => 'ro', isa => Str, default => sub { return '(' }); |
97
|
|
|
|
|
|
|
|
98
|
|
|
|
|
|
|
|
99
|
|
|
|
|
|
|
has address_format => (is => 'ro', isa => Str, default => sub { return '0x%x' }); |
100
|
|
|
|
|
|
|
|
101
|
|
|
|
|
|
|
|
102
|
|
|
|
|
|
|
has address_end => (is => 'ro', isa => Str, default => sub { return ')' }); |
103
|
|
|
|
|
|
|
|
104
|
|
|
|
|
|
|
|
105
|
|
|
|
|
|
|
has ref_start => (is => 'ro', isa => Str, default => sub { return '\\' }); |
106
|
|
|
|
|
|
|
|
107
|
|
|
|
|
|
|
|
108
|
|
|
|
|
|
|
has ref_end => (is => 'ro', isa => Str, default => sub { return '' }); |
109
|
|
|
|
|
|
|
|
110
|
|
|
|
|
|
|
|
111
|
|
|
|
|
|
|
has with_address => (is => 'ro', isa => Bool, default => sub { return !!0 }); |
112
|
|
|
|
|
|
|
|
113
|
|
|
|
|
|
|
|
114
|
|
|
|
|
|
|
has with_array_indice => (is => 'ro', isa => Bool, default => sub { return !!1 }); |
115
|
|
|
|
|
|
|
|
116
|
|
|
|
|
|
|
|
117
|
|
|
|
|
|
|
has with_hash_indice => (is => 'ro', isa => Bool, default => sub { return !!1 }); |
118
|
|
|
|
|
|
|
|
119
|
|
|
|
|
|
|
|
120
|
|
|
|
|
|
|
has with_deparse => (is => 'ro', isa => Bool, default => sub { return !!0 }); |
121
|
|
|
|
|
|
|
|
122
|
|
|
|
|
|
|
|
123
|
|
|
|
|
|
|
has with_methods => (is => 'ro', isa => Bool, default => sub { return !!0 }); |
124
|
|
|
|
|
|
|
|
125
|
|
|
|
|
|
|
|
126
|
|
|
|
|
|
|
has with_filename => (is => 'ro', isa => Bool, default => sub { return !!0 }); |
127
|
|
|
|
|
|
|
|
128
|
|
|
|
|
|
|
|
129
|
|
|
|
|
|
|
has buffered => (is => 'ro', isa => Bool, default => sub { return !!0 }); |
130
|
|
|
|
|
|
|
|
131
|
|
|
|
|
|
|
|
132
|
|
|
|
|
|
|
has colors => (is => 'ro', isa => HashRef[Str|Undef], default => sub { |
133
|
|
|
|
|
|
|
return { |
134
|
|
|
|
|
|
|
blessed => 'bold', |
135
|
|
|
|
|
|
|
string => undef, |
136
|
|
|
|
|
|
|
regexp => undef, |
137
|
|
|
|
|
|
|
|
138
|
|
|
|
|
|
|
array_start => 'blue', |
139
|
|
|
|
|
|
|
array_next => 'blue', |
140
|
|
|
|
|
|
|
array_end => 'blue', |
141
|
|
|
|
|
|
|
|
142
|
|
|
|
|
|
|
hash_start => 'blue', |
143
|
|
|
|
|
|
|
hash_separator => 'blue', |
144
|
|
|
|
|
|
|
hash_next => 'blue', |
145
|
|
|
|
|
|
|
hash_end => 'blue', |
146
|
|
|
|
|
|
|
|
147
|
|
|
|
|
|
|
ref_start => undef, |
148
|
|
|
|
|
|
|
ref_end => undef, |
149
|
|
|
|
|
|
|
|
150
|
|
|
|
|
|
|
indice_full => 'magenta', |
151
|
|
|
|
|
|
|
indice_start => 'magenta', |
152
|
|
|
|
|
|
|
indice_value => 'magenta', |
153
|
|
|
|
|
|
|
indice_end => 'magenta', |
154
|
|
|
|
|
|
|
|
155
|
|
|
|
|
|
|
undef => 'red', |
156
|
|
|
|
|
|
|
unknown => 'bold red', |
157
|
|
|
|
|
|
|
address_start => 'magenta', |
158
|
|
|
|
|
|
|
address_value => 'magenta', |
159
|
|
|
|
|
|
|
address_end => 'magenta', |
160
|
|
|
|
|
|
|
code => 'yellow', |
161
|
|
|
|
|
|
|
already_scanned => 'green' |
162
|
|
|
|
|
|
|
} |
163
|
|
|
|
|
|
|
} |
164
|
|
|
|
|
|
|
); |
165
|
|
|
|
|
|
|
# |
166
|
|
|
|
|
|
|
# Internal attributes - Note that they are ALL explicitely setted in dsstart() |
167
|
|
|
|
|
|
|
# and because they are internal we give us the right to access them |
168
|
|
|
|
|
|
|
# in the dirty way |
169
|
|
|
|
|
|
|
# |
170
|
|
|
|
|
|
|
has _lines => (is => 'rwp', isa => Undef|ArrayRef[ArrayRef]); |
171
|
|
|
|
|
|
|
has _currentLevel => (is => 'rwp', isa => Undef|PositiveOrZeroInt); |
172
|
|
|
|
|
|
|
has _currentIndicePerLevel => (is => 'rwp', isa => Undef|ArrayRef[PositiveOrZeroInt]); |
173
|
|
|
|
|
|
|
has _currentReftypePerLevel => (is => 'rwp', isa => Undef|ArrayRef[Str]); |
174
|
|
|
|
|
|
|
has _seen => (is => 'rwp', isa => Undef|HashRef[PositiveOrZeroInt]); |
175
|
|
|
|
|
|
|
has _indice_start_nospace => (is => 'rwp', isa => Undef|Str); # C.f. BUILD |
176
|
|
|
|
|
|
|
has _indice_end_nospace => (is => 'rwp', isa => Undef|Str); |
177
|
|
|
|
|
|
|
has _colors_cache => (is => 'rwp', isa => Undef|HashRef[Str|Undef]); |
178
|
|
|
|
|
|
|
has _concatenatedLevels => (is => 'rwp', isa => Undef|ArrayRef[Str]); |
179
|
|
|
|
|
|
|
|
180
|
|
|
|
|
|
|
# |
181
|
|
|
|
|
|
|
# Required methods |
182
|
|
|
|
|
|
|
# |
183
|
|
|
|
|
|
|
|
184
|
|
|
|
|
|
|
|
185
|
|
|
|
|
|
|
sub dsstart { |
186
|
1
|
|
|
1
|
1
|
1
|
my ($self) = @_; |
187
|
|
|
|
|
|
|
|
188
|
1
|
|
|
|
|
4
|
$self->_set__lines([[]]); |
189
|
1
|
|
|
|
|
419
|
$self->_set__currentLevel(0); |
190
|
1
|
|
|
|
|
446
|
$self->_set__currentIndicePerLevel([]); |
191
|
1
|
|
|
|
|
445
|
$self->_set__currentReftypePerLevel([]); |
192
|
1
|
|
|
|
|
405
|
$self->_set__seen({}); |
193
|
1
|
|
|
|
|
403
|
$self->_set__concatenatedLevels([]); |
194
|
|
|
|
|
|
|
|
195
|
1
|
|
|
|
|
410
|
my $indice_start_nospace = $self->indice_start; |
196
|
1
|
|
|
|
|
3
|
my $indice_end_nospace = $self->indice_end; |
197
|
1
|
|
|
|
|
2
|
$indice_start_nospace =~ s/\s//g; |
198
|
1
|
|
|
|
|
3
|
$indice_end_nospace =~ s/\s//g; |
199
|
1
|
|
|
|
|
3
|
$self->_set__indice_start_nospace($indice_start_nospace); |
200
|
1
|
|
|
|
|
401
|
$self->_set__indice_end_nospace($indice_end_nospace); |
201
|
|
|
|
|
|
|
# |
202
|
|
|
|
|
|
|
# Precompute color attributes |
203
|
|
|
|
|
|
|
# |
204
|
1
|
|
|
|
|
402
|
$self->_set__colors_cache({}); |
205
|
1
|
50
|
|
|
|
407
|
if ($self->with_ansicolor) { |
206
|
1
|
|
|
|
|
1
|
foreach (keys %{$self->colors}) { |
|
1
|
|
|
|
|
7
|
|
207
|
23
|
|
|
|
|
25
|
my $color = $self->colors->{$_}; |
208
|
23
|
100
|
|
|
|
22
|
if (defined($color)) { |
209
|
19
|
|
|
|
|
27
|
my $colored = colored('dummy', $color); |
210
|
|
|
|
|
|
|
# |
211
|
|
|
|
|
|
|
# ANSI color spec is clear: attributes before the string, followed by |
212
|
|
|
|
|
|
|
# the string, followed by "\e[0m". We do not support the eventual |
213
|
|
|
|
|
|
|
# $EACHLINE hack. |
214
|
|
|
|
|
|
|
# |
215
|
19
|
50
|
|
|
|
314
|
if ($colored =~ /(.+)dummy\e\[0m$/) { |
216
|
19
|
|
|
|
|
62
|
$self->{_colors_cache}->{$_} = substr($colored, $-[1], $+[1] - $-[1]) |
217
|
|
|
|
|
|
|
} else { |
218
|
0
|
|
|
|
|
0
|
$self->{_colors_cache}->{$_} = undef |
219
|
|
|
|
|
|
|
} |
220
|
|
|
|
|
|
|
} else { |
221
|
4
|
|
|
|
|
6
|
$self->{_colors_cache}->{$_} = undef |
222
|
|
|
|
|
|
|
} |
223
|
|
|
|
|
|
|
} |
224
|
|
|
|
|
|
|
} else { |
225
|
0
|
|
|
|
|
0
|
foreach (keys %{$self->colors}) { |
|
0
|
|
|
|
|
0
|
|
226
|
0
|
|
|
|
|
0
|
$self->{_colors_cache}->{$_} = undef |
227
|
|
|
|
|
|
|
} |
228
|
|
|
|
|
|
|
} |
229
|
|
|
|
|
|
|
|
230
|
|
|
|
|
|
|
return |
231
|
1
|
|
|
|
|
4
|
} |
232
|
|
|
|
|
|
|
|
233
|
|
|
|
|
|
|
|
234
|
|
|
|
|
|
|
sub dsend { |
235
|
1
|
|
|
1
|
1
|
2
|
my ($self) = @_; |
236
|
|
|
|
|
|
|
|
237
|
|
|
|
|
|
|
# |
238
|
|
|
|
|
|
|
# Buffered or not, we always "flush" what remains in the _lines. |
239
|
|
|
|
|
|
|
# In fact, in the buffered mode, the previous call can be |
240
|
|
|
|
|
|
|
# a dsclose(), that may push new characters, and there is no call |
241
|
|
|
|
|
|
|
# to _print in the later. |
242
|
|
|
|
|
|
|
# |
243
|
1
|
|
|
|
|
2
|
$self->_print; |
244
|
|
|
|
|
|
|
|
245
|
1
|
|
|
|
|
34
|
$self->_set__lines (undef); |
246
|
1
|
|
|
|
|
24
|
$self->_set__currentLevel (undef); |
247
|
1
|
|
|
|
|
23
|
$self->_set__currentIndicePerLevel (undef); |
248
|
1
|
|
|
|
|
23
|
$self->_set__currentReftypePerLevel(undef); |
249
|
1
|
|
|
|
|
23
|
$self->_set__seen (undef); |
250
|
1
|
|
|
|
|
27
|
$self->_set__indice_start_nospace (undef); |
251
|
1
|
|
|
|
|
23
|
$self->_set__indice_end_nospace (undef); |
252
|
1
|
|
|
|
|
22
|
$self->_set__colors_cache (undef); |
253
|
1
|
|
|
|
|
25
|
$self->_set__concatenatedLevels (undef); |
254
|
|
|
|
|
|
|
|
255
|
1
|
|
|
|
|
13
|
return !!1 |
256
|
|
|
|
|
|
|
} |
257
|
|
|
|
|
|
|
|
258
|
|
|
|
|
|
|
sub _print { |
259
|
36
|
|
|
36
|
|
25
|
my ($self) = @_; |
260
|
|
|
|
|
|
|
|
261
|
36
|
50
|
|
|
|
24
|
return if (! @{$self->{_lines}}); |
|
36
|
|
|
|
|
50
|
|
262
|
|
|
|
|
|
|
|
263
|
36
|
|
|
|
|
35
|
my $output = join($self->newline, map { join('', @{$_}) } @{$self->{_lines}}); |
|
67
|
|
|
|
|
43
|
|
|
67
|
|
|
|
|
151
|
|
|
36
|
|
|
|
|
41
|
|
264
|
36
|
|
|
|
|
47
|
my $handle = $self->handle; |
265
|
36
|
50
|
33
|
|
|
69
|
if (Scalar::Util::blessed($handle) && $handle->can('print')) { |
266
|
0
|
|
|
|
|
0
|
$handle->print($output) |
267
|
|
|
|
|
|
|
} else { |
268
|
36
|
|
|
|
|
2522
|
print $handle $output |
269
|
|
|
|
|
|
|
} |
270
|
|
|
|
|
|
|
|
271
|
36
|
|
|
|
|
812
|
return $self->_set__lines([[]]) |
272
|
|
|
|
|
|
|
} |
273
|
|
|
|
|
|
|
|
274
|
|
|
|
|
|
|
|
275
|
|
|
|
|
|
|
sub dsopen { |
276
|
10
|
|
|
10
|
1
|
11
|
my ($self, $item) = @_; |
277
|
|
|
|
|
|
|
|
278
|
10
|
|
|
|
|
15
|
my $reftype = reftype $item; |
279
|
10
|
|
|
|
|
13
|
my $blessed = Scalar::Util::blessed $item; |
280
|
|
|
|
|
|
|
|
281
|
10
|
100
|
|
|
|
18
|
if ($reftype eq 'ARRAY') { $self->_pushDesc('array_start', $self->array_start) } |
|
3
|
100
|
|
|
|
8
|
|
282
|
5
|
|
|
|
|
11
|
elsif ($reftype eq 'HASH') { $self->_pushDesc('hash_start', $self->hash_start) } |
283
|
2
|
|
|
|
|
6
|
else { $self->_pushDesc('ref_start', $self->ref_start) } |
284
|
|
|
|
|
|
|
|
285
|
|
|
|
|
|
|
# |
286
|
|
|
|
|
|
|
# Precompute the string describing previous level. |
287
|
|
|
|
|
|
|
# Here $self->{_currentLevel} is the value before we increase it |
288
|
|
|
|
|
|
|
# |
289
|
10
|
100
|
|
|
|
14
|
if ($self->{_currentLevel}) { |
290
|
9
|
|
|
|
|
29
|
push(@{$self->{_concatenatedLevels}}, |
291
|
|
|
|
|
|
|
$self->{_concatenatedLevels}->[-1] . |
292
|
|
|
|
|
|
|
$self->_indice_start_nospace . |
293
|
9
|
|
|
|
|
8
|
$self->{_currentIndicePerLevel}->[-1] . |
294
|
|
|
|
|
|
|
$self->_indice_end_nospace) |
295
|
|
|
|
|
|
|
} else { |
296
|
1
|
|
|
|
|
1
|
push(@{$self->{_concatenatedLevels}}, '') |
|
1
|
|
|
|
|
2
|
|
297
|
|
|
|
|
|
|
} |
298
|
|
|
|
|
|
|
|
299
|
10
|
|
|
|
|
14
|
$self->_pushLevel($reftype); |
300
|
|
|
|
|
|
|
return |
301
|
10
|
|
|
|
|
40
|
} |
302
|
|
|
|
|
|
|
|
303
|
|
|
|
|
|
|
|
304
|
|
|
|
|
|
|
sub dsclose { |
305
|
10
|
|
|
10
|
1
|
8
|
my ($self, $item) = @_; |
306
|
|
|
|
|
|
|
|
307
|
|
|
|
|
|
|
# |
308
|
|
|
|
|
|
|
# Remove precomputed string describing this level. |
309
|
|
|
|
|
|
|
# |
310
|
10
|
|
|
|
|
11
|
pop(@{$self->{_concatenatedLevels}}); |
|
10
|
|
|
|
|
11
|
|
311
|
|
|
|
|
|
|
|
312
|
10
|
|
|
|
|
16
|
$self->_popLevel; |
313
|
|
|
|
|
|
|
|
314
|
10
|
|
|
|
|
13
|
my $reftype = reftype $item; |
315
|
10
|
100
|
|
|
|
20
|
if ($reftype eq 'ARRAY') { $self->_pushLine; $self->_pushDesc('array_end', $self->array_end) } |
|
3
|
100
|
|
|
|
7
|
|
|
3
|
|
|
|
|
7
|
|
316
|
5
|
|
|
|
|
6
|
elsif ($reftype eq 'HASH') { $self->_pushLine; $self->_pushDesc('hash_end', $self->hash_end) } |
|
5
|
|
|
|
|
10
|
|
317
|
2
|
|
|
|
|
7
|
else { $self->_pushDesc('ref_end', $self->ref_end) } |
318
|
|
|
|
|
|
|
|
319
|
|
|
|
|
|
|
return |
320
|
10
|
|
|
|
|
35
|
} |
321
|
|
|
|
|
|
|
|
322
|
|
|
|
|
|
|
|
323
|
|
|
|
|
|
|
sub dsread { |
324
|
35
|
|
|
35
|
1
|
30
|
my ($self, $item) = @_; |
325
|
|
|
|
|
|
|
|
326
|
35
|
|
|
|
|
38
|
my $refaddr = refaddr($item); |
327
|
35
|
|
100
|
|
|
90
|
my $blessed = Scalar::Util::blessed($item) // ''; |
328
|
35
|
|
100
|
|
|
78
|
my $reftype = reftype($item) // ''; |
329
|
|
|
|
|
|
|
# |
330
|
|
|
|
|
|
|
# Precompute things that always have the same value |
331
|
|
|
|
|
|
|
# |
332
|
35
|
|
|
|
|
44
|
my $indice_start = $self->indice_start; |
333
|
35
|
|
|
|
|
38
|
my $indice_end = $self->indice_end; |
334
|
35
|
|
|
|
|
39
|
my $indice_start_nospace = $self->_indice_start_nospace; |
335
|
35
|
|
|
|
|
31
|
my $indice_end_nospace = $self->_indice_end_nospace; |
336
|
|
|
|
|
|
|
# |
337
|
|
|
|
|
|
|
# Increase indice if we reading something unfolded |
338
|
|
|
|
|
|
|
# |
339
|
35
|
|
|
|
|
27
|
my $currentLevel = $self->{_currentLevel}; |
340
|
35
|
100
|
|
|
|
58
|
my $currentIndicePerLevel = $currentLevel ? ++$self->{_currentIndicePerLevel}->[-1] : undef; |
341
|
|
|
|
|
|
|
# |
342
|
|
|
|
|
|
|
# Push a newline or a '=>' and prefix with indice if in a fold |
343
|
|
|
|
|
|
|
# |
344
|
35
|
100
|
|
|
|
47
|
if ($currentLevel) { |
345
|
34
|
|
|
|
|
29
|
my $currentReftypePerLevel = $self->{_currentReftypePerLevel}->[-1]; |
346
|
34
|
100
|
100
|
|
|
94
|
if ($currentReftypePerLevel eq 'ARRAY' or $currentReftypePerLevel eq 'HASH') { |
347
|
32
|
|
|
|
|
19
|
my $show_indice; |
348
|
32
|
100
|
|
|
|
36
|
if ($currentReftypePerLevel eq 'ARRAY') { |
349
|
6
|
100
|
|
|
|
15
|
$self->_pushDesc('array_next', $self->array_next) if ($currentIndicePerLevel > $ARRAY_START_INDICE); |
350
|
6
|
|
|
|
|
8
|
$self->_pushLine; |
351
|
6
|
|
|
|
|
11
|
$show_indice = $self->with_array_indice |
352
|
|
|
|
|
|
|
} else { |
353
|
26
|
100
|
|
|
|
37
|
if ($currentIndicePerLevel % 2) { |
354
|
13
|
|
|
|
|
24
|
$self->_pushDesc('hash_separator', $self->hash_separator) |
355
|
|
|
|
|
|
|
} else { |
356
|
13
|
100
|
|
|
|
28
|
$self->_pushDesc('hash_next', $self->hash_next) if ($currentIndicePerLevel > 0); |
357
|
13
|
|
|
|
|
14
|
$self->_pushLine |
358
|
|
|
|
|
|
|
} |
359
|
26
|
|
|
|
|
31
|
$show_indice = $self->with_hash_indice |
360
|
|
|
|
|
|
|
} |
361
|
32
|
50
|
|
|
|
40
|
if ($show_indice) { |
362
|
32
|
50
|
|
|
|
37
|
if ($self->with_indices_full) { |
363
|
|
|
|
|
|
|
# |
364
|
|
|
|
|
|
|
# We know that $self->{_concatenatedLevels} is an ArrayRef. |
365
|
|
|
|
|
|
|
# $currentLevel is a true value, this mean there is at least |
366
|
|
|
|
|
|
|
# one element in $self->{_concatenatedLevels}. |
367
|
|
|
|
|
|
|
# |
368
|
0
|
|
|
|
|
0
|
$self->_pushDesc('indice_full', $self->{_concatenatedLevels}->[-1] . $indice_start_nospace . $currentIndicePerLevel . $indice_end_nospace) |
369
|
|
|
|
|
|
|
} else { |
370
|
32
|
|
|
|
|
34
|
$self->_pushDesc('indice_start', $indice_start); |
371
|
32
|
|
|
|
|
37
|
$self->_pushDesc('indice_value', $currentIndicePerLevel); |
372
|
32
|
|
|
|
|
31
|
$self->_pushDesc('indice_end', $indice_end) |
373
|
|
|
|
|
|
|
} |
374
|
|
|
|
|
|
|
} |
375
|
|
|
|
|
|
|
} |
376
|
|
|
|
|
|
|
} |
377
|
|
|
|
|
|
|
# |
378
|
|
|
|
|
|
|
# See how this can be displayed |
379
|
|
|
|
|
|
|
# |
380
|
35
|
|
|
|
|
20
|
my $alreadyScanned; |
381
|
35
|
100
|
|
|
|
41
|
if ($refaddr) { |
382
|
14
|
100
|
|
|
|
22
|
if (exists($self->{_seen}->{$refaddr})) { |
383
|
2
|
|
|
|
|
2
|
$alreadyScanned = $self->{_seen}->{$refaddr}; |
384
|
|
|
|
|
|
|
# |
385
|
|
|
|
|
|
|
# Already scanned ! |
386
|
|
|
|
|
|
|
# |
387
|
2
|
|
|
|
|
3
|
$self->_pushDesc('already_scanned', $alreadyScanned) |
388
|
|
|
|
|
|
|
} else { |
389
|
|
|
|
|
|
|
# |
390
|
|
|
|
|
|
|
# Determine the "location" in terms of an hypothetical "@var" describing the tree |
391
|
|
|
|
|
|
|
# |
392
|
12
|
|
|
|
|
10
|
my $var = 'var'; |
393
|
|
|
|
|
|
|
# |
394
|
|
|
|
|
|
|
# Note the if ($currentLevel) at the end |
395
|
|
|
|
|
|
|
# |
396
|
12
|
100
|
|
|
|
23
|
$var .= $self->{_concatenatedLevels}->[-1] . $indice_start_nospace . $currentIndicePerLevel . $indice_end_nospace if ($currentLevel); |
397
|
12
|
|
|
|
|
20
|
$self->{_seen}->{$refaddr} = $var |
398
|
|
|
|
|
|
|
} |
399
|
|
|
|
|
|
|
} |
400
|
35
|
100
|
|
|
|
49
|
if (! $alreadyScanned) { |
401
|
33
|
100
|
100
|
|
|
156
|
if ($blessed && $reftype ne 'REGEXP') { |
|
|
100
|
66
|
|
|
|
|
|
|
100
|
100
|
|
|
|
|
|
|
|
100
|
|
|
|
|
|
|
|
100
|
|
|
|
|
|
|
|
66
|
|
|
|
|
402
|
|
|
|
|
|
|
# |
403
|
|
|
|
|
|
|
# A regexp appears as being blessed in perl. |
404
|
|
|
|
|
|
|
# Priority is given to blessed name except if it is a regexp. |
405
|
|
|
|
|
|
|
# |
406
|
3
|
|
|
|
|
8
|
$self->_pushDesc('blessed', $blessed) |
407
|
|
|
|
|
|
|
} elsif ($reftype eq 'CODE' && $self->with_deparse) { |
408
|
|
|
|
|
|
|
# |
409
|
|
|
|
|
|
|
# Code deparse with B::Deparse |
410
|
|
|
|
|
|
|
# |
411
|
1
|
|
|
|
|
3
|
my $i = length($self->indent) x ($self->{_currentLevel} + 2); |
412
|
1
|
|
|
|
|
2
|
my $deparseopts = ["-sCv'Useless const omitted'"]; |
413
|
1
|
|
|
|
|
2
|
my $code = eval { 'sub ' . B::Deparse->new($deparseopts)->coderef2text($item) }; |
|
1
|
|
|
|
|
938
|
|
414
|
1
|
50
|
|
|
|
7
|
goto CODE_fallback if $@; |
415
|
1
|
|
|
|
|
18
|
my @code = split(/\R/, $code); |
416
|
|
|
|
|
|
|
# |
417
|
|
|
|
|
|
|
# First item is not aligned |
418
|
|
|
|
|
|
|
# |
419
|
1
|
|
|
|
|
4
|
$self->_pushDesc('code', shift(@code)); |
420
|
|
|
|
|
|
|
# |
421
|
|
|
|
|
|
|
# The rest is aligned |
422
|
|
|
|
|
|
|
# |
423
|
1
|
50
|
|
|
|
3
|
if (@code) { |
424
|
1
|
|
|
|
|
2
|
$self->_pushLevel($reftype); |
425
|
1
|
|
|
|
|
2
|
map { $self->_pushLine; $self->_pushDesc('code', $_) } @code; |
|
4
|
|
|
|
|
5
|
|
|
4
|
|
|
|
|
5
|
|
426
|
1
|
|
|
|
|
3
|
$self->_popLevel |
427
|
|
|
|
|
|
|
} |
428
|
|
|
|
|
|
|
} elsif ((! $reftype) |
429
|
|
|
|
|
|
|
|| |
430
|
|
|
|
|
|
|
( |
431
|
|
|
|
|
|
|
$reftype ne 'ARRAY' && |
432
|
|
|
|
|
|
|
$reftype ne 'HASH' && |
433
|
|
|
|
|
|
|
$reftype ne 'SCALAR' && |
434
|
|
|
|
|
|
|
$reftype ne 'REF' |
435
|
|
|
|
|
|
|
) |
436
|
|
|
|
|
|
|
) { |
437
|
|
|
|
|
|
|
# |
438
|
|
|
|
|
|
|
# Stringify if possible everything that we do not unfold |
439
|
|
|
|
|
|
|
# |
440
|
|
|
|
|
|
|
CODE_fallback: |
441
|
22
|
100
|
|
|
|
23
|
if (defined($item)) { |
442
|
21
|
|
|
|
|
11
|
my $string = eval { "$item" }; ## no critic qw/BuiltinFunctions::ProhibitStringyEval/ |
|
21
|
|
|
|
|
21
|
|
443
|
21
|
50
|
|
|
|
18
|
if (defined($string)) { |
444
|
21
|
50
|
|
|
|
43
|
$self->_pushDesc($reftype eq 'REGEXP' ? 'regexp' : |
|
|
100
|
|
|
|
|
|
445
|
|
|
|
|
|
|
$reftype eq 'CODE' ? 'code' : |
446
|
|
|
|
|
|
|
'string', $string) |
447
|
|
|
|
|
|
|
} else { |
448
|
0
|
|
|
|
|
0
|
$self->_pushDesc('unknown', $self->unknown) |
449
|
|
|
|
|
|
|
} |
450
|
|
|
|
|
|
|
} else { |
451
|
1
|
|
|
|
|
4
|
$self->_pushDesc('undef', $self->undef) |
452
|
|
|
|
|
|
|
} |
453
|
|
|
|
|
|
|
} |
454
|
|
|
|
|
|
|
# |
455
|
|
|
|
|
|
|
# Show address ? |
456
|
|
|
|
|
|
|
# |
457
|
33
|
50
|
66
|
|
|
66
|
if ($refaddr && $self->with_address) { |
458
|
0
|
|
|
|
|
0
|
my $address_format = $self->address_format; |
459
|
0
|
|
|
|
|
0
|
$self->_pushDesc('address_start', $self->address_start); |
460
|
0
|
0
|
|
|
|
0
|
$self->_pushDesc('address_value', length($address_format) ? sprintf($address_format, $refaddr) : $refaddr); |
461
|
0
|
|
|
|
|
0
|
$self->_pushDesc('address_end', $self->address_end) |
462
|
|
|
|
|
|
|
} |
463
|
|
|
|
|
|
|
} |
464
|
|
|
|
|
|
|
# |
465
|
|
|
|
|
|
|
# Eventually increase indice number |
466
|
|
|
|
|
|
|
# |
467
|
|
|
|
|
|
|
# |
468
|
|
|
|
|
|
|
# Prepare return value |
469
|
|
|
|
|
|
|
# |
470
|
35
|
|
|
|
|
27
|
my ($rc, $max_depth); |
471
|
|
|
|
|
|
|
# |
472
|
|
|
|
|
|
|
# Max depth option value ? |
473
|
|
|
|
|
|
|
# |
474
|
35
|
50
|
33
|
|
|
69
|
if (! ($max_depth = $self->max_depth) || ($currentLevel < $max_depth)) { |
475
|
|
|
|
|
|
|
# |
476
|
|
|
|
|
|
|
# Unfold if not already done and if this can be unfolded |
477
|
|
|
|
|
|
|
# |
478
|
35
|
100
|
|
|
|
42
|
if (! $alreadyScanned) { |
479
|
33
|
100
|
|
|
|
37
|
if ($reftype) { |
480
|
12
|
100
|
|
|
|
24
|
if ($reftype eq 'ARRAY') { |
|
|
100
|
|
|
|
|
|
|
|
100
|
|
|
|
|
|
|
|
100
|
|
|
|
|
|
481
|
3
|
|
|
|
|
2
|
$rc = $item |
482
|
|
|
|
|
|
|
} elsif ($reftype eq 'HASH') { |
483
|
5
|
|
50
|
|
|
6
|
$rc = [ map { $_ => $item->{$_} } sort { ($a // '') cmp ($b // '') } keys %{$item} ] |
|
13
|
|
50
|
|
|
16
|
|
|
26
|
|
|
|
|
44
|
|
|
5
|
|
|
|
|
17
|
|
484
|
|
|
|
|
|
|
} elsif ($reftype eq 'SCALAR') { |
485
|
1
|
|
|
|
|
1
|
$rc = [ ${$item} ] |
|
1
|
|
|
|
|
2
|
|
486
|
|
|
|
|
|
|
} elsif ($reftype eq 'REF') { |
487
|
1
|
|
|
|
|
2
|
$rc = [ ${$item} ] |
|
1
|
|
|
|
|
2
|
|
488
|
|
|
|
|
|
|
} |
489
|
|
|
|
|
|
|
} |
490
|
33
|
50
|
66
|
|
|
67
|
if ($blessed && $self->with_methods) { |
491
|
0
|
|
0
|
|
|
0
|
$rc //= []; |
492
|
0
|
|
|
|
|
0
|
my $expanded = Class::Inspector->methods($blessed, 'expanded'); |
493
|
0
|
0
|
0
|
|
|
0
|
if (defined($expanded) && reftype($expanded) eq 'ARRAY') { |
494
|
0
|
|
|
|
|
0
|
my @expanded = @{$expanded}; |
|
0
|
|
|
|
|
0
|
|
495
|
|
|
|
|
|
|
my %public_methods = |
496
|
0
|
|
|
|
|
0
|
map { $_->[$ARRAY_START_INDICE_PLUS_2] => $_->[$ARRAY_START_INDICE_PLUS_3] } |
497
|
0
|
|
|
|
|
0
|
grep { $_->[$ARRAY_START_INDICE_PLUS_2] !~ /^\_/ } |
498
|
0
|
|
|
|
|
0
|
grep { $_->[$ARRAY_START_INDICE_PLUS_1] eq $blessed } |
|
0
|
|
|
|
|
0
|
|
499
|
|
|
|
|
|
|
@expanded; |
500
|
|
|
|
|
|
|
my %private_methods = |
501
|
0
|
|
|
|
|
0
|
map { $_->[$ARRAY_START_INDICE_PLUS_2] => $_->[$ARRAY_START_INDICE_PLUS_3] } |
502
|
0
|
|
|
|
|
0
|
grep { $_->[$ARRAY_START_INDICE_PLUS_2] =~ /^\_/ } |
503
|
0
|
|
|
|
|
0
|
grep { $_->[$ARRAY_START_INDICE_PLUS_1] eq $blessed } |
|
0
|
|
|
|
|
0
|
|
504
|
|
|
|
|
|
|
@expanded; |
505
|
|
|
|
|
|
|
my %inherited_methods = |
506
|
0
|
|
|
|
|
0
|
map { $_->[$ARRAY_START_INDICE_PLUS_2] => $_->[$ARRAY_START_INDICE_PLUS_3] } |
507
|
0
|
|
|
|
|
0
|
grep { $_->[$ARRAY_START_INDICE_PLUS_1] ne $blessed } @expanded; |
|
0
|
|
|
|
|
0
|
|
508
|
0
|
|
|
|
|
0
|
push(@{$rc}, { |
|
0
|
|
|
|
|
0
|
|
509
|
|
|
|
|
|
|
public_methods => \%public_methods, |
510
|
|
|
|
|
|
|
private_methods => \%private_methods, |
511
|
|
|
|
|
|
|
inherited_methods => \%inherited_methods |
512
|
|
|
|
|
|
|
} |
513
|
|
|
|
|
|
|
) |
514
|
|
|
|
|
|
|
} |
515
|
0
|
0
|
|
|
|
0
|
if ($self->with_filename) { |
516
|
0
|
0
|
|
|
|
0
|
if (Class::Inspector->loaded($blessed)) { |
517
|
0
|
|
|
|
|
0
|
push(@{$rc}, { filename => Class::Inspector->loaded_filename($blessed) }) |
|
0
|
|
|
|
|
0
|
|
518
|
|
|
|
|
|
|
} else { |
519
|
0
|
|
|
|
|
0
|
push(@{$rc}, { filename => Class::Inspector->resolved_filename($blessed) }) |
|
0
|
|
|
|
|
0
|
|
520
|
|
|
|
|
|
|
} |
521
|
|
|
|
|
|
|
} |
522
|
|
|
|
|
|
|
} |
523
|
|
|
|
|
|
|
} |
524
|
|
|
|
|
|
|
} |
525
|
|
|
|
|
|
|
|
526
|
35
|
50
|
|
|
|
75
|
$self->_print unless $self->buffered; |
527
|
35
|
|
|
|
|
773
|
return $rc |
528
|
|
|
|
|
|
|
} |
529
|
|
|
|
|
|
|
# |
530
|
|
|
|
|
|
|
# Internal methods |
531
|
|
|
|
|
|
|
# |
532
|
|
|
|
|
|
|
sub _pushLevel { |
533
|
11
|
|
|
11
|
|
10
|
my ($self, $reftype) = @_; |
534
|
|
|
|
|
|
|
|
535
|
11
|
|
|
|
|
9
|
push(@{$self->{_currentReftypePerLevel}}, $reftype); |
|
11
|
|
|
|
|
12
|
|
536
|
11
|
|
|
|
|
8
|
push(@{$self->{_currentIndicePerLevel}}, $ARRAY_START_INDICE_MINUS_1); # dsread() will increase it at every item |
|
11
|
|
|
|
|
11
|
|
537
|
|
|
|
|
|
|
return ++$self->{_currentLevel} |
538
|
11
|
|
|
|
|
10
|
} |
539
|
|
|
|
|
|
|
|
540
|
|
|
|
|
|
|
sub _popLevel { |
541
|
11
|
|
|
11
|
|
9
|
my ($self) = @_; |
542
|
|
|
|
|
|
|
|
543
|
11
|
|
|
|
|
8
|
pop(@{$self->{_currentReftypePerLevel}}); |
|
11
|
|
|
|
|
8
|
|
544
|
11
|
|
|
|
|
9
|
pop(@{$self->{_currentIndicePerLevel}}); |
|
11
|
|
|
|
|
11
|
|
545
|
|
|
|
|
|
|
return --$self->{_currentLevel} |
546
|
11
|
|
|
|
|
23
|
} |
547
|
|
|
|
|
|
|
|
548
|
|
|
|
|
|
|
sub _pushLine { |
549
|
31
|
|
|
31
|
|
24
|
my ($self) = @_; |
550
|
|
|
|
|
|
|
|
551
|
31
|
|
|
|
|
18
|
return push(@{$self->{_lines}}, [ $self->indent x $self->{_currentLevel} ]); |
|
31
|
|
|
|
|
81
|
|
552
|
|
|
|
|
|
|
} |
553
|
|
|
|
|
|
|
|
554
|
|
|
|
|
|
|
sub _pushDesc { |
555
|
175
|
|
|
175
|
|
147
|
my ($self, $what, $desc) = @_; |
556
|
|
|
|
|
|
|
|
557
|
175
|
100
|
100
|
|
|
280
|
if ($what eq 'string' && ! looks_like_number($desc)) { |
558
|
|
|
|
|
|
|
# |
559
|
|
|
|
|
|
|
# Detect any non ANSI character and enclose result within "" |
560
|
|
|
|
|
|
|
# |
561
|
19
|
|
|
|
|
33
|
$desc =~ s/$_NON_ASCII_PRINT_RE/sprintf('\\x{%x}', ord(${^MATCH}))/egpo; |
|
0
|
|
|
|
|
0
|
|
562
|
19
|
|
|
|
|
41
|
$desc = "\"$desc\"" |
563
|
|
|
|
|
|
|
} |
564
|
175
|
50
|
|
|
|
229
|
if ($self->with_ansicolor) { |
565
|
|
|
|
|
|
|
# |
566
|
|
|
|
|
|
|
# We know that _colors_cache is a HashRef, and that _lines is an ArrayRef |
567
|
|
|
|
|
|
|
# |
568
|
175
|
|
|
|
|
142
|
my $color_cache = $self->{_colors_cache}->{$what}; # Handled below if it does not exist or its value is undef |
569
|
175
|
100
|
|
|
|
279
|
$desc = $color_cache . $desc . "\e[0m" if (defined($color_cache)) |
570
|
|
|
|
|
|
|
} |
571
|
175
|
|
|
|
|
95
|
push(@{$self->{_lines}->[-1]}, $desc); |
|
175
|
|
|
|
|
206
|
|
572
|
|
|
|
|
|
|
|
573
|
|
|
|
|
|
|
return |
574
|
175
|
|
|
|
|
155
|
} |
575
|
|
|
|
|
|
|
|
576
|
|
|
|
|
|
|
sub _canColor { |
577
|
1
|
|
|
1
|
|
1
|
my ($class) = @_; |
578
|
|
|
|
|
|
|
# |
579
|
|
|
|
|
|
|
# Mimic Data::Printer use of $ENV{ANSI_COLORS_DISABLED} |
580
|
|
|
|
|
|
|
# |
581
|
1
|
50
|
|
|
|
4
|
return 0 if exists($ENV{ANSI_COLORS_DISABLED}); |
582
|
|
|
|
|
|
|
# |
583
|
|
|
|
|
|
|
# Add the support of ANSI_COLORS_ENABLED |
584
|
|
|
|
|
|
|
# |
585
|
1
|
50
|
|
|
|
2
|
return 1 if exists($ENV{ANSI_COLORS_ENABLED}); |
586
|
|
|
|
|
|
|
# |
587
|
|
|
|
|
|
|
# that has precedence on the Windows check, returning 0 if we did not load Win32::Console::ANSI |
588
|
|
|
|
|
|
|
# |
589
|
1
|
50
|
33
|
|
|
4
|
return 0 if (is_os_type('Windows') && ! $_HAVE_Win32__Console__ANSI); |
590
|
1
|
|
|
|
|
27
|
return 1 |
591
|
|
|
|
|
|
|
} |
592
|
|
|
|
|
|
|
|
593
|
|
|
|
|
|
|
|
594
|
|
|
|
|
|
|
with 'Data::Scan::Role::Consumer'; |
595
|
|
|
|
|
|
|
|
596
|
|
|
|
|
|
|
1; |
597
|
|
|
|
|
|
|
|
598
|
|
|
|
|
|
|
__END__ |