← Index
NYTProf Performance Profile   « line view »
For ../prof.pl
  Run on Thu Dec 15 15:23:56 2022
Reported on Thu Dec 15 15:27:01 2022

Filename/Users/ether/perl5/perlbrew/perls/36.0/lib/5.36.0/darwin-2level/Data/Dumper.pm
StatementsExecuted 48 statements in 7.05ms
Subroutines
Calls P F Exclusive
Time		 Inclusive
Time		 Subroutine
11119µs3.52msData::Dumper::::BEGIN@31Data::Dumper::BEGIN@31
11118µs20µsData::Dumper::::BEGIN@12Data::Dumper::BEGIN@12
11115µs67µsData::Dumper::::BEGIN@258Data::Dumper::BEGIN@258
11110µs10µsData::Dumper::::BEGIN@17Data::Dumper::BEGIN@17
11110µs14µsData::Dumper::::BEGIN@762Data::Dumper::BEGIN@762
1117µs7µsData::Dumper::::CORE:regcompData::Dumper::CORE:regcomp (opcode)
1117µs7µsData::Dumper::::_vstringData::Dumper::_vstring (xsub)
1115µs26µsData::Dumper::::BEGIN@13Data::Dumper::BEGIN@13
1115µs39µsData::Dumper::::BEGIN@20Data::Dumper::BEGIN@20
1113µs3µsData::Dumper::::BEGIN@22Data::Dumper::BEGIN@22
1112µs2µsData::Dumper::::CORE:qrData::Dumper::CORE:qr (opcode)
0000s0sData::Dumper::::BlessData::Dumper::Bless
0000s0sData::Dumper::::DESTROYData::Dumper::DESTROY
0000s0sData::Dumper::::DeepcopyData::Dumper::Deepcopy
0000s0sData::Dumper::::DeparseData::Dumper::Deparse
0000s0sData::Dumper::::DumpData::Dumper::Dump
0000s0sData::Dumper::::DumperData::Dumper::Dumper
0000s0sData::Dumper::::DumperXData::Dumper::DumperX
0000s0sData::Dumper::::DumpperlData::Dumper::Dumpperl
0000s0sData::Dumper::::FreezerData::Dumper::Freezer
0000s0sData::Dumper::::IndentData::Dumper::Indent
0000s0sData::Dumper::::MaxdepthData::Dumper::Maxdepth
0000s0sData::Dumper::::MaxrecurseData::Dumper::Maxrecurse
0000s0sData::Dumper::::NamesData::Dumper::Names
0000s0sData::Dumper::::PadData::Dumper::Pad
0000s0sData::Dumper::::PairData::Dumper::Pair
0000s0sData::Dumper::::PurityData::Dumper::Purity
0000s0sData::Dumper::::QuotekeysData::Dumper::Quotekeys
0000s0sData::Dumper::::ResetData::Dumper::Reset
0000s0sData::Dumper::::SeenData::Dumper::Seen
0000s0sData::Dumper::::SortkeysData::Dumper::Sortkeys
0000s0sData::Dumper::::SparseseenData::Dumper::Sparseseen
0000s0sData::Dumper::::TerseData::Dumper::Terse
0000s0sData::Dumper::::ToasterData::Dumper::Toaster
0000s0sData::Dumper::::TrailingcommaData::Dumper::Trailingcomma
0000s0sData::Dumper::::UseperlData::Dumper::Useperl
0000s0sData::Dumper::::UseqqData::Dumper::Useqq
0000s0sData::Dumper::::ValuesData::Dumper::Values
0000s0sData::Dumper::::VarnameData::Dumper::Varname
0000s0sData::Dumper::::_compose_outData::Dumper::_compose_out
0000s0sData::Dumper::::_dumpData::Dumper::_dump
0000s0sData::Dumper::::_quoteData::Dumper::_quote
0000s0sData::Dumper::::_refine_nameData::Dumper::_refine_name
0000s0sData::Dumper::::format_refaddrData::Dumper::format_refaddr
0000s0sData::Dumper::::newData::Dumper::new
0000s0sData::Dumper::::qquoteData::Dumper::qquote
Call graph for these subroutines as a Graphviz dot language file.
Line State
ments		 Time
on line		 Calls Time
in subs		 Code
1#
2# Data/Dumper.pm
3#
4# convert perl data structures into perl syntax suitable for both printing
5# and eval
6#
7# Documentation at the __END__
8#
9
10package Data::Dumper;
11
12219µs222µs
# spent 20µs (18+2) within Data::Dumper::BEGIN@12 which was called: # once (18µs+2µs) by Mojo::Util::BEGIN@5 at line 12
use strict;
# spent 20µs making 1 call to Data::Dumper::BEGIN@12 # spent 2µs making 1 call to strict::import
13218µs247µs
# spent 26µs (5+21) within Data::Dumper::BEGIN@13 which was called: # once (5µs+21µs) by Mojo::Util::BEGIN@5 at line 13
use warnings;
# spent 26µs making 1 call to Data::Dumper::BEGIN@13 # spent 21µs making 1 call to warnings::import
14
15#$| = 1;
16
17235µs110µs
# spent 10µs within Data::Dumper::BEGIN@17 which was called: # once (10µs+0s) by Mojo::Util::BEGIN@5 at line 17
use 5.008_001;
# spent 10µs making 1 call to Data::Dumper::BEGIN@17
1811µsrequire Exporter;
19
20214µs273µs
# spent 39µs (5+34) within Data::Dumper::BEGIN@20 which was called: # once (5µs+34µs) by Mojo::Util::BEGIN@5 at line 20
use constant IS_PRE_516_PERL => $] < 5.016;
# spent 39µs making 1 call to Data::Dumper::BEGIN@20 # spent 34µs making 1 call to constant::import
21
222107µs13µs
# spent 3µs within Data::Dumper::BEGIN@22 which was called: # once (3µs+0s) by Mojo::Util::BEGIN@5 at line 22
use Carp ();
# spent 3µs making 1 call to Data::Dumper::BEGIN@22
23
24# Globals people alter.
25our ( $Indent, $Trailingcomma, $Purity, $Pad, $Varname, $Useqq, $Terse, $Freezer,
26 $Toaster, $Deepcopy, $Quotekeys, $Bless, $Maxdepth, $Pair, $Sortkeys,
27 $Deparse, $Sparseseen, $Maxrecurse, $Useperl );
28
29our ( @ISA, @EXPORT, @EXPORT_OK, $VERSION );
30
31
# spent 3.52ms (19µs+3.50) within Data::Dumper::BEGIN@31 which was called: # once (19µs+3.50ms) by Mojo::Util::BEGIN@5 at line 48
BEGIN {
3210s $VERSION = '2.184'; # Don't forget to set version and release
33 # date in POD below!
34
3516µs @ISA = qw(Exporter);
3610s @EXPORT = qw(Dumper);
3710s @EXPORT_OK = qw(DumperX);
38
39 # if run under miniperl, or otherwise lacking dynamic loading,
40 # XSLoader should be attempted to load, or the pure perl flag
41 # toggled on load failure.
4213µs eval {
4310s require XSLoader;
4413.51ms13.50ms XSLoader::load( 'Data::Dumper' );
# spent 3.50ms making 1 call to XSLoader::load
4511µs 1
46 }
47 or $Useperl = 1;
481720µs13.52ms}
# spent 3.52ms making 1 call to Data::Dumper::BEGIN@31
49
5010smy $IS_ASCII = ord 'A' == 65;
51
52# module vars and their defaults
5311µs$Indent = 2 unless defined $Indent;
5410s$Trailingcomma = 0 unless defined $Trailingcomma;
5510s$Purity = 0 unless defined $Purity;
5611µs$Pad = "" unless defined $Pad;
5710s$Varname = "VAR" unless defined $Varname;
5810s$Useqq = 0 unless defined $Useqq;
5910s$Terse = 0 unless defined $Terse;
6011µs$Freezer = "" unless defined $Freezer;
6110s$Toaster = "" unless defined $Toaster;
6210s$Deepcopy = 0 unless defined $Deepcopy;
6310s$Quotekeys = 1 unless defined $Quotekeys;
6410s$Bless = "bless" unless defined $Bless;
65#$Expdepth = 0 unless defined $Expdepth;
6610s$Maxdepth = 0 unless defined $Maxdepth;
6710s$Pair = ' => ' unless defined $Pair;
6810s$Useperl = 0 unless defined $Useperl;
6911µs$Sortkeys = 0 unless defined $Sortkeys;
7010s$Deparse = 0 unless defined $Deparse;
7110s$Sparseseen = 0 unless defined $Sparseseen;
7210s$Maxrecurse = 1000 unless defined $Maxrecurse;
73
74#
75# expects an arrayref of values to be dumped.
76# can optionally pass an arrayref of names for the values.
77# names must have leading $ sign stripped. begin the name with *
78# to cause output of arrays and hashes rather than refs.
79#
80sub new {
81 my($c, $v, $n) = @_;
82
83 Carp::croak("Usage: PACKAGE->new(ARRAYREF, [ARRAYREF])")
84 unless (defined($v) && (ref($v) eq 'ARRAY'));
85 $n = [] unless (defined($n) && (ref($n) eq 'ARRAY'));
86
87 my($s) = {
88 level => 0, # current recursive depth
89 indent => $Indent, # various styles of indenting
90 trailingcomma => $Trailingcomma, # whether to add comma after last elem
91 pad => $Pad, # all lines prefixed by this string
92 xpad => "", # padding-per-level
93 apad => "", # added padding for hash keys n such
94 sep => "", # list separator
95 pair => $Pair, # hash key/value separator: defaults to ' => '
96 seen => {}, # local (nested) refs (id => [name, val])
97 todump => $v, # values to dump []
98 names => $n, # optional names for values []
99 varname => $Varname, # prefix to use for tagging nameless ones
100 purity => $Purity, # degree to which output is evalable
101 useqq => $Useqq, # use "" for strings (backslashitis ensues)
102 terse => $Terse, # avoid name output (where feasible)
103 freezer => $Freezer, # name of Freezer method for objects
104 toaster => $Toaster, # name of method to revive objects
105 deepcopy => $Deepcopy, # do not cross-ref, except to stop recursion
106 quotekeys => $Quotekeys, # quote hash keys
107 'bless' => $Bless, # keyword to use for "bless"
108# expdepth => $Expdepth, # cutoff depth for explicit dumping
109 maxdepth => $Maxdepth, # depth beyond which we give up
110 maxrecurse => $Maxrecurse, # depth beyond which we abort
111 useperl => $Useperl, # use the pure Perl implementation
112 sortkeys => $Sortkeys, # flag or filter for sorting hash keys
113 deparse => $Deparse, # use B::Deparse for coderefs
114 noseen => $Sparseseen, # do not populate the seen hash unless necessary
115 };
116
117 if ($Indent > 0) {
118 $s->{xpad} = " ";
119 $s->{sep} = "\n";
120 }
121 return bless($s, $c);
122}
123
124# Packed numeric addresses take less memory. Plus pack is faster than sprintf
125
126sub format_refaddr {
127 require Scalar::Util;
128 pack "J", Scalar::Util::refaddr(shift);
129};
130
131#
132# add-to or query the table of already seen references
133#
134sub Seen {
135 my($s, $g) = @_;
136 if (defined($g) && (ref($g) eq 'HASH')) {
137 my($k, $v, $id);
138 while (($k, $v) = each %$g) {
139 if (defined $v) {
140 if (ref $v) {
141 $id = format_refaddr($v);
142 if ($k =~ /^[*](.*)$/) {
143 $k = (ref $v eq 'ARRAY') ? ( "\\\@" . $1 ) :
144 (ref $v eq 'HASH') ? ( "\\\%" . $1 ) :
145 (ref $v eq 'CODE') ? ( "\\\&" . $1 ) :
146 ( "\$" . $1 ) ;
147 }
148 elsif ($k !~ /^\$/) {
149 $k = "\$" . $k;
150 }
151 $s->{seen}{$id} = [$k, $v];
152 }
153 else {
154 Carp::carp("Only refs supported, ignoring non-ref item \$$k");
155 }
156 }
157 else {
158 Carp::carp("Value of ref must be defined; ignoring undefined item \$$k");
159 }
160 }
161 return $s;
162 }
163 else {
164 return map { @$_ } values %{$s->{seen}};
165 }
166}
167
168#
169# set or query the values to be dumped
170#
171sub Values {
172 my($s, $v) = @_;
173 if (defined($v)) {
174 if (ref($v) eq 'ARRAY') {
175 $s->{todump} = [@$v]; # make a copy
176 return $s;
177 }
178 else {
179 Carp::croak("Argument to Values, if provided, must be array ref");
180 }
181 }
182 else {
183 return @{$s->{todump}};
184 }
185}
186
187#
188# set or query the names of the values to be dumped
189#
190sub Names {
191 my($s, $n) = @_;
192 if (defined($n)) {
193 if (ref($n) eq 'ARRAY') {
194 $s->{names} = [@$n]; # make a copy
195 return $s;
196 }
197 else {
198 Carp::croak("Argument to Names, if provided, must be array ref");
199 }
200 }
201 else {
202 return @{$s->{names}};
203 }
204}
205
206sub DESTROY {}
207
208sub Dump {
209 return &Dumpxs
210 unless $Data::Dumper::Useperl || (ref($_[0]) && $_[0]->{useperl})
211 # Use pure perl version on earlier releases on EBCDIC platforms
212 || (! $IS_ASCII && $] lt 5.021_010);
213 return &Dumpperl;
214}
215
216#
217# dump the refs in the current dumper object.
218# expects same args as new() if called via package name.
219#
220our @post;
221sub Dumpperl {
222 my($s) = shift;
223 my(@out, $val, $name);
224 my($i) = 0;
225 local(@post);
226
227 $s = $s->new(@_) unless ref $s;
228
229 for $val (@{$s->{todump}}) {
230 @post = ();
231 $name = $s->{names}[$i++];
232 $name = $s->_refine_name($name, $val, $i);
233
234 my $valstr;
235 {
236 local($s->{apad}) = $s->{apad};
237 $s->{apad} .= ' ' x (length($name) + 3) if $s->{indent} >= 2 and !$s->{terse};
238 $valstr = $s->_dump($val, $name);
239 }
240
241 $valstr = "$name = " . $valstr . ';' if @post or !$s->{terse};
242 my $out = $s->_compose_out($valstr, \@post);
243
244 push @out, $out;
245 }
246 return wantarray ? @out : join('', @out);
247}
248
249# wrap string in single quotes (escaping if needed)
250sub _quote {
251 my $val = shift;
252 $val =~ s/([\\\'])/\\$1/g;
253 return "'" . $val . "'";
254}
255
256# Old Perls (5.14-) have trouble resetting vstring magic when it is no
257# longer valid.
25822.19ms3119µs
# spent 67µs (15+52) within Data::Dumper::BEGIN@258 which was called: # once (15µs+52µs) by Mojo::Util::BEGIN@5 at line 258
use constant _bad_vsmg => defined &_vstring && (_vstring(~v0)||'') eq "v0";
# spent 67µs making 1 call to Data::Dumper::BEGIN@258 # spent 45µs making 1 call to constant::import # spent 7µs making 1 call to Data::Dumper::_vstring
259
260#
261# twist, toil and turn;
262# and recurse, of course.
263# sometimes sordidly;
264# and curse if no recourse.
265#
266sub _dump {
267 my($s, $val, $name) = @_;
268 my($out, $type, $id, $sname);
269
270 $type = ref $val;
271 $out = "";
272
273 if ($type) {
274
275 # Call the freezer method if it's specified and the object has the
276 # method. Trap errors and warn() instead of die()ing, like the XS
277 # implementation.
278 my $freezer = $s->{freezer};
279 if ($freezer and UNIVERSAL::can($val, $freezer)) {
280 eval { $val->$freezer() };
281 warn "WARNING(Freezer method call failed): $@" if $@;
282 }
283
284 require Scalar::Util;
285 my $realpack = Scalar::Util::blessed($val);
286 my $realtype = $realpack ? Scalar::Util::reftype($val) : ref $val;
287 $id = format_refaddr($val);
288
289 # Note: By this point $name is always defined and of non-zero length.
290 # Keep a tab on it so that we do not fall into recursive pit.
291 if (exists $s->{seen}{$id}) {
292 if ($s->{purity} and $s->{level} > 0) {
293 $out = ($realtype eq 'HASH') ? '{}' :
294 ($realtype eq 'ARRAY') ? '[]' :
295 'do{my $o}' ;
296 push @post, $name . " = " . $s->{seen}{$id}[0];
297 }
298 else {
299 $out = $s->{seen}{$id}[0];
300 if ($name =~ /^([\@\%])/) {
301 my $start = $1;
302 if ($out =~ /^\\$start/) {
303 $out = substr($out, 1);
304 }
305 else {
306 $out = $start . '{' . $out . '}';
307 }
308 }
309 }
310 return $out;
311 }
312 else {
313 # store our name
314 $s->{seen}{$id} = [ (
315 ($name =~ /^[@%]/)
316 ? ('\\' . $name )
317 : ($realtype eq 'CODE' and $name =~ /^[*](.*)$/)
318 ? ('\\&' . $1 )
319 : $name
320 ), $val ];
321 }
322 my $no_bless = 0;
323 my $is_regex = 0;
324 if ( $realpack and ($] >= 5.009005 ? re::is_regexp($val) : $realpack eq 'Regexp') ) {
325 $is_regex = 1;
326 $no_bless = $realpack eq 'Regexp';
327 }
328
329 # If purity is not set and maxdepth is set, then check depth:
330 # if we have reached maximum depth, return the string
331 # representation of the thing we are currently examining
332 # at this depth (i.e., 'Foo=ARRAY(0xdeadbeef)').
333 if (!$s->{purity}
334 and defined($s->{maxdepth})
335 and $s->{maxdepth} > 0
336 and $s->{level} >= $s->{maxdepth})
337 {
338 return qq['$val'];
339 }
340
341 # avoid recursing infinitely [perl #122111]
342 if ($s->{maxrecurse} > 0
343 and $s->{level} >= $s->{maxrecurse}) {
344 die "Recursion limit of $s->{maxrecurse} exceeded";
345 }
346
347 # we have a blessed ref
348 my ($blesspad);
349 if ($realpack and !$no_bless) {
350 $out = $s->{'bless'} . '( ';
351 $blesspad = $s->{apad};
352 $s->{apad} .= ' ' if ($s->{indent} >= 2);
353 }
354
355 $s->{level}++;
356 my $ipad = $s->{xpad} x $s->{level};
357
358 if ($is_regex) {
359 my $pat;
360 my $flags = "";
361 if (defined(*re::regexp_pattern{CODE})) {
362 ($pat, $flags) = re::regexp_pattern($val);
363 }
364 else {
365 $pat = "$val";
366 }
367 $pat =~ s <
368 {
369 $1 ? $1
370 : $2 ? '${\q($)}'
371 : '\\/'
372 }gex;
373
- -
377 $out .= "qr/$pat/$flags";
378 }
379 elsif ($realtype eq 'SCALAR' || $realtype eq 'REF'
380 || $realtype eq 'VSTRING') {
381 if ($realpack) {
382 $out .= 'do{\\(my $o = ' . $s->_dump($$val, "\${$name}") . ')}';
383 }
384 else {
385 $out .= '\\' . $s->_dump($$val, "\${$name}");
386 }
387 }
388 elsif ($realtype eq 'GLOB') {
389 $out .= '\\' . $s->_dump($$val, "*{$name}");
390 }
391 elsif ($realtype eq 'ARRAY') {
392 my($pad, $mname);
393 my($i) = 0;
394 $out .= ($name =~ /^\@/) ? '(' : '[';
395 $pad = $s->{sep} . $s->{pad} . $s->{apad};
396 ($name =~ /^\@(.*)$/) ? ($mname = "\$" . $1) :
397 # omit -> if $foo->[0]->{bar}, but not ${$foo->[0]}->{bar}
398 ($name =~ /^\\?[\%\@\*\$][^{].*[]}]$/) ? ($mname = $name) :
399 ($mname = $name . '->');
400 $mname .= '->' if $mname =~ /^\*.+\{[A-Z]+\}$/;
401 for my $v (@$val) {
402 $sname = $mname . '[' . $i . ']';
403 $out .= $pad . $ipad . '#' . $i
404 if $s->{indent} >= 3;
405 $out .= $pad . $ipad . $s->_dump($v, $sname);
406 $out .= ","
407 if $i++ < $#$val
408 || ($s->{trailingcomma} && $s->{indent} >= 1);
409 }
410 $out .= $pad . ($s->{xpad} x ($s->{level} - 1)) if $i;
411 $out .= ($name =~ /^\@/) ? ')' : ']';
412 }
413 elsif ($realtype eq 'HASH') {
414 my ($k, $v, $pad, $lpad, $mname, $pair);
415 $out .= ($name =~ /^\%/) ? '(' : '{';
416 $pad = $s->{sep} . $s->{pad} . $s->{apad};
417 $lpad = $s->{apad};
418 $pair = $s->{pair};
419 ($name =~ /^\%(.*)$/) ? ($mname = "\$" . $1) :
420 # omit -> if $foo->[0]->{bar}, but not ${$foo->[0]}->{bar}
421 ($name =~ /^\\?[\%\@\*\$][^{].*[]}]$/) ? ($mname = $name) :
422 ($mname = $name . '->');
423 $mname .= '->' if $mname =~ /^\*.+\{[A-Z]+\}$/;
424 my $sortkeys = defined($s->{sortkeys}) ? $s->{sortkeys} : '';
425 my $keys = [];
426 if ($sortkeys) {
427 if (ref($s->{sortkeys}) eq 'CODE') {
428 $keys = $s->{sortkeys}($val);
429 unless (ref($keys) eq 'ARRAY') {
430 Carp::carp("Sortkeys subroutine did not return ARRAYREF");
431 $keys = [];
432 }
433 }
434 else {
435 $keys = [ sort keys %$val ];
436 }
437 }
438
439 # Ensure hash iterator is reset
440 keys(%$val);
441
442 my $key;
443 while (($k, $v) = ! $sortkeys ? (each %$val) :
444 @$keys ? ($key = shift(@$keys), $val->{$key}) :
445 () )
446 {
447 my $nk = $s->_dump($k, "");
448
449 # _dump doesn't quote numbers of this form
450 if ($s->{quotekeys} && $nk =~ /^(?:0|-?[1-9][0-9]{0,8})\z/) {
451 $nk = $s->{useqq} ? qq("$nk") : qq('$nk');
452 }
453 elsif (!$s->{quotekeys} and $nk =~ /^[\"\']([A-Za-z_]\w*)[\"\']$/) {
454 $nk = $1
455 }
456
457 $sname = $mname . '{' . $nk . '}';
458 $out .= $pad . $ipad . $nk . $pair;
459
460 # temporarily alter apad
461 $s->{apad} .= (" " x (length($nk) + 4))
462 if $s->{indent} >= 2;
463 $out .= $s->_dump($val->{$k}, $sname) . ",";
464 $s->{apad} = $lpad
465 if $s->{indent} >= 2;
466 }
467 if (substr($out, -1) eq ',') {
468 chop $out if !$s->{trailingcomma} || !$s->{indent};
469 $out .= $pad . ($s->{xpad} x ($s->{level} - 1));
470 }
471 $out .= ($name =~ /^\%/) ? ')' : '}';
472 }
473 elsif ($realtype eq 'CODE') {
474 if ($s->{deparse}) {
475 require B::Deparse;
476 my $sub = 'sub ' . (B::Deparse->new)->coderef2text($val);
477 my $pad = $s->{sep} . $s->{pad} . $s->{apad} . $s->{xpad} x ($s->{level} - 1);
478 $sub =~ s/\n/$pad/gs;
479 $out .= $sub;
480 }
481 else {
482 $out .= 'sub { "DUMMY" }';
483 Carp::carp("Encountered CODE ref, using dummy placeholder") if $s->{purity};
484 }
485 }
486 else {
487 Carp::croak("Can't handle '$realtype' type");
488 }
489
490 if ($realpack and !$no_bless) { # we have a blessed ref
491 $out .= ', ' . _quote($realpack) . ' )';
492 $out .= '->' . $s->{toaster} . '()'
493 if $s->{toaster} ne '';
494 $s->{apad} = $blesspad;
495 }
496 $s->{level}--;
497 }
498 else { # simple scalar
499
500 my $ref = \$_[1];
501 my $v;
502 # first, catalog the scalar
503 if ($name ne '') {
504 $id = format_refaddr($ref);
505 if (exists $s->{seen}{$id}) {
506 if ($s->{seen}{$id}[2]) {
507 $out = $s->{seen}{$id}[0];
508 #warn "[<$out]\n";
509 return "\${$out}";
510 }
511 }
512 else {
513 #warn "[>\\$name]\n";
514 $s->{seen}{$id} = ["\\$name", $ref];
515 }
516 }
517 $ref = \$val;
518 if (ref($ref) eq 'GLOB') { # glob
519 my $name = substr($val, 1);
520 $name =~ s/^main::(?!\z)/::/;
521 if ($name =~ /\A(?:[A-Z_a-z][0-9A-Z_a-z]*)?::(?:[0-9A-Z_a-z]+::)*[0-9A-Z_a-z]*\z/ && $name ne 'main::') {
522 $sname = $name;
523 }
524 else {
525 local $s->{useqq} = IS_PRE_516_PERL && ($s->{useqq} || $name =~ /[^\x00-\x7f]/) ? 1 : $s->{useqq};
526 $sname = $s->_dump(
527 $name eq 'main::'
528 ? ''
529 : $name,
530 "",
531 );
532 $sname = '{' . $sname . '}';
533 }
534 if ($s->{purity}) {
535 my $k;
536 local ($s->{level}) = 0;
537 for $k (qw(SCALAR ARRAY HASH)) {
538 my $gval = *$val{$k};
539 next unless defined $gval;
540 next if $k eq "SCALAR" && ! defined $$gval; # always there
541
542 # _dump can push into @post, so we hold our place using $postlen
543 my $postlen = scalar @post;
544 $post[$postlen] = "\*$sname = ";
545 local ($s->{apad}) = " " x length($post[$postlen]) if $s->{indent} >= 2;
546 $post[$postlen] .= $s->_dump($gval, "\*$sname\{$k\}");
547 }
548 }
549 $out .= '*' . $sname;
550 }
551 elsif (!defined($val)) {
552 $out .= "undef";
553 }
554 # This calls the XSUB _vstring (if the XS code is loaded). I'm not *sure* if
555 # if belongs in the "Pure Perl" implementation. It sort of depends on what
556 # was meant by "Pure Perl", as this subroutine already relies Scalar::Util
557 # loading, which means that it has an XS dependency. De facto, it's the
558 # "Pure Perl" implementation of dumping (which uses XS helper code), as
559 # opposed to the C implementation (which calls out to Perl helper code).
560 # So in that sense this is fine - it just happens to be a local XS helper.
561 elsif (defined &_vstring and $v = _vstring($val)
562 and !_bad_vsmg || eval $v eq $val) {
563 $out .= $v;
564 }
565 # However the confusion comes here - if we *can't* find our XS helper, we
566 # fall back to this code, which generates different (worse) results. That's
567 # better than nothing, *but* it means that if you run the regression tests
568 # with Dumper.so missing, the test for "vstrings" fails, because this code
569 # here generates a different result. So there are actually "three" different
570 # implementations of Data::Dumper (kind of sort of) but we only test two.
571 elsif (!defined &_vstring
572 and ref $ref eq 'VSTRING' || eval{Scalar::Util::isvstring($val)}) {
573 $out .= sprintf "v%vd", $val;
574 }
575 # \d here would treat "1\x{660}" as a safe decimal number
576 elsif ($val =~ /^(?:0|-?[1-9][0-9]{0,8})\z/) { # safe decimal number
577 $out .= $val;
578 }
579 else { # string
580 if ($s->{useqq} or $val =~ tr/\0-\377//c) {
581 # Fall back to qq if there's Unicode
582 $out .= qquote($val, $s->{useqq});
583 }
584 else {
585 $out .= _quote($val);
586 }
587 }
588 }
589 if ($id) {
590 # if we made it this far, $id was added to seen list at current
591 # level, so remove it to get deep copies
592 if ($s->{deepcopy}) {
593 delete($s->{seen}{$id});
594 }
595 elsif ($name) {
596 $s->{seen}{$id}[2] = 1;
597 }
598 }
599 return $out;
600}
601
602#
603# non-OO style of earlier version
604#
605sub Dumper {
606 return Data::Dumper->Dump([@_]);
607}
608
609# compat stub
610sub DumperX {
611 return Data::Dumper->Dumpxs([@_], []);
612}
613
614#
615# reset the "seen" cache
616#
617sub Reset {
618 my($s) = shift;
619 $s->{seen} = {};
620 return $s;
621}
622
623sub Indent {
624 my($s, $v) = @_;
625 if (@_ >= 2) {
626 if ($v == 0) {
627 $s->{xpad} = "";
628 $s->{sep} = "";
629 }
630 else {
631 $s->{xpad} = " ";
632 $s->{sep} = "\n";
633 }
634 $s->{indent} = $v;
635 return $s;
636 }
637 else {
638 return $s->{indent};
639 }
640}
641
642sub Trailingcomma {
643 my($s, $v) = @_;
644 @_ >= 2 ? (($s->{trailingcomma} = $v), return $s) : $s->{trailingcomma};
645}
646
647sub Pair {
648 my($s, $v) = @_;
649 @_ >= 2 ? (($s->{pair} = $v), return $s) : $s->{pair};
650}
651
652sub Pad {
653 my($s, $v) = @_;
654 @_ >= 2 ? (($s->{pad} = $v), return $s) : $s->{pad};
655}
656
657sub Varname {
658 my($s, $v) = @_;
659 @_ >= 2 ? (($s->{varname} = $v), return $s) : $s->{varname};
660}
661
662sub Purity {
663 my($s, $v) = @_;
664 @_ >= 2 ? (($s->{purity} = $v), return $s) : $s->{purity};
665}
666
667sub Useqq {
668 my($s, $v) = @_;
669 @_ >= 2 ? (($s->{useqq} = $v), return $s) : $s->{useqq};
670}
671
672sub Terse {
673 my($s, $v) = @_;
674 @_ >= 2 ? (($s->{terse} = $v), return $s) : $s->{terse};
675}
676
677sub Freezer {
678 my($s, $v) = @_;
679 @_ >= 2 ? (($s->{freezer} = $v), return $s) : $s->{freezer};
680}
681
682sub Toaster {
683 my($s, $v) = @_;
684 @_ >= 2 ? (($s->{toaster} = $v), return $s) : $s->{toaster};
685}
686
687sub Deepcopy {
688 my($s, $v) = @_;
689 @_ >= 2 ? (($s->{deepcopy} = $v), return $s) : $s->{deepcopy};
690}
691
692sub Quotekeys {
693 my($s, $v) = @_;
694 @_ >= 2 ? (($s->{quotekeys} = $v), return $s) : $s->{quotekeys};
695}
696
697sub Bless {
698 my($s, $v) = @_;
699 @_ >= 2 ? (($s->{'bless'} = $v), return $s) : $s->{'bless'};
700}
701
702sub Maxdepth {
703 my($s, $v) = @_;
704 @_ >= 2 ? (($s->{'maxdepth'} = $v), return $s) : $s->{'maxdepth'};
705}
706
707sub Maxrecurse {
708 my($s, $v) = @_;
709 @_ >= 2 ? (($s->{'maxrecurse'} = $v), return $s) : $s->{'maxrecurse'};
710}
711
712sub Useperl {
713 my($s, $v) = @_;
714 @_ >= 2 ? (($s->{'useperl'} = $v), return $s) : $s->{'useperl'};
715}
716
717sub Sortkeys {
718 my($s, $v) = @_;
719 @_ >= 2 ? (($s->{'sortkeys'} = $v), return $s) : $s->{'sortkeys'};
720}
721
722sub Deparse {
723 my($s, $v) = @_;
724 @_ >= 2 ? (($s->{'deparse'} = $v), return $s) : $s->{'deparse'};
725}
726
727sub Sparseseen {
728 my($s, $v) = @_;
729 @_ >= 2 ? (($s->{'noseen'} = $v), return $s) : $s->{'noseen'};
730}
731
732# used by qquote below
73313µsmy %esc = (
734 "\a" => "\\a",
735 "\b" => "\\b",
736 "\t" => "\\t",
737 "\n" => "\\n",
738 "\f" => "\\f",
739 "\r" => "\\r",
740 "\e" => "\\e",
741);
742
743# The low controls are considered to be everything below SPACE, plus the
744# outlier \c? control (but that wasn't properly in existence in early perls,
745# so reconstruct its value here. This abandons EBCDIC support for this
746# character for perls below 5.8)
747114µsmy $low_controls = join "", map { quotemeta chr $_ } 0.. (ord(" ") - 1);
74811µs$low_controls .= ($] < 5.008 || $IS_ASCII)
749 ? "\x7f"
750 : chr utf8::unicode_to_native(0x9F);
751116µs29µsmy $low_controls_re = qr/[$low_controls]/;
# spent 7µs making 1 call to Data::Dumper::CORE:regcomp # spent 2µs making 1 call to Data::Dumper::CORE:qr
752
753# put a string value in double quotes
754sub qquote {
755 local($_) = shift;
756 s/([\\\"\@\$])/\\$1/g;
757
758 # This efficiently changes the high ordinal characters to \x{} if the utf8
759 # flag is on. On ASCII platforms, the high ordinals are all the
760 # non-ASCII's. On EBCDIC platforms, we don't include in these the non-ASCII
761 # controls.
7622374µs218µs
# spent 14µs (10+4) within Data::Dumper::BEGIN@762 which was called: # once (10µs+4µs) by Mojo::Util::BEGIN@5 at line 762
my $bytes; { use bytes; $bytes = length }
# spent 14µs making 1 call to Data::Dumper::BEGIN@762 # spent 4µs making 1 call to bytes::import
763 s/([^[:ascii:]$low_controls])/sprintf("\\x{%x}",ord($1))/ge
764 if $bytes > length;
765
766 return qq("$_") unless /[[:^print:]]/; # fast exit if only printables
767
768 # Here, there is at least one non-printable to output. First, translate the
769 # escapes.
770 s/([\a\b\t\n\f\r\e])/$esc{$1}/g;
771
772 # no need for 3 digits in escape for octals not followed by a digit.
773 s/($low_controls_re)(?!\d)/'\\'.sprintf('%o',ord($1))/eg;
774
775 # But otherwise use 3 digits
776 s/($low_controls_re)/'\\'.sprintf('%03o',ord($1))/eg;
777
778 # all but last branch below not supported --BEHAVIOR SUBJECT TO CHANGE--
779 my $high = shift || "";
780 if ($high eq "iso8859") { # Doesn't escape the Latin1 printables
781 # Could use /u and [:cntrl:] etc, if khw were confident it worked in
782 # early early perls
783 s/([\200-\240])/'\\'.sprintf('%o',ord($1))/eg if $IS_ASCII;
784 } elsif ($high eq "utf8") {
785# Some discussion of what to do here is in
786# https://rt.perl.org/Ticket/Display.html?id=113088
787# use utf8;
788# $str =~ s/([^\040-\176])/sprintf "\\x{%04x}", ord($1)/ge;
789 } elsif ($high eq "8bit") {
790 # leave it as it is
791 } else {
792 s/([[:^ascii:]])/'\\'.sprintf('%03o',ord($1))/eg;
793 #s/([^\040-\176])/sprintf "\\x{%04x}", ord($1)/ge;
794 }
795
796 return qq("$_");
797}
798
799sub _refine_name {
800 my $s = shift;
801 my ($name, $val, $i) = @_;
802 if (defined $name) {
803 if ($name =~ /^[*](.*)$/) {
804 if (defined $val) {
805 $name = (ref $val eq 'ARRAY') ? ( "\@" . $1 ) :
806 (ref $val eq 'HASH') ? ( "\%" . $1 ) :
807 (ref $val eq 'CODE') ? ( "\*" . $1 ) :
808 ( "\$" . $1 ) ;
809 }
810 else {
811 $name = "\$" . $1;
812 }
813 }
814 elsif ($name !~ /^\$/) {
815 $name = "\$" . $name;
816 }
817 }
818 else { # no names provided
819 $name = "\$" . $s->{varname} . $i;
820 }
821 return $name;
822}
823
824sub _compose_out {
825 my $s = shift;
826 my ($valstr, $postref) = @_;
827 my $out = "";
828 $out .= $s->{pad} . $valstr . $s->{sep};
829 if (@{$postref}) {
830 $out .= $s->{pad} .
831 join(';' . $s->{sep} . $s->{pad}, @{$postref}) .
832 ';' .
833 $s->{sep};
834 }
835 return $out;
836}
837
838111µs1;
839__END__
 
# spent 2µs within Data::Dumper::CORE:qr which was called: # once (2µs+0s) by Mojo::Util::BEGIN@5 at line 751
sub Data::Dumper::CORE:qr; # opcode
# spent 7µs within Data::Dumper::CORE:regcomp which was called: # once (7µs+0s) by Mojo::Util::BEGIN@5 at line 751
sub Data::Dumper::CORE:regcomp; # opcode
# spent 7µs within Data::Dumper::_vstring which was called: # once (7µs+0s) by Data::Dumper::BEGIN@258 at line 258
sub Data::Dumper::_vstring; # xsub
Report produced by the NYTProf 6.12 Perl profiler, developed by Tim Bunce based on work by Adam Kaplan and Salvador Fandiño García.