File Coverage

blib/lib/Data/Printer/Common.pm
Criterion Covered Total %
statement 1782 1782 100.0
branch 76 106 71.7
condition 15 29 51.7
subroutine 594 594 100.0
pod 0 2 0.0
total 2467 2513 98.1


line stmt bran cond sub pod time code
1             package Data::Printer::Common;
2             # Private library of shared Data::Printer code.
3 48     48   170119 use strict;
  48         111  
  48         1073  
4 48     48   227 use warnings;
  48         80  
  48         871  
5 48     48   234 use Scalar::Util;
  48         92  
  48         52403  
6              
7             my $mro_initialized = 0;
8             my $nsort_initialized;
9              
10              
11             sub _filter_category_for {
12 449     449   756 my ($name) = @_;
13 449         801 my %core_types = map { $_ => 1 }
  4409         7219  
14             qw(SCALAR LVALUE ARRAY HASH REF VSTRING GLOB FORMAT Regexp CODE);
15 449 100       2117 return exists $core_types{$name} ? 'type_filters' : 'class_filters';
16             }
17              
18             # strings are tough to process: there are control characters like "\t",
19             # unicode characters to name or escape (or do nothing), max_string to
20             # worry about, and every single piece of that could have its own color.
21             # That, and hash keys and strings share this. So we put it all in one place.
22             sub _process_string {
23 230     230   799 my ($ddp, $string, $src_color) = @_;
24              
25             # colorizing messes with reduce_string because we are effectively
26             # adding new (invisible) characters to the string. So we need to
27             # handle reduction first. But! Because we colorize string_max
28             # *and* we should escape any colors already present, we need to
29             # do both at the same time.
30 230         692 $string = _reduce_string($ddp, $string, $src_color);
31              
32             # now we escape all other control characters except for "\e", which was
33             # already escaped in _reduce_string(), and convert any chosen charset
34             # to the \x{} format. These could go in any particular order:
35 230         597 $string = _escape_chars($ddp, $string, $src_color);
36 230         570 $string = _print_escapes($ddp, $string, $src_color);
37              
38             # finally, send our wrapped string:
39 230         775 return $ddp->maybe_colorize($string, $src_color);
40             }
41              
42             sub _colorstrip {
43 155     155   276 my ($string) = @_;
44 155         240 $string =~ s{ \e\[ [\d;]* m }{}xmsg;
45 155         346 return $string;
46             }
47              
48             sub _reduce_string {
49 230     230   486 my ($ddp, $string, $src_color) = @_;
50 230         539 my $max = $ddp->string_max;
51 230         567 my $str_len = length($string);
52 230 100 66     1174 if ($max && $str_len && $str_len > $max) {
      100        
53 14         39 my $preserve = $ddp->string_preserve;
54 14 100       142 my $skipped_chars = $str_len - ($preserve eq 'none' ? 0 : $max);
55 14         83 my $skip_message = $ddp->maybe_colorize(
56             $ddp->string_overflow,
57             'caller_info',
58             undef,
59             $src_color
60             );
61 14         49 $skip_message =~ s/__SKIPPED__/$skipped_chars/g;
62 14 100       155 if ($preserve eq 'end') {
    100          
    100          
    100          
63 10         55 substr $string, 0, $skipped_chars, '';
64 10 50       23 $string =~ s{\e}{$ddp->maybe_colorize('\\e', 'escaped', undef, $src_color)}ge
  9         119  
65             if $ddp->print_escapes;
66 10         58 $string = $skip_message . $string;
67             }
68             elsif ($preserve eq 'begin') {
69 10         22 $string = substr($string, 0, $max);
70 10 50       139 $string =~ s{\e}{$ddp->maybe_colorize('\\e', 'escaped', undef, $src_color)}ge
  9         51  
71             if $ddp->print_escapes;
72 10         25 $string = $string . $skip_message;
73             }
74             elsif ($preserve eq 'extremes') {
75 10         112 my $leftside_chars = int($max / 2);
76 10         64 my $rightside_chars = $max - $leftside_chars;
77 10         25 my $leftside = substr($string, 0, $leftside_chars);
78 10         105 my $rightside = substr($string, -$rightside_chars);
79 10 50       62 if ($ddp->print_escapes) {
80 9         16 $leftside =~ s{\e}{$ddp->maybe_colorize('\\e', 'escaped', undef, $src_color)}ge;
  9         121  
81 8         52 $rightside =~ s{\e}{$ddp->maybe_colorize('\\e', 'escaped', undef, $src_color)}ge;
  8         22  
82             }
83 9         112 $string = $leftside . $skip_message . $rightside;
84             }
85             elsif ($preserve eq 'middle') {
86 9         49 my $string_middle = int($str_len / 2);
87 9         20 my $middle_substr = int($max / 2);
88 9         106 my $substr_begin = $string_middle - $middle_substr;
89 9         48 my $message_begin = $ddp->string_overflow;
90 9         19 $message_begin =~ s/__SKIPPED__/$substr_begin/gs;
91 9         109 my $chars_left = $str_len - ($substr_begin + $max);
92 9         48 my $message_end = $ddp->string_overflow;
93 9         25 $message_end =~ s/__SKIPPED__/$chars_left/gs;
94 9         95 $string = substr($string, $substr_begin, $max);
95 9 50       74 $string =~ s{\e}{$ddp->maybe_colorize('\\e', 'escaped', undef, $src_color)}ge
  8         15  
96             if $ddp->print_escapes;
97 9         113 $string = $ddp->maybe_colorize($message_begin, 'caller_info', undef, $src_color)
98             . $string
99             . $ddp->maybe_colorize($message_end, 'caller_info', undef, $src_color)
100             ;
101             }
102             else {
103             # preserving 'none' only shows the skipped message:
104 9         59 $string = $skip_message;
105             }
106             }
107             else {
108             # nothing to do? ok, then escape any colors already present:
109 224 100       579 $string =~ s{\e}{$ddp->maybe_colorize('\\e', 'escaped', undef, $src_color)}ge
  9         114  
110             if $ddp->print_escapes;
111             }
112 229         574 return $string;
113             }
114              
115              
116             # _escape_chars() replaces characters with their "escaped" versions.
117             # Because it may be called on scalars or (scalar) hash keys and they
118             # have different colors, we need to be aware of that.
119             sub _escape_chars {
120 229     230   419 my ($ddp, $scalar, $src_color) = @_;
121              
122 229         625 my $escape_kind = $ddp->escape_chars;
123 229         745 my %target_for = (
124             nonascii => '[^\x{00}-\x{7f}]+',
125             nonlatin1 => '[^\x{00}-\x{ff}]+',
126             );
127              
128 229 100       510 if ($ddp->unicode_charnames) {
    100          
129 11         922 require charnames;
130 11 100       29271 if ($escape_kind eq 'all') {
131 9         23 $scalar = join('', map { sprintf '\N{%s}', charnames::viacode(ord $_) } split //, $scalar);
  12         415  
132 9         129 $scalar = $ddp->maybe_colorize($scalar, 'escaped');
133             }
134             else {
135 10 50       89 $scalar =~ s{($target_for{$escape_kind})}{$ddp->maybe_colorize( (join '', map { sprintf '\N{%s}', charnames::viacode(ord $_) } split //, $1), 'escaped', undef, $src_color)}ge if exists $target_for{$escape_kind};
  14         145  
  17         421  
136             }
137             }
138             elsif ($escape_kind eq 'all') {
139 9         23 $scalar = join('', map { sprintf '\x{%02x}', ord $_ } split //, $scalar);
  45         166  
140 9         55 $scalar = $ddp->maybe_colorize($scalar, 'escaped');
141             }
142             else {
143 225 100       561 $scalar =~ s{($target_for{$escape_kind})}{$ddp->maybe_colorize((join '', map { sprintf '\x{%02x}', ord $_ } split //, $1), 'escaped', undef, $src_color)}ge if exists $target_for{$escape_kind};
  14         122  
  17         95  
144             }
145 229         620 return $scalar;
146             }
147              
148             # _print_escapes() prints invisible chars if they exist on a string.
149             # Because it may be called on scalars or (scalar) hash keys and they
150             # have different colors, we need to be aware of that. Also, \e is
151             # deliberately omitted because it was escaped from the original
152             # string earlier, and the \e's we have now are our own colorized
153             # output.
154             sub _print_escapes {
155 229     230   517 my ($ddp, $string, $src_color) = @_;
156              
157             # always escape the null character
158 229         497 $string =~ s/\0/$ddp->maybe_colorize('\\0', 'escaped', undef, $src_color)/ge;
  10         27  
159              
160 229 100       606 return $string unless $ddp->print_escapes;
161              
162 9         55 my %escaped = (
163             "\n" => '\n', # line feed
164             "\r" => '\r', # carriage return
165             "\t" => '\t', # horizontal tab
166             "\f" => '\f', # formfeed
167             "\b" => '\b', # backspace
168             "\a" => '\a', # alert (bell)
169             );
170 9         21 foreach my $k ( keys %escaped ) {
171 14         136 $string =~ s/$k/$ddp->maybe_colorize($escaped{$k}, 'escaped', undef, $src_color)/ge;
  14         67  
172             }
173 9         24 return $string;
174             }
175              
176             sub _initialize_nsort {
177 21 50   22   259 return 'Sort::Key::Natural' if $INC{'Sort/Key/Natural.pm'};
178 21 50       115 return 'Sort::Naturally' if $INC{'Sort/Naturally.pm'};
179 21 50       44 return 'Sort::Key::Natural' if eval { require Sort::Key::Natural; 1; };
  21         2159  
  8         51  
180 21 50       92 return 'Sort::Naturally' if eval { require Sort::Naturally; 1; };
  21         1633  
  8         45  
181 21         79 return 'core';
182             }
183              
184             sub _nsort {
185 138 100   139   360 if (!$nsort_initialized) {
186 19         86 my $nsort_class = _initialize_nsort();
187 19 50       74 if ($nsort_class eq 'Sort::Key::Natural') {
    50          
188 8         90 $nsort_initialized = \&{ $nsort_class . '::natsort' };
  8         45  
189             }
190             elsif ($nsort_class ne 'core') {
191 8         17 $nsort_initialized = \&{ $nsort_class . '::nsort' };
  8         88  
192             }
193             else {
194 19         81 $nsort_initialized = \&_nsort_pp
195             }
196             }
197 138         289 return $nsort_initialized->(@_);
198             }
199              
200             # this is a very simple 'natural-ish' sorter, heavily inspired in
201             # http://www.perlmonks.org/?node_id=657130 by thundergnat and tye
202             sub _nsort_pp {
203 139     140   749 my $i;
204 139         518 my @unsorted = map lc, @_;
205 139         241 foreach my $data (@unsorted) {
206 48     48   361 no warnings 'uninitialized';
  48         91  
  48         51010  
207 425         1362 $data =~ s/((\.0*)?)(\d+)/("\x0" x length $2) . (pack 'aNa*', 0, length $3, $3)/eg;
  21         114  
208 425         781 $data .= ' ' . $i++;
209             }
210 139         460 return @_[ map { (split)[-1] } sort @unsorted ];
  424         1242  
211             }
212              
213             sub _fetch_arrayref_of_scalars {
214 7     9   10 my ($props, $name) = @_;
215 7 0 0     95 return [] unless exists $props->{$name} && ref $props->{$name} eq 'ARRAY';
216 7         38 my @valid;
217 7         14 foreach my $option (@{$props->{$name}}) {
  7         88  
218 7 0       49 if (ref $option) {
219             # FIXME: because there is no object at this point, we need to check
220             # the 'warnings' option ourselves.
221             _warn(undef, "'$name' option requires scalar values only. Ignoring $option.")
222 7 0 0     16 if !exists $props->{warnings} || !$props->{warnings};
223 7         129 next;
224             }
225 7         62 push @valid, $option;
226             }
227 7         14 return \@valid;
228             }
229              
230             sub _fetch_anyof {
231 2935     2937   4594 my ($props, $name, $default, $list) = @_;
232 2935 100       7704 return $default unless exists $props->{$name};
233 138         339 foreach my $option (@$list) {
234 304 100       999 return $option if $props->{$name} eq $option;
235             }
236             _die(
237 7         40 "invalid value '$props->{$name}' for option '$name'"
238             . "(must be one of: " . join(',', @$list) . ")"
239             );
240             };
241              
242              
243             sub _fetch_scalar_or_default {
244 11720     11722   17214 my ($props, $name, $default) = @_;
245 11720 100       31235 return $default unless exists $props->{$name};
246              
247 577 50       1366 if (my $ref = ref $props->{$name}) {
248 7         15 _die("'$name' property must be a scalar, not a reference to $ref");
249             }
250 577         1493 return $props->{$name};
251             }
252              
253             sub _die {
254 10     11   47 my ($message) = @_;
255 10         19 my ($file, $line) = _get_proper_caller();
256 10         105 die '[Data::Printer] ' . $message . " at $file line $line.\n";
257             }
258              
259             sub _warn {
260 8     9   122 my ($ddp, $message) = @_;
261 8 50 33     15 return if $ddp && !$ddp->warnings;
262 8         86 my ($file, $line) = _get_proper_caller();
263 8         52 warn '[Data::Printer] ' . $message . " at $file line $line.\n";
264             }
265              
266             sub _get_proper_caller {
267 11     12   22 my $frame = 1;
268 11         154 while (my @caller = caller($frame++)) {
269 14 100       85 if ($caller[0] !~ /\AD(?:DP|ata::Printer)/) {
270 11         35 return ($caller[1], $caller[2]);
271             }
272             }
273 7         100 return ('n/d', 'n/d');
274             }
275              
276              
277             # simple eval++ adapted from Try::Tiny.
278             # returns a (true) error message if failed.
279             sub _tryme {
280 3068     3069   23625 my ($subref_or_string) = @_;
281              
282 3068         3865 my $previous_error = $@;
283 3068         4159 my ($failed, $error);
284              
285 3068 100       6617 if (ref $subref_or_string eq 'CODE') {
286 329         564 $failed = not eval {
287 329         968 local $SIG{'__DIE__'}; # make sure we don't trigger any exception hooks.
288 327         518 $@ = $previous_error;
289 327         899 $subref_or_string->();
290 319         2634 return 1;
291             };
292 327         1018 $error = $@;
293             }
294             else {
295 2744         4046 my $code = q(local $SIG{'__DIE__'};) . $subref_or_string;
296 2744     39 0 177852 $failed = not eval $code;
  36     38 0 13303  
  34     38   13227  
  34     38   531  
  35     38   2998  
  35     38   315  
  35     38   633  
  35     38   1488  
  35     38   102  
  35     38   524  
  35     38   612  
  35     31   89  
  35     31   486  
  35     30   921  
  34     29   100  
  34     29   472  
  35     29   225  
  35     29   89  
  35     29   507  
  35     28   245  
  35     28   90  
  35     28   500  
  35     26   243  
  35     26   88  
  35     26   503  
  35     26   233  
  35     24   83  
  35     23   443  
  35     22   244  
  35     22   95  
  35     22   475  
  35     22   262  
  35     22   91  
  35     22   526  
  28     22   2711  
  28     22   79  
  28     22   389  
  28     22   214  
  28     22   76  
  28     22   340  
  28     22   946  
  27     22   10550  
  27     22   301  
  27     22   1100  
  27     20   2284  
  27     20   340  
  27     20   1904  
  27     20   73  
  27     19   300  
  27     19   209  
  27     19   84  
  27     19   312  
  27     19   194  
  27     19   74  
  27     19   348  
  27     16   207  
  27     16   66  
  27     16   318  
  26     16   181  
  26     16   62  
  26     16   278  
  26     16   1093  
  26     16   67  
  26     16   307  
  26     16   176  
  26     16   65  
  26     5   257  
  24     5   196  
  24     5   81  
  24     5   276  
  24     5   195  
  24     5   81  
  24     5   287  
  24     5   162  
  24     5   363  
  24     5   253  
  24     5   171  
  24     5   61  
  24     5   293  
  24     5   177  
  24     5   67  
  24     4   262  
  23     4   469  
  21     4   61  
  21     4   294  
  21     4   162  
  21     4   60  
  21     4   208  
  21     4   215  
  21     4   54  
  21     4   206  
  21     4   148  
  21     4   53  
  21     4   203  
  21     4   147  
  21     4   72  
  21     4   209  
  21     4   147  
  21     4   53  
  21     4   268  
  21     4   160  
  21     4   57  
  21     4   379  
  21     3   152  
  21     3   55  
  21     3   232  
  21     3   140  
  21     3   59  
  21     3   214  
  21     3   144  
  21     3   56  
  21     3   248  
  21     3   146  
  21     3   63  
  21     3   245  
  21     3   154  
  21     3   65  
  21     3   312  
  21     3   227  
  21     3   70  
  21     3   233  
  21     3   160  
  21     3   117  
  21     3   215  
  21     3   146  
  21     3   55  
  21     3   223  
  21     3   145  
  21     3   50  
  21     3   223  
  21     3   161  
  21     3   57  
  21     3   225  
  19     3   159  
  19     3   48  
  19     3   226  
  19     3   143  
  19     3   52  
  19     3   224  
  19     3   149  
  19     3   57  
  19     3   202  
  19     3   186  
  19     3   54  
  19     3   198  
  18     3   135  
  18     3   51  
  18     3   241  
  18     3   125  
  17     3   48  
  17     3   183  
  17     3   126  
  17     3   74  
  17     3   174  
  17     3   232  
  17     3   119  
  17     3   189  
  17     3   119  
  17     3   43  
  17     3   187  
  17     3   119  
  17     3   40  
  17     3   193  
  17     3   111  
  17     3   74  
  17     3   171  
  14     3   109  
  14     3   41  
  14     3   177  
  14     3   139  
  14     3   43  
  14     3   151  
  14     3   99  
  14     3   40  
  14     3   141  
  14     3   204  
  14     3   99  
  14     3   166  
  14     3   103  
  14     3   41  
  14     3   162  
  14     3   97  
  14     3   140  
  14     3   244  
  14     3   126  
  14     3   42  
  14     3   207  
  14     3   106  
  14     3   39  
  14     3   134  
  14     3   99  
  14     2   38  
  14     2   148  
  14     2   103  
  14     2   51  
  14     2   139  
  14     2   166  
  14     2   214  
  14     2   234  
  3     2   39  
  3     2   16  
  3     2   7  
  3     2   33  
  3     2   15  
  3     2   6  
  3     2   32  
  3     2   17  
  3     2   5  
  3     2   31  
  3     2   17  
  3     2   6  
  3     2   32  
  3     2   16  
  3     2   8  
  3     2   33  
  3     2   22  
  3     2   7  
  3     2   41  
  3     2   22  
  3     2   6  
  3     2   38  
  3     2   18  
  3     2   6  
  3     2   36  
  3     2   18  
  3     2   6  
  3     2   42  
  3     2   17  
  3     2   5  
  3     2   34  
  3     2   18  
  3     2   6  
  3     2   41  
  3     2   17  
  3     2   6  
  3     2   32  
  3     2   16  
  3     2   4  
  3     2   45  
  3     2   17  
  3     2   6  
  3     2   30  
  3     2   15  
  3     2   7  
  3     2   32  
  3     2   17  
  3     1   5  
  3     1   32  
  3     1   20  
  3     1   7  
  3     1   39  
  3     1   21  
  3     1   6  
  3     1   41  
  3     1   22  
  3     1   8  
  3     1   71  
  3     1   18  
  3     1   6  
  3     1   37  
  3     1   17  
  3     1   6  
  3     1   36  
  3     1   17  
  3     1   7  
  3     1   47  
  3     1   17  
  3     1   6  
  3     1   35  
  3     1   18  
  3     1   14  
  3     1   43  
  3     1   17  
  3     1   7  
  3     1   32  
  3     1   16  
  3     1   8  
  3     1   32  
  3     1   17  
  3     1   14  
  3     1   34  
  3     1   23  
  3     1   7  
  3     1   54  
  3     1   22  
  3     1   7  
  3     1   40  
  3     1   20  
  3     1   5  
  3     1   33  
  3     1   18  
  3     1   7  
  3     1   34  
  3     1   17  
  3     1   13  
  3     1   38  
  3     1   18  
  3     1   6  
  3     1   32  
  3     1   16  
  3     1   6  
  3     1   35  
  3     1   18  
  3     1   7  
  3     1   33  
  3     1   18  
  3     1   120  
  3     1   41  
  3     1   17  
  3     1   5  
  3     1   34  
  3     1   17  
  3     1   6  
  3     1   48  
  3     1   20  
  3     1   6  
  3     1   40  
  3     1   18  
  3     1   6  
  3     1   55  
  3     1   17  
  3     1   5  
  3     1   33  
  3     1   16  
  3     1   7  
  3     1   61  
  3     1   19  
  3     1   6  
  3     1   32  
  3     1   18  
  3     1   7  
  3     1   34  
  3     1   29  
  3     1   20  
  3     1   34  
  3     1   17  
  3     1   4  
  3     1   33  
  3     1   18  
  3     1   6  
  3     1   32  
  3     1   18  
  3     1   5  
  3     1   32  
  3     1   19  
  3     1   6  
  3     1   173  
  3     1   22  
  3     1   5  
  3     1   43  
  3     1   33  
  3     1   7  
  3     1   40  
  3     1   18  
  3     1   6  
  3     1   36  
  3     1   18  
  3     1   6  
  3     1   35  
  3     1   40  
  3     1   7  
  3     1   34  
  3     1   17  
  3     1   5  
  3     1   33  
  3     1   54  
  3     1   6  
  3     1   37  
  3     1   19  
  3     1   5  
  3     1   35  
  3     1   18  
  3     1   20  
  3     1   35  
  3     1   17  
  3     1   6  
  3     1   36  
  3     1   30  
  3     1   20  
  3     1   35  
  3     1   21  
  3     1   6  
  3     1   49  
  3     1   22  
  3     1   6  
  3     1   57  
  3     1   18  
  3     1   8  
  3     1   35  
  3     1   17  
  3     1   13  
  3     1   38  
  3     1   19  
  3     1   7  
  3     1   35  
  3     1   18  
  3     1   6  
  3     1   35  
  3     1   17  
  3     1   7  
  3     1   42  
  3     1   18  
  3     1   12  
  3     1   65  
  3     1   16  
  3     1   6  
  3     1   34  
  3     1   17  
  3     1   6  
  3     1   33  
  3     1   19  
  3     1   5  
  3     1   33  
  2     1   15  
  2     1   5  
  2     1   27  
  2     1   14  
  2     1   4  
  2     1   29  
  2     1   13  
  2     1   3  
  2     1   28  
  2     1   11  
  2     1   4  
  2     1   21  
  2     1   13  
  2     1   3  
  2     1   25  
  2     1   11  
  2     1   4  
  2     1   22  
  2     1   12  
  2     1   5  
  2     1   24  
  2     1   11  
  2     1   5  
  2     1   23  
  2     1   13  
  2     1   3  
  2     1   23  
  2     1   10  
  2     1   4  
  2     1   24  
  2     1   12  
  2     1   4  
  2     1   21  
  2     1   14  
  2     1   5  
  2     1   29  
  2     1   14  
  2     1   5  
  2     1   27  
  2     1   13  
  2     1   3  
  2     1   28  
  2     1   12  
  2     1   3  
  2     1   32  
  2     1   11  
  2     1   4  
  2     1   23  
  2     1   13  
  2     1   4  
  2     1   24  
  2     1   10  
  2     1   5  
  2     1   23  
  2     1   12  
  2     1   5  
  2     1   22  
  2     1   11  
  2     1   5  
  2     1   21  
  2     1   11  
  2     1   4  
  2     1   24  
  2     1   12  
  2     1   4  
  2     1   22  
  2     1   15  
  2     1   5  
  2     1   27  
  2     1   15  
  2     1   4  
  2     1   29  
  2     1   11  
  2     1   4  
  2     1   24  
  2     1   12  
  2     1   4  
  2     1   22  
  2     1   12  
  2     1   4  
  2     1   23  
  2     1   11  
  2     1   5  
  2     1   22  
  2     1   28  
  2     1   5  
  2     1   27  
  2     1   12  
  2     1   4  
  2     1   23  
  2     1   11  
  2     1   6  
  2     1   24  
  2     1   11  
  2     1   4  
  2     1   22  
  2     1   12  
  2     1   4  
  2     1   32  
  2     1   14  
  2     1   6  
  2     1   28  
  2     1   13  
  2     1   4  
  2     1   28  
  2     1   12  
  2     1   6  
  2     1   24  
  2     1   12  
  2     1   3  
  2     1   23  
  2     1   11  
  2     1   4  
  2     1   23  
  2     1   14  
  2     1   4  
  2     1   25  
  2     1   12  
  2     1   11  
  2     1   26  
  2     1   11  
  2     1   4  
  2     1   21  
  2     1   11  
  2     1   4  
  2     1   23  
  2     1   11  
  2     1   4  
  2     1   24  
  2     1   12  
  2     1   4  
  2     1   23  
  2     1   15  
  2     1   4  
  2     1   28  
  2     1   14  
  2     1   3  
  2     1   41  
  2     1   12  
  2     1   5  
  2     1   26  
  2     1   12  
  2     1   4  
  2     1   27  
  2     1   20  
  2     1   6  
  2     1   27  
  2     1   11  
  2     1   4  
  2     1   26  
  2     1   12  
  2     1   3  
  2         27  
  2         11  
  2         5  
  2         25  
  2         12  
  2         4  
  2         25  
  2         11  
  2         3  
  2         25  
  2         13  
  2         5  
  2         26  
  1         7  
  1         2  
  1         14  
  1         8  
  1         2  
  1         17  
  1         7  
  1         3  
  1         12  
  1         7  
  1         2  
  1         12  
  1         5  
  1         2  
  1         12  
  1         7  
  1         2  
  1         13  
  1         7  
  1         3  
  1         13  
  1         6  
  1         3  
  1         13  
  1         6  
  1         2  
  1         12  
  1         6  
  1         2  
  1         12  
  1         8  
  1         2  
  1         15  
  1         8  
  1         3  
  1         14  
  1         8  
  1         2  
  1         16  
  1         6  
  1         3  
  1         12  
  1         7  
  1         2  
  1         12  
  1         7  
  1         2  
  1         13  
  1         8  
  1         2  
  1         12  
  1         5  
  1         2  
  1         14  
  1         7  
  1         1  
  1         12  
  1         6  
  1         3  
  1         12  
  1         6  
  1         3  
  1         13  
  1         6  
  1         2  
  1         23  
  1         7  
  1         2  
  1         14  
  1         8  
  1         2  
  1         15  
  1         5  
  1         3  
  1         12  
  1         7  
  1         2  
  1         11  
  1         6  
  1         4  
  1         12  
  1         7  
  1         2  
  1         11  
  1         7  
  1         1  
  1         12  
  1         6  
  1         1  
  1         13  
  1         6  
  1         2  
  1         12  
  1         6  
  1         3  
  1         12  
  1         6  
  1         3  
  1         11  
  1         6  
  1         2  
  1         14  
  1         8  
  1         2  
  1         15  
  1         6  
  1         2  
  1         12  
  1         7  
  1         2  
  1         12  
  1         5  
  1         3  
  1         13  
  1         8  
  1         2  
  1         11  
  1         6  
  1         2  
  1         13  
  1         8  
  1         2  
  1         12  
  1         6  
  1         2  
  1         64  
  1         7  
  1         3  
  1         12  
  1         8  
  1         2  
  1         13  
  1         7  
  1         3  
  1         15  
  1         7  
  1         3  
  1         15  
  1         7  
  1         3  
  1         15  
  1         7  
  1         2  
  1         12  
  1         7  
  1         2  
  1         14  
  1         7  
  1         3  
  1         13  
  1         7  
  1         2  
  1         12  
  1         7  
  1         10  
  1         14  
  1         5  
  1         2  
  1         12  
  1         6  
  1         2  
  1         11  
  1         8  
  1         2  
  1         12  
  1         8  
  1         2  
  1         14  
  1         7  
  1         2  
  1         14  
  1         8  
  1         2  
  1         12  
  1         8  
  1         2  
  1         12  
  1         6  
  1         2  
  1         13  
  1         7  
  1         3  
  1         13  
  1         7  
  1         2  
  1         14  
  1         7  
  1         2  
  1         13  
  1         6  
  1         2  
  1         12  
  1         6  
  1         2  
  1         13  
  1         7  
  1         2  
  1         14  
  1         7  
  1         2  
  1         17  
  1         7  
  1         3  
  1         14  
  1         6  
  1         2  
  1         13  
  1         7  
  1         2  
  1         14  
  1         7  
  1         2  
  1         13  
  1         7  
  1         2  
  1         13  
  1         7  
  1         2  
  1         13  
  1         6  
  1         2  
  1         11  
  1         6  
  1         2  
  1         21  
  1         6  
  1         2  
  1         11  
  1         7  
  1         2  
  1         13  
  1         8  
  1         2  
  1         16  
  1         8  
  1         3  
  1         14  
  1         6  
  1         2  
  1         13  
  1         6  
  1         2  
  1         13  
  1         8  
  1         3  
  1         12  
  1         7  
  1         2  
  1         13  
  1         7  
  1         3  
  1         12  
  1         6  
  1         2  
  1         12  
  1         6  
  1         2  
  1         11  
  1         7  
  1         2  
  1         21  
  1         7  
  1         2  
  1         13  
  1         8  
  1         2  
  1         14  
  1         8  
  1         2  
  1         16  
  1         7  
  1         2  
  1         12  
  1         6  
  1         2  
  1         11  
  1         7  
  1         4  
  1         13  
  1         8  
  1         2  
  1         13  
  1         6  
  1         2  
  1         13  
  1         6  
  1         3  
  1         13  
  1         6  
  1         2  
  1         13  
  1         7  
  1         2  
  1         14  
  1         6  
  1         2  
  1         12  
  1         8  
  1         2  
  1         14  
  1         7  
  1         2  
  1         15  
  1         7  
  1         2  
  1         13  
  1         6  
  1         2  
  1         13  
  1         7  
  1         2  
  1         13  
  1         7  
  1         2  
  1         11  
  1         6  
  1         2  
  1         14  
  1         7  
  1         2  
  1         13  
  1         7  
  1         2  
  1         12  
  1         7  
  1         1  
  1         13  
  1         6  
  1         2  
  1         12  
  1         11  
  1         2  
  1         18  
  1         8  
  1         2  
  1         17  
  1         7  
  1         2  
  1         13  
  1         7  
  1         1  
  1         13  
  1         7  
  1         3  
  1         14  
  1         8  
  1         2  
  1         12  
  1         6  
  1         3  
  1         12  
  1         6  
  1         3  
  1         13  
  1         5  
  1         2  
  1         12  
  1         6  
  1         2  
  1         12  
  1         6  
  1         3  
  1         12  
  1         9  
  1         3  
  1         14  
  1         8  
  1         3  
  1         15  
  1         6  
  1         3  
  1         12  
  1         7  
  1         2  
  1         13  
  1         7  
  1         2  
  1         13  
  1         7  
  1         3  
  1         21  
  1         7  
  1         2  
  1         12  
  1         7  
  1         2  
  1         12  
  1         6  
  1         4  
  1         11  
  1         6  
  1         2  
  1         12  
  1         7  
  1         2  
  1         12  
  1         10  
  1         2  
  1         15  
  1         7  
  1         2  
  1         14  
  1         6  
  1         2  
  1         14  
  1         6  
  1         3  
  1         13  
  1         7  
  1         2  
  1         14  
  1         6  
  1         3  
  1         11  
  1         7  
  1         2  
  1         14  
  1         15  
  1         5  
  1         14  
  1         7  
  1         3  
  1         13  
  1         6  
  1         2  
  1         12  
  1         7  
  1         2  
  1         33  
  1         9  
  1         2  
  1         14  
  1         8  
  1         5  
  1         16  
  1         7  
  1         4  
  1         14  
  1         7  
  1         2  
  1         13  
  1         7  
  1         2  
  1         15  
  1         7  
  1         2  
  1         12  
  1         7  
  1         2  
  1         13  
  1         6  
  1         3  
  1         13  
  1         6  
  1         2  
  1         11  
  1         6  
  1         2  
  1         11  
  1         6  
  1         2  
  1         12  
  1         8  
  1         2  
  1         13  
  1         7  
  1         2  
  1         15  
  1         7  
  1         3  
  1         13  
  1         7  
  1         2  
  1         12  
  1         7  
  1         2  
  1         12  
  1         8  
  1         3  
  1         12  
  1         6  
  1         3  
  1         13  
  1         6  
  1         3  
  1         11  
  1         7  
  1         3  
  1         12  
  1         7  
  1         2  
  1         13  
  1         6  
  1         2  
  1         12  
  1         8  
  1         2  
  1         14  
  1         7  
  1         3  
  1         14  
  1         6  
  1         3  
  1         13  
  1         7  
  1         2  
  1         13  
  1         6  
  1         2  
  1         12  
  1         7  
  1         2  
  1         11  
  1         7  
  1         2  
  1         12  
  1         6  
  1         3  
  1         12  
  1         7  
  1         2  
  1         12  
  1         6  
  1         2  
  1         13  
  1         6  
  1         2  
  1         11  
  1         9  
  1         3  
  1         13  
  1         7  
  1         3  
  1         15  
  1         6  
  1         2  
  1         13  
  1         7  
  1         3  
  1         12  
  1         6  
  1         2  
  1         22  
  1         6  
  1         3  
  1         11  
  1         6  
  1         2  
  1         13  
  1         6  
  1         3  
  1         13  
  1         6  
  1         3  
  1         11  
  1         7  
  1         2  
  1         12  
  1         6  
  1         2  
  1         13  
  1         8  
  1         2  
  1         14  
  1         7  
  1         2  
  1         14  
  1         6  
  1         3  
  1         12  
  1         7  
  1         2  
  1         12  
  1         18  
  1         2  
  1         14  
  1         7  
  1         2  
  1         22  
  1         8  
  1         3  
  1         14  
  1         6  
  1         3  
  1         11  
  1         6  
  1         3  
  1         12  
  1         7  
  1         3  
  1         13  
  1         7  
  1         2  
  1         12  
  1         8  
  1         2  
  1         13  
  1         7  
  1         15  
  1         14  
  1         6  
  1         2  
  1         14  
  1         6  
  1         2  
  1         13  
  1         6  
  1         2  
  1         13  
  1         8  
  1         2  
  1         12  
  1         8  
  1         1  
  1         13  
  1         5  
  1         2  
  1         11  
  1         6  
  1         4  
  1         12  
  1         7  
  1         2  
  1         11  
  1         6  
  1         2  
  1         12  
  1         7  
  1         2  
  1         13  
  1         6  
  1         3  
  1         15  
  1         7  
  1         2  
  1         14  
  1         7  
  1         2  
  1         14  
  1         6  
  1         2  
  1         23  
  1         7  
  1         2  
  1         11  
  1         6  
  1         3  
  1         12  
  1         6  
  1         2  
  1         23  
  1         6  
  1         2  
  1         12  
  1         6  
  1         3  
  1         12  
  1         7  
  1         2  
  1         12  
  1         8  
  1         3  
  1         15  
  1         8  
  1         2  
  1         16  
  1         6  
  1         3  
  1         12  
  1         7  
  1         2  
  1         12  
  1         6  
  1         3  
  1         12  
  1         7  
  1         3  
  1         14  
  1         7  
  1         2  
  1         31  
  1         6  
  1         3  
  1         13  
  1         14  
  1         3  
  1         13  
  1         6  
  1         3  
  1         12  
  1         7  
  1         2  
  1         12  
  1         9  
  1         3  
  1         15  
  1         7  
  1         2  
  1         13  
  1         9  
  1         2  
  1         11  
  1         7  
  1         2  
  1         12  
  1         6  
  1         2  
  1         12  
  1         7  
  1         3  
  1         15  
  1         7  
  1         1  
  1         12  
  1         6  
  1         3  
  1         12  
  1         7  
  1         2  
  1         12  
  1         7  
  1         2  
  1         11  
  1         6  
  1         2  
  1         12  
  1         8  
  1         2  
  1         14  
  1         7  
  1         2  
  1         16  
  1         6  
  1         2  
  1         14  
  1         6  
  1         3  
  1         13  
  1         6  
  1         2  
  1         11  
  1         7  
  1         3  
  1         11  
  1         7  
  1         3  
  1         14  
  1         6  
  1         3  
  1         11  
  1         6  
  1         2  
  1         12  
  1         6  
  1         2  
  1         11  
  1         7  
  1         2  
  1         11  
  1         8  
  1         3  
  1         16  
  1         7  
  1         3  
  1         17  
  1         6  
  1         2  
  1         24  
  1         6  
  1         2  
  1         12  
  1         6  
  1         3  
  1         12  
  1         8  
  1         2  
  1         11  
  1         6  
  1         3  
  1         12  
  1         6  
  1         3  
  1         10  
  1         6  
  1         2  
  1         11  
  1         6  
  1         2  
  1         13  
  1         7  
  1         2  
  1         12  
  1         8  
  1         2  
  1         16  
  1         9  
  1         3  
  1         14  
  1         6  
  1         2  
  1         12  
  1         7  
  1         2  
  1         13  
  1         6  
  1         3  
  1         12  
  1         6  
  1         3  
  1         11  
  1         6  
  1         2  
  1         14  
  1         6  
  1         2  
  1         12  
  1         6  
  1         3  
  1         12  
  1         6  
  1         3  
  1         12  
  1         6  
  1         2  
  1         13  
  1         8  
  1         3  
  1         14  
  1         8  
  1         2  
  1         14  
  1         7  
  1         2  
  1         13  
  1         6  
  1         2  
  1         11  
  1         7  
  1         2  
  1         14  
  1         6  
  1         2  
  1         13  
  1         7  
  1         3  
  1         13  
  1         5  
  1         2  
  1         12  
  1         7  
  1         2  
  1         11  
  1         6  
  1         2  
  1         12  
  1         7  
  1         2  
  1         12  
  1         7  
  1         3  
  1         16  
  1         8  
  1         2  
  1         18  
  1         6  
  1         1  
  1         15  
  1         7  
  1         1  
  1         12  
  1         7  
  1         2  
  1         13  
  1         7  
  1         2  
  1         12  
  1         6  
  1         2  
  1         13  
  1         6  
  1         2  
  1         13  
  1         6  
  1         3  
  1         12  
  1         7  
  1         2  
  1         11  
  1         6  
  1         2  
  1         13  
  1         8  
  1         2  
  1         15  
  1         8  
  1         2  
  1         18  
  1         7  
  1         2  
  1         14  
  1         6  
  1         3  
  1         13  
  1         6  
  1         2  
  1         12  
  1         8  
  1         2  
  1         22  
  1         7  
  1         3  
  1         12  
  1         6  
  1         2  
  1         14  
  1         6  
  1         2  
  1         12  
  1         6  
  1         3  
  1         12  
  1         6  
  1         3  
  1         12  
  1         8  
  1         3  
  1         16  
  1         9  
  1         3  
  1         15  
  1         6  
  1         3  
  1         12  
  1         8  
  1         2  
  1         12  
  1         7  
  1         3  
  1         13  
  1         6  
  1         3  
  1         11  
  1         6  
  1         3  
  1         12  
  1         6  
  1         2  
  1         13  
  1         6  
  1         2  
  1         11  
  1         7  
  1         3  
  1         494  
  1         6  
  1         2  
  1         11  
297 2744         5919 $error = $@;
298             }
299 3066         4432 $@ = $previous_error;
300             # at this point $failed contains a true value if the eval died,
301             # even if some destructor overwrote $@ as the eval was unwinding.
302 3066 100       9434 return unless $failed;
303 17   50     77 return ($error || '(unknown error)');
304             }
305              
306              
307             # When printing array elements or hash keys, we may traverse all of it
308             # or just a few chunks. This function returns those chunks' indexes, and
309             # a scalar ref to a message whenever a chunk was skipped.
310             sub _fetch_indexes_for {
311 118     121   235 my ($array_ref, $prefix, $ddp) = @_;
312              
313 118         343 my $max_function = $prefix . '_max';
314 118         266 my $preserve_function = $prefix . '_preserve';
315 118         181 my $overflow_function = $prefix . '_overflow';
316 118         469 my $max = $ddp->$max_function;
317 118         331 my $preserve = $ddp->$preserve_function;
318              
319 118 100 100     501 return (0 .. $#{$array_ref}) if !$max || @$array_ref <= $max;
  106         464  
320              
321 17         72 my $skip_message = $ddp->maybe_colorize($ddp->$overflow_function, 'overflow');
322 17 100 100     83 if ($preserve eq 'begin' || $preserve eq 'end') {
    100          
    100          
323 11         85 my $n_elements = @$array_ref - $max;
324 11         55 $skip_message =~ s/__SKIPPED__/$n_elements/g;
325             return $preserve eq 'begin'
326             ? ((0 .. ($max - 1)), \$skip_message)
327 11 100       41 : (\$skip_message, ($n_elements .. $#{$array_ref}))
  7         66  
328             ;
329             }
330             elsif ($preserve eq 'extremes') {
331 7         34 my $half_max = int($max / 2);
332 7         16 my $last_index_of_chunk_one = $half_max - 1;
333 7         71 my $n_elements = @$array_ref - $max;
334              
335 7         34 my $first_index_of_chunk_two = @$array_ref - ($max - $half_max);
336 7         21 $skip_message =~ s/__SKIPPED__/$n_elements/g;
337             return (
338             (0 .. $last_index_of_chunk_one),
339             \$skip_message,
340 7         60 ($first_index_of_chunk_two .. $#{$array_ref})
  7         38  
341             );
342             }
343             elsif ($preserve eq 'middle') {
344 7         14 my $array_middle = int($#{$array_ref} / 2);
  7         71  
345 7         49 my $first_index_to_show = $array_middle - int($max / 2);
346 7         15 my $last_index_to_show = $first_index_to_show + $max - 1;
347 7         78 my ($message_begin, $message_end) = ($skip_message, $skip_message);
348 7         55 $message_begin =~ s/__SKIPPED__/$first_index_to_show/gse;
  7         21  
349 7         79 my $items_left = $#{$array_ref} - $last_index_to_show;
  7         35  
350 7         18 $message_end =~ s/__SKIPPED__/$items_left/gs;
351             return (
352 7         74 \$message_begin,
353             $first_index_to_show .. $last_index_to_show,
354             \$message_end
355             );
356             }
357             else { # $preserve eq 'none'
358 7         48 my $n_elements = scalar(@$array_ref);
359 7         21 $skip_message =~ s/__SKIPPED__/$n_elements/g;
360 7         78 return (\$skip_message);
361             }
362             }
363              
364             # helpers below strongly inspired by the excellent Package::Stash:
365             sub _linear_ISA_for {
366 149     152   272 my ($class, $ddp) = @_;
367 149 100       293 _initialize_mro($ddp) unless $mro_initialized;
368 149         220 my $isa;
369 149 50       288 if ($mro_initialized > 0) {
370 149         448 $isa = mro::get_linear_isa($class);
371             }
372             else {
373             # minimal fallback in case Class::MRO isn't available
374             # (should only matter for perl < 5.009_005):
375 5         59 $isa = [ $class, _get_superclasses_for($class) ];
376             }
377 149 100       346 return [@$isa, ($ddp->class->universal ? 'UNIVERSAL' : ())];
378             }
379              
380             sub _initialize_mro {
381 16     19   41 my ($ddp) = @_;
382             my $error = _tryme(sub {
383 16 50   19   82 if ($] < 5.009_005) { require MRO::Compat }
  5         9  
384 16         128 else { require mro }
385 16         49 1;
386 16         139 });
387 16 0 33     70 if ($error && index($error, 'in @INC') != -1 && $mro_initialized == 0) {
      33        
388 5 0       56 _warn(
389             $ddp,
390             ($] < 5.009_005 ? 'MRO::Compat' : 'mro') . ' not found in @INC.'
391             . ' Objects may display inaccurate/incomplete ISA and method list'
392             );
393             }
394 16 50       98 $mro_initialized = $error ? -1 : 1;
395             }
396              
397             sub _get_namespace {
398 113     116   168 my ($class_name) = @_;
399 113         187 my $namespace;
400             {
401 48     48   371 no strict 'refs';
  48         122  
  48         6981  
  113         148  
402 113         124 $namespace = \%{ $class_name . '::' }
  113         325  
403             }
404             # before 5.10, stashes don't ever seem to drop to a refcount of zero,
405             # so weakening them isn't helpful
406 113 50       350 Scalar::Util::weaken($namespace) if $] >= 5.010;
407              
408 113         215 return $namespace;
409             }
410              
411             sub _get_superclasses_for {
412 43     46   136 my ($class_name) = @_;
413 43         106 my $namespace = _get_namespace($class_name);
414 43         99 my $res = _get_symbol($class_name, $namespace, 'ISA', 'ARRAY');
415 43 100       116 return @{ $res || [] };
  43         178  
416             }
417              
418             sub _get_symbol {
419 267     270   409 my ($class_name, $namespace, $symbol_name, $symbol_kind) = @_;
420              
421 267 100       461 if (exists $namespace->{$symbol_name}) {
422 252         334 my $entry_ref = \$namespace->{$symbol_name};
423 252 50       394 if (ref($entry_ref) eq 'GLOB') {
424 252         327 return *{$entry_ref}{$symbol_kind};
  252         556  
425             }
426             else {
427 5 0       11 if ($symbol_kind eq 'CODE') {
428 48     48   331 no strict 'refs';
  48         116  
  48         3179  
429 5         57 return \&{ $class_name . '::' . $symbol_name };
  5         30  
430             }
431             }
432             }
433 20         35 return;
434             }
435              
436             1;