File Coverage

blib/lib/Data/Dump/Partial.pm
Criterion Covered Total %
statement 98 99 98.9
branch 52 54 96.3
condition 46 50 92.0
subroutine 8 9 88.8
pod 2 2 100.0
total 206 214 96.2


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__