line |
stmt |
bran |
cond |
sub |
pod |
time |
code |
1
|
|
|
|
|
|
|
package Data::Dump::Partial; |
2
|
|
|
|
|
|
|
|
3
|
1
|
|
|
1
|
|
22165
|
use 5.010001; |
|
1
|
|
|
|
|
4
|
|
|
1
|
|
|
|
|
41
|
|
4
|
1
|
|
|
1
|
|
6
|
use strict; |
|
1
|
|
|
|
|
3
|
|
|
1
|
|
|
|
|
35
|
|
5
|
1
|
|
|
1
|
|
5
|
use warnings; |
|
1
|
|
|
|
|
2
|
|
|
1
|
|
|
|
|
37
|
|
6
|
1
|
|
|
1
|
|
840
|
use experimental 'smartmatch'; |
|
1
|
|
|
|
|
879
|
|
|
1
|
|
|
|
|
5
|
|
7
|
1
|
|
|
1
|
|
895
|
use Data::Dump::Filtered; |
|
1
|
|
|
|
|
10707
|
|
|
1
|
|
|
|
|
1409
|
|
8
|
|
|
|
|
|
|
|
9
|
|
|
|
|
|
|
require Exporter; |
10
|
|
|
|
|
|
|
our @ISA = qw(Exporter); |
11
|
|
|
|
|
|
|
our @EXPORT_OK = qw(dump_partial dumpp); |
12
|
|
|
|
|
|
|
|
13
|
|
|
|
|
|
|
our $VERSION = '0.05'; # VERSION |
14
|
|
|
|
|
|
|
|
15
|
0
|
|
|
0
|
|
0
|
sub _dmp { Data::Dump::Filtered::dump_filtered(@_, undef) } |
16
|
|
|
|
|
|
|
|
17
|
|
|
|
|
|
|
sub dump_partial { |
18
|
55
|
|
|
55
|
1
|
128
|
my @data = @_; |
19
|
55
|
50
|
66
|
|
|
284
|
die 'Usage: dump_partial(@data, \%opts)' |
20
|
|
|
|
|
|
|
if @data > 1 && ref($data[-1]) ne 'HASH'; |
21
|
55
|
100
|
|
|
|
122
|
my $opts = (@data > 1) ? {%{pop(@data)}} : {}; |
|
43
|
|
|
|
|
196
|
|
22
|
|
|
|
|
|
|
|
23
|
55
|
|
100
|
|
|
205
|
$opts->{max_keys} //= 5; |
24
|
55
|
|
100
|
|
|
174
|
$opts->{max_elems} //= 5; |
25
|
55
|
|
100
|
|
|
159
|
$opts->{max_len} //= 32; |
26
|
55
|
|
100
|
|
|
154
|
$opts->{max_total_len} //= 80; |
27
|
|
|
|
|
|
|
|
28
|
1
|
|
|
|
|
3
|
$opts->{max_keys} = @{$opts->{precious_keys}} if $opts->{precious_keys} && |
|
6
|
|
|
|
|
28
|
|
29
|
55
|
100
|
100
|
|
|
152
|
@{ $opts->{precious_keys} } > $opts->{max_keys}; |
30
|
|
|
|
|
|
|
|
31
|
55
|
|
|
|
|
59
|
my $out; |
32
|
|
|
|
|
|
|
|
33
|
55
|
100
|
|
|
|
109
|
if ($opts->{_inner}) { |
34
|
|
|
|
|
|
|
#print "DEBUG: inner dump, data="._dmp(@data)."\n"; |
35
|
23
|
|
|
|
|
561
|
$out = Data::Dump::dump(@data); |
36
|
|
|
|
|
|
|
} else { |
37
|
|
|
|
|
|
|
#print "DEBUG: outer dump, data="._dmp(@data)."\n"; |
38
|
|
|
|
|
|
|
my $filter = sub { |
39
|
154
|
|
|
154
|
|
11482
|
my ($ctx, $oref) = @_; |
40
|
|
|
|
|
|
|
|
41
|
|
|
|
|
|
|
# to avoid deep recursion (dump_partial keeps modifying the hash due |
42
|
|
|
|
|
|
|
# to pair_filter or mask_keys_regex) |
43
|
154
|
|
|
|
|
178
|
my $skip_modify_outermost_hash; |
44
|
154
|
100
|
|
|
|
388
|
if ($opts->{_skip_modify_outermost_hash}) { |
45
|
|
|
|
|
|
|
#print "DEBUG: Will skip modify outermost hash\n"; |
46
|
17
|
|
|
|
|
23
|
$skip_modify_outermost_hash++; |
47
|
17
|
|
|
|
|
31
|
$opts->{_skip_modify_outermost_hash}--; |
48
|
|
|
|
|
|
|
} |
49
|
|
|
|
|
|
|
|
50
|
154
|
100
|
100
|
|
|
646
|
if ($opts->{max_len} && $ctx->is_scalar && defined($$oref) && |
|
|
100
|
66
|
|
|
|
|
|
|
100
|
100
|
|
|
|
|
|
|
|
100
|
|
|
|
|
|
|
|
100
|
|
|
|
|
51
|
|
|
|
|
|
|
length($$oref) > $opts->{max_len}) { |
52
|
|
|
|
|
|
|
|
53
|
|
|
|
|
|
|
#print "DEBUG: truncating scalar\n"; |
54
|
4
|
|
|
|
|
63
|
return { object => substr($$oref, 0, $opts->{max_len}-3)."..." }; |
55
|
|
|
|
|
|
|
|
56
|
|
|
|
|
|
|
} elsif ($opts->{max_elems} && $ctx->is_array && |
57
|
|
|
|
|
|
|
@$oref > $opts->{max_elems}) { |
58
|
|
|
|
|
|
|
|
59
|
|
|
|
|
|
|
#print "DEBUG: truncating array\n"; |
60
|
6
|
|
|
|
|
156
|
my @ary = @{$oref}[0..($opts->{max_elems}-1)]; |
|
6
|
|
|
|
|
21
|
|
61
|
6
|
|
|
|
|
17
|
local $opts->{_inner} = 1; |
62
|
6
|
|
|
|
|
12
|
local $opts->{max_total_len} = 0; |
63
|
6
|
|
|
|
|
18
|
my $out = dump_partial(\@ary, $opts); |
64
|
6
|
|
|
|
|
38
|
$out =~ s/(?:, )?]$/, ...]/; |
65
|
6
|
|
|
|
|
38
|
return { dump => $out }; |
66
|
|
|
|
|
|
|
|
67
|
|
|
|
|
|
|
} elsif ($ctx->is_hash) { |
68
|
|
|
|
|
|
|
|
69
|
38
|
|
|
|
|
893
|
my %hash; |
70
|
|
|
|
|
|
|
my $modified; |
71
|
|
|
|
|
|
|
|
72
|
38
|
100
|
100
|
|
|
176
|
if ($opts->{pair_filter} && !$skip_modify_outermost_hash) { |
73
|
5
|
|
|
|
|
25
|
for (sort keys %$oref) { |
74
|
11
|
|
|
|
|
36
|
my @res = $opts->{pair_filter}->($_, $oref->{$_}); |
75
|
11
|
100
|
66
|
|
|
173
|
$modified = "pair_filter" unless @res == 2 && |
|
|
|
100
|
|
|
|
|
76
|
|
|
|
|
|
|
$res[0] eq $_ && "$res[1]" eq "$oref->{$_}"; |
77
|
11
|
|
|
|
|
43
|
while (my ($k, $v) = splice @res, 0, 2) { |
78
|
11
|
|
|
|
|
58
|
$hash{$k} = $v; |
79
|
|
|
|
|
|
|
} |
80
|
|
|
|
|
|
|
} |
81
|
|
|
|
|
|
|
} else { |
82
|
33
|
|
|
|
|
166
|
%hash = %$oref; |
83
|
|
|
|
|
|
|
} |
84
|
|
|
|
|
|
|
|
85
|
38
|
100
|
100
|
|
|
128
|
if ($opts->{mask_keys_regex} && !$skip_modify_outermost_hash) { |
86
|
3
|
|
|
|
|
13
|
for (sort keys %hash) { |
87
|
7
|
100
|
|
|
|
38
|
if (/$opts->{mask_keys_regex}/) { |
88
|
3
|
|
|
|
|
6
|
$modified = "mask_keys_regex"; |
89
|
3
|
|
|
|
|
8
|
$hash{$_} = '***'; |
90
|
|
|
|
|
|
|
} |
91
|
|
|
|
|
|
|
} |
92
|
|
|
|
|
|
|
} |
93
|
|
|
|
|
|
|
|
94
|
38
|
|
|
|
|
45
|
my $truncated; |
95
|
38
|
100
|
100
|
|
|
194
|
if ($opts->{max_keys} && keys(%$oref) > $opts->{max_keys}) { |
96
|
9
|
|
|
|
|
17
|
my $mk = $opts->{max_keys}; |
97
|
|
|
|
|
|
|
{ |
98
|
9
|
100
|
|
|
|
15
|
if ($opts->{hide_keys}) { |
|
9
|
|
|
|
|
22
|
|
99
|
1
|
|
|
|
|
6
|
for (sort keys %hash) { |
100
|
6
|
100
|
|
|
|
8
|
delete $hash{$_} if $_ ~~ @{$opts->{hide_keys}}; |
|
6
|
|
|
|
|
28
|
|
101
|
|
|
|
|
|
|
} |
102
|
|
|
|
|
|
|
} |
103
|
9
|
100
|
|
|
|
25
|
last if keys(%hash) <= $mk; |
104
|
8
|
100
|
|
|
|
19
|
if ($opts->{worthless_keys}) { |
105
|
1
|
|
|
|
|
7
|
for (sort keys %hash) { |
106
|
6
|
100
|
|
|
|
16
|
last if keys(%hash) <= $mk; |
107
|
5
|
100
|
|
|
|
42
|
delete $hash{$_} if $_ ~~ @{$opts->{worthless_keys}}; |
|
5
|
|
|
|
|
35
|
|
108
|
|
|
|
|
|
|
} |
109
|
|
|
|
|
|
|
} |
110
|
8
|
100
|
|
|
|
20
|
last if keys(%hash) <= $mk; |
111
|
7
|
|
|
|
|
40
|
for (reverse sort keys %hash) { |
112
|
11
|
|
|
|
|
45
|
delete $hash{$_} if !$opts->{precious_keys} || |
113
|
20
|
100
|
66
|
|
|
62
|
!($_ ~~ @{$opts->{precious_keys}}); |
114
|
20
|
100
|
|
|
|
57
|
last if keys(%hash) <= $mk; |
115
|
|
|
|
|
|
|
} |
116
|
|
|
|
|
|
|
} |
117
|
9
|
|
|
|
|
17
|
$modified = "truncate"; |
118
|
9
|
|
|
|
|
15
|
$truncated++; |
119
|
|
|
|
|
|
|
} |
120
|
|
|
|
|
|
|
|
121
|
38
|
100
|
|
|
|
109
|
if ($modified) { |
122
|
|
|
|
|
|
|
#print "DEBUG: modified hash ($modified)\n"; |
123
|
17
|
|
|
|
|
38
|
local $opts->{_inner} = 1; |
124
|
17
|
|
|
|
|
31
|
local $opts->{_skip_modify_outermost_hash} = 1; |
125
|
17
|
|
|
|
|
33
|
local $opts->{max_total_len} = 0; |
126
|
17
|
|
|
|
|
45
|
my $out = dump_partial(\%hash, $opts); |
127
|
17
|
100
|
|
|
|
83
|
$out =~ s/(?:, )? }$/, ... }/ if $truncated; |
128
|
17
|
|
|
|
|
124
|
return { dump => $out }; |
129
|
|
|
|
|
|
|
} |
130
|
|
|
|
|
|
|
} |
131
|
|
|
|
|
|
|
|
132
|
127
|
100
|
|
|
|
2894
|
if ($opts->{dd_filter}) { |
133
|
1
|
|
|
|
|
3
|
return $opts->{dd_filter}->($ctx, $oref); |
134
|
|
|
|
|
|
|
} else { |
135
|
126
|
|
|
|
|
354
|
return; |
136
|
|
|
|
|
|
|
} |
137
|
32
|
|
|
|
|
200
|
}; |
138
|
32
|
|
|
|
|
106
|
$out = Data::Dump::Filtered::dump_filtered(@data, $filter); |
139
|
|
|
|
|
|
|
} |
140
|
|
|
|
|
|
|
|
141
|
55
|
|
|
|
|
5999
|
for ($out) { |
142
|
55
|
|
|
|
|
104
|
s/^\s*#.*//mg; # comments |
143
|
55
|
|
|
|
|
122
|
s/^\s+//mg; # indents |
144
|
55
|
|
|
|
|
150
|
s/\n+/ /g; # newlines |
145
|
|
|
|
|
|
|
} |
146
|
|
|
|
|
|
|
|
147
|
55
|
100
|
100
|
|
|
282
|
if ($opts->{max_total_len} && length($out) > $opts->{max_total_len}) { |
148
|
1
|
|
|
|
|
4
|
$out = substr($out, 0, $opts->{max_total_len}-3) . "..."; |
149
|
|
|
|
|
|
|
} |
150
|
|
|
|
|
|
|
|
151
|
55
|
50
|
|
|
|
120
|
print STDERR "$out\n" unless defined wantarray; |
152
|
55
|
|
|
|
|
310
|
$out; |
153
|
|
|
|
|
|
|
} |
154
|
|
|
|
|
|
|
|
155
|
31
|
|
|
31
|
1
|
103
|
sub dumpp { dump_partial(@_) } |
156
|
|
|
|
|
|
|
|
157
|
|
|
|
|
|
|
1; |
158
|
|
|
|
|
|
|
# ABSTRACT: Dump data structure compactly and potentially partially |
159
|
|
|
|
|
|
|
|
160
|
|
|
|
|
|
|
__END__ |