← Index
NYTProf Performance Profile   « line view »
For webmerge/scripts/webmerge.pl
  Run on Mon Oct 7 02:42:42 2013
Reported on Mon Oct 7 03:03:28 2013

Filename/usr/lib64/perl5/5.16.0/x86_64-linux/Data/Dumper.pm
StatementsExecuted 37 statements in 53.2ms
Subroutines
Calls P F Exclusive
Time		 Inclusive
Time		 Subroutine
111159µs159µsData::Dumper::::BEGIN@18Data::Dumper::BEGIN@18
111158µs514µsData::Dumper::::BEGIN@275Data::Dumper::BEGIN@275
111120µs26.8msData::Dumper::::BEGIN@24Data::Dumper::BEGIN@24
11177µs95µsData::Dumper::::BEGIN@718Data::Dumper::BEGIN@718
11156µs321µsData::Dumper::::BEGIN@22Data::Dumper::BEGIN@22
11153µs53µsData::Dumper::::BEGIN@12Data::Dumper::BEGIN@12
11127µs27µsData::Dumper::::_vstringData::Dumper::_vstring (xsub)
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::::DumpfData::Dumper::Dumpf
0000s0sData::Dumper::::DumppData::Dumper::Dumpp
0000s0sData::Dumper::::DumpperlData::Dumper::Dumpperl
0000s0sData::Dumper::::FreezerData::Dumper::Freezer
0000s0sData::Dumper::::IndentData::Dumper::Indent
0000s0sData::Dumper::::MaxdepthData::Dumper::Maxdepth
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::::TerseData::Dumper::Terse
0000s0sData::Dumper::::ToasterData::Dumper::Toaster
0000s0sData::Dumper::::UseperlData::Dumper::Useperl
0000s0sData::Dumper::::UseqqData::Dumper::Useqq
0000s0sData::Dumper::::ValuesData::Dumper::Values
0000s0sData::Dumper::::VarnameData::Dumper::Varname
0000s0sData::Dumper::::_dumpData::Dumper::_dump
0000s0sData::Dumper::::_quoteData::Dumper::_quote
0000s0sData::Dumper::::_sortkeysData::Dumper::_sortkeys
0000s0sData::Dumper::::format_refaddrData::Dumper::format_refaddr
0000s0sData::Dumper::::init_refaddr_formatData::Dumper::init_refaddr_format
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
12
# spent 53µs within Data::Dumper::BEGIN@12 which was called: # once (53µs+0s) by XML::LibXML::Error::BEGIN@257 at line 14
BEGIN {
13137µs $VERSION = '2.135_06'; # Don't forget to set version and release
141114µs153µs} # date in POD!
# spent 53µs making 1 call to Data::Dumper::BEGIN@12
15
16#$| = 1;
17
182444µs1159µs
# spent 159µs within Data::Dumper::BEGIN@18 which was called: # once (159µs+0s) by XML::LibXML::Error::BEGIN@257 at line 18
use 5.006_001;
# spent 159µs making 1 call to Data::Dumper::BEGIN@18
1914µsrequire Exporter;
2012µsrequire overload;
21
222440µs2585µs
# spent 321µs (56+264) within Data::Dumper::BEGIN@22 which was called: # once (56µs+264µs) by XML::LibXML::Error::BEGIN@257 at line 22
use Carp;
# spent 321µs making 1 call to Data::Dumper::BEGIN@22 # spent 264µs making 1 call to Exporter::import
23
24
# spent 26.8ms (120µs+26.7) within Data::Dumper::BEGIN@24 which was called: # once (120µs+26.7ms) by XML::LibXML::Error::BEGIN@257 at line 38
BEGIN {
25132µs @ISA = qw(Exporter);
2615µs @EXPORT = qw(Dumper);
2713µs @EXPORT_OK = qw(DumperX);
28
29 # if run under miniperl, or otherwise lacking dynamic loading,
30 # XSLoader should be attempted to load, or the pure perl flag
31 # toggled on load failure.
32124µs eval {
3314µs require XSLoader;
34126.8ms126.7ms XSLoader::load( 'Data::Dumper' );
# spent 26.7ms making 1 call to XSLoader::load
3515µs 1
36 }
37 or $Useperl = 1;
3817.10ms126.8ms}
# spent 26.8ms making 1 call to Data::Dumper::BEGIN@24
39
40# module vars and their defaults
4113µs$Indent = 2 unless defined $Indent;
4211µs$Purity = 0 unless defined $Purity;
4313µs$Pad = "" unless defined $Pad;
4412µs$Varname = "VAR" unless defined $Varname;
451800ns$Useqq = 0 unless defined $Useqq;
461900ns$Terse = 0 unless defined $Terse;
4711µs$Freezer = "" unless defined $Freezer;
4811µs$Toaster = "" unless defined $Toaster;
491800ns$Deepcopy = 0 unless defined $Deepcopy;
501900ns$Quotekeys = 1 unless defined $Quotekeys;
5111µs$Bless = "bless" unless defined $Bless;
52#$Expdepth = 0 unless defined $Expdepth;
531800ns$Maxdepth = 0 unless defined $Maxdepth;
5411µs$Pair = ' => ' unless defined $Pair;
551800ns$Useperl = 0 unless defined $Useperl;
561700ns$Sortkeys = 0 unless defined $Sortkeys;
571800ns$Deparse = 0 unless defined $Deparse;
58
59#
60# expects an arrayref of values to be dumped.
61# can optionally pass an arrayref of names for the values.
62# names must have leading $ sign stripped. begin the name with *
63# to cause output of arrays and hashes rather than refs.
64#
65sub new {
66 my($c, $v, $n) = @_;
67
68 croak "Usage: PACKAGE->new(ARRAYREF, [ARRAYREF])"
69 unless (defined($v) && (ref($v) eq 'ARRAY'));
70 $n = [] unless (defined($n) && (ref($n) eq 'ARRAY'));
71
72 my($s) = {
73 level => 0, # current recursive depth
74 indent => $Indent, # various styles of indenting
75 pad => $Pad, # all lines prefixed by this string
76 xpad => "", # padding-per-level
77 apad => "", # added padding for hash keys n such
78 sep => "", # list separator
79 pair => $Pair, # hash key/value separator: defaults to ' => '
80 seen => {}, # local (nested) refs (id => [name, val])
81 todump => $v, # values to dump []
82 names => $n, # optional names for values []
83 varname => $Varname, # prefix to use for tagging nameless ones
84 purity => $Purity, # degree to which output is evalable
85 useqq => $Useqq, # use "" for strings (backslashitis ensues)
86 terse => $Terse, # avoid name output (where feasible)
87 freezer => $Freezer, # name of Freezer method for objects
88 toaster => $Toaster, # name of method to revive objects
89 deepcopy => $Deepcopy, # dont cross-ref, except to stop recursion
90 quotekeys => $Quotekeys, # quote hash keys
91 'bless' => $Bless, # keyword to use for "bless"
92# expdepth => $Expdepth, # cutoff depth for explicit dumping
93 maxdepth => $Maxdepth, # depth beyond which we give up
94 useperl => $Useperl, # use the pure Perl implementation
95 sortkeys => $Sortkeys, # flag or filter for sorting hash keys
96 deparse => $Deparse, # use B::Deparse for coderefs
97 };
98
99 if ($Indent > 0) {
100 $s->{xpad} = " ";
101 $s->{sep} = "\n";
102 }
103 return bless($s, $c);
104}
105
106# Packed numeric addresses take less memory. Plus pack is faster than sprintf
107
108# Most users of current versions of Data::Dumper will be 5.008 or later.
109# Anyone on 5.6.1 and 5.6.2 upgrading will be rare (particularly judging by
110# the bug reports from users on those platforms), so for the common case avoid
111# complexity, and avoid even compiling the unneeded code.
112
113sub init_refaddr_format {
114}
115
116sub format_refaddr {
117 require Scalar::Util;
118 pack "J", Scalar::Util::refaddr(shift);
119};
120
12115µsif ($] < 5.008) {
122 eval <<'EOC' or die;
123 no warnings 'redefine';
124 my $refaddr_format;
125 sub init_refaddr_format {
126 require Config;
127 my $f = $Config::Config{uvxformat};
128 $f =~ tr/"//d;
129 $refaddr_format = "0x%" . $f;
130 }
131
132 sub format_refaddr {
133 require Scalar::Util;
134 sprintf $refaddr_format, Scalar::Util::refaddr(shift);
135 }
136
137 1
138EOC
139}
140
141#
142# add-to or query the table of already seen references
143#
144sub Seen {
145 my($s, $g) = @_;
146 if (defined($g) && (ref($g) eq 'HASH')) {
147 init_refaddr_format();
148 my($k, $v, $id);
149 while (($k, $v) = each %$g) {
150 if (defined $v and ref $v) {
151 $id = format_refaddr($v);
152 if ($k =~ /^[*](.*)$/) {
153 $k = (ref $v eq 'ARRAY') ? ( "\\\@" . $1 ) :
154 (ref $v eq 'HASH') ? ( "\\\%" . $1 ) :
155 (ref $v eq 'CODE') ? ( "\\\&" . $1 ) :
156 ( "\$" . $1 ) ;
157 }
158 elsif ($k !~ /^\$/) {
159 $k = "\$" . $k;
160 }
161 $s->{seen}{$id} = [$k, $v];
162 }
163 else {
164 carp "Only refs supported, ignoring non-ref item \$$k";
165 }
166 }
167 return $s;
168 }
169 else {
170 return map { @$_ } values %{$s->{seen}};
171 }
172}
173
174#
175# set or query the values to be dumped
176#
177sub Values {
178 my($s, $v) = @_;
179 if (defined($v) && (ref($v) eq 'ARRAY')) {
180 $s->{todump} = [@$v]; # make a copy
181 return $s;
182 }
183 else {
184 return @{$s->{todump}};
185 }
186}
187
188#
189# set or query the names of the values to be dumped
190#
191sub Names {
192 my($s, $n) = @_;
193 if (defined($n) && (ref($n) eq 'ARRAY')) {
194 $s->{names} = [@$n]; # make a copy
195 return $s;
196 }
197 else {
198 return @{$s->{names}};
199 }
200}
201
202sub DESTROY {}
203
204sub Dump {
205 return &Dumpxs
206 unless $Data::Dumper::Useperl || (ref($_[0]) && $_[0]->{useperl}) ||
207 $Data::Dumper::Useqq || (ref($_[0]) && $_[0]->{useqq}) ||
208 $Data::Dumper::Deparse || (ref($_[0]) && $_[0]->{deparse});
209 return &Dumpperl;
210}
211
212#
213# dump the refs in the current dumper object.
214# expects same args as new() if called via package name.
215#
216sub Dumpperl {
217 my($s) = shift;
218 my(@out, $val, $name);
219 my($i) = 0;
220 local(@post);
221 init_refaddr_format();
222
223 $s = $s->new(@_) unless ref $s;
224
225 for $val (@{$s->{todump}}) {
226 my $out = "";
227 @post = ();
228 $name = $s->{names}[$i++];
229 if (defined $name) {
230 if ($name =~ /^[*](.*)$/) {
231 if (defined $val) {
232 $name = (ref $val eq 'ARRAY') ? ( "\@" . $1 ) :
233 (ref $val eq 'HASH') ? ( "\%" . $1 ) :
234 (ref $val eq 'CODE') ? ( "\*" . $1 ) :
235 ( "\$" . $1 ) ;
236 }
237 else {
238 $name = "\$" . $1;
239 }
240 }
241 elsif ($name !~ /^\$/) {
242 $name = "\$" . $name;
243 }
244 }
245 else {
246 $name = "\$" . $s->{varname} . $i;
247 }
248
249 my $valstr;
250 {
251 local($s->{apad}) = $s->{apad};
252 $s->{apad} .= ' ' x (length($name) + 3) if $s->{indent} >= 2 and !$s->{terse};
253 $valstr = $s->_dump($val, $name);
254 }
255
256 $valstr = "$name = " . $valstr . ';' if @post or !$s->{terse};
257 $out .= $s->{pad} . $valstr . $s->{sep};
258 $out .= $s->{pad} . join(';' . $s->{sep} . $s->{pad}, @post)
259 . ';' . $s->{sep} if @post;
260
261 push @out, $out;
262 }
263 return wantarray ? @out : join('', @out);
264}
265
266# wrap string in single quotes (escaping if needed)
267sub _quote {
268 my $val = shift;
269 $val =~ s/([\\\'])/\\$1/g;
270 return "'" . $val . "'";
271}
272
273# Old Perls (5.14-) have trouble resetting vstring magic when it is no
274# longer valid.
275216.2ms3871µs
# spent 514µs (158+357) within Data::Dumper::BEGIN@275 which was called: # once (158µs+357µs) by XML::LibXML::Error::BEGIN@257 at line 275
use constant _bad_vsmg => defined &_vstring && (_vstring(~v0)||'') eq "v0";
# spent 514µs making 1 call to Data::Dumper::BEGIN@275 # spent 329µs making 1 call to constant::import # spent 27µs making 1 call to Data::Dumper::_vstring
276
277#
278# twist, toil and turn;
279# and recurse, of course.
280# sometimes sordidly;
281# and curse if no recourse.
282#
283sub _dump {
284 my($s, $val, $name) = @_;
285 my($sname);
286 my($out, $realpack, $realtype, $type, $ipad, $id, $blesspad);
287
288 $type = ref $val;
289 $out = "";
290
291 if ($type) {
292
293 # Call the freezer method if it's specified and the object has the
294 # method. Trap errors and warn() instead of die()ing, like the XS
295 # implementation.
296 my $freezer = $s->{freezer};
297 if ($freezer and UNIVERSAL::can($val, $freezer)) {
298 eval { $val->$freezer() };
299 warn "WARNING(Freezer method call failed): $@" if $@;
300 }
301
302 require Scalar::Util;
303 $realpack = Scalar::Util::blessed($val);
304 $realtype = $realpack ? Scalar::Util::reftype($val) : ref $val;
305 $id = format_refaddr($val);
306
307 # if it has a name, we need to either look it up, or keep a tab
308 # on it so we know when we hit it later
309 if (defined($name) and length($name)) {
310 # keep a tab on it so that we dont fall into recursive pit
311 if (exists $s->{seen}{$id}) {
312# if ($s->{expdepth} < $s->{level}) {
313 if ($s->{purity} and $s->{level} > 0) {
314 $out = ($realtype eq 'HASH') ? '{}' :
315 ($realtype eq 'ARRAY') ? '[]' :
316 'do{my $o}' ;
317 push @post, $name . " = " . $s->{seen}{$id}[0];
318 }
319 else {
320 $out = $s->{seen}{$id}[0];
321 if ($name =~ /^([\@\%])/) {
322 my $start = $1;
323 if ($out =~ /^\\$start/) {
324 $out = substr($out, 1);
325 }
326 else {
327 $out = $start . '{' . $out . '}';
328 }
329 }
330 }
331 return $out;
332# }
333 }
334 else {
335 # store our name
336 $s->{seen}{$id} = [ (($name =~ /^[@%]/) ? ('\\' . $name ) :
337 ($realtype eq 'CODE' and
338 $name =~ /^[*](.*)$/) ? ('\\&' . $1 ) :
339 $name ),
340 $val ];
341 }
342 }
343 my $no_bless = 0;
344 my $is_regex = 0;
345 if ( $realpack and ($] >= 5.009005 ? re::is_regexp($val) : $realpack eq 'Regexp') ) {
346 $is_regex = 1;
347 $no_bless = $realpack eq 'Regexp';
348 }
349
350 # If purity is not set and maxdepth is set, then check depth:
351 # if we have reached maximum depth, return the string
352 # representation of the thing we are currently examining
353 # at this depth (i.e., 'Foo=ARRAY(0xdeadbeef)').
354 if (!$s->{purity}
355 and $s->{maxdepth} > 0
356 and $s->{level} >= $s->{maxdepth})
357 {
358 return qq['$val'];
359 }
360
361 # we have a blessed ref
362 if ($realpack and !$no_bless) {
363 $out = $s->{'bless'} . '( ';
364 $blesspad = $s->{apad};
365 $s->{apad} .= ' ' if ($s->{indent} >= 2);
366 }
367
368 $s->{level}++;
369 $ipad = $s->{xpad} x $s->{level};
370
371 if ($is_regex) {
372 my $pat;
373 # This really sucks, re:regexp_pattern is in ext/re/re.xs and not in
374 # universal.c, and even worse we cant just require that re to be loaded
375 # we *have* to use() it.
376 # We should probably move it to universal.c for 5.10.1 and fix this.
377 # Currently we only use re::regexp_pattern when the re is blessed into another
378 # package. This has the disadvantage of meaning that a DD dump won't round trip
379 # as the pattern will be repeatedly wrapped with the same modifiers.
380 # This is an aesthetic issue so we will leave it for now, but we could use
381 # regexp_pattern() in list context to get the modifiers separately.
382 # But since this means loading the full debugging engine in process we wont
383 # bother unless its necessary for accuracy.
384 if (($realpack ne 'Regexp') && defined(*re::regexp_pattern{CODE})) {
385 $pat = re::regexp_pattern($val);
386 } else {
387 $pat = "$val";
388 }
389 $pat =~ s <(\\.)|/> { $1 || '\\/' }ge;
390 $out .= "qr/$pat/";
391 }
392 elsif ($realtype eq 'SCALAR' || $realtype eq 'REF'
393 || $realtype eq 'VSTRING') {
394 if ($realpack) {
395 $out .= 'do{\\(my $o = ' . $s->_dump($$val, "\${$name}") . ')}';
396 }
397 else {
398 $out .= '\\' . $s->_dump($$val, "\${$name}");
399 }
400 }
401 elsif ($realtype eq 'GLOB') {
402 $out .= '\\' . $s->_dump($$val, "*{$name}");
403 }
404 elsif ($realtype eq 'ARRAY') {
405 my($pad, $mname);
406 my($i) = 0;
407 $out .= ($name =~ /^\@/) ? '(' : '[';
408 $pad = $s->{sep} . $s->{pad} . $s->{apad};
409 ($name =~ /^\@(.*)$/) ? ($mname = "\$" . $1) :
410 # omit -> if $foo->[0]->{bar}, but not ${$foo->[0]}->{bar}
411 ($name =~ /^\\?[\%\@\*\$][^{].*[]}]$/) ? ($mname = $name) :
412 ($mname = $name . '->');
413 $mname .= '->' if $mname =~ /^\*.+\{[A-Z]+\}$/;
414 for my $v (@$val) {
415 $sname = $mname . '[' . $i . ']';
416 $out .= $pad . $ipad . '#' . $i if $s->{indent} >= 3;
417 $out .= $pad . $ipad . $s->_dump($v, $sname);
418 $out .= "," if $i++ < $#$val;
419 }
420 $out .= $pad . ($s->{xpad} x ($s->{level} - 1)) if $i;
421 $out .= ($name =~ /^\@/) ? ')' : ']';
422 }
423 elsif ($realtype eq 'HASH') {
424 my($k, $v, $pad, $lpad, $mname, $pair);
425 $out .= ($name =~ /^\%/) ? '(' : '{';
426 $pad = $s->{sep} . $s->{pad} . $s->{apad};
427 $lpad = $s->{apad};
428 $pair = $s->{pair};
429 ($name =~ /^\%(.*)$/) ? ($mname = "\$" . $1) :
430 # omit -> if $foo->[0]->{bar}, but not ${$foo->[0]}->{bar}
431 ($name =~ /^\\?[\%\@\*\$][^{].*[]}]$/) ? ($mname = $name) :
432 ($mname = $name . '->');
433 $mname .= '->' if $mname =~ /^\*.+\{[A-Z]+\}$/;
434 my ($sortkeys, $keys, $key) = ("$s->{sortkeys}");
435 if ($sortkeys) {
436 if (ref($s->{sortkeys}) eq 'CODE') {
437 $keys = $s->{sortkeys}($val);
438 unless (ref($keys) eq 'ARRAY') {
439 carp "Sortkeys subroutine did not return ARRAYREF";
440 $keys = [];
441 }
442 }
443 else {
444 $keys = [ sort keys %$val ];
445 }
446 }
447
448 # Ensure hash iterator is reset
449 keys(%$val);
450
451 while (($k, $v) = ! $sortkeys ? (each %$val) :
452 @$keys ? ($key = shift(@$keys), $val->{$key}) :
453 () )
454 {
455 my $nk = $s->_dump($k, "");
456 $nk = $1 if !$s->{quotekeys} and $nk =~ /^[\"\']([A-Za-z_]\w*)[\"\']$/;
457 $sname = $mname . '{' . $nk . '}';
458 $out .= $pad . $ipad . $nk . $pair;
459
460 # temporarily alter apad
461 $s->{apad} .= (" " x (length($nk) + 4)) if $s->{indent} >= 2;
462 $out .= $s->_dump($val->{$k}, $sname) . ",";
463 $s->{apad} = $lpad if $s->{indent} >= 2;
464 }
465 if (substr($out, -1) eq ',') {
466 chop $out;
467 $out .= $pad . ($s->{xpad} x ($s->{level} - 1));
468 }
469 $out .= ($name =~ /^\%/) ? ')' : '}';
470 }
471 elsif ($realtype eq 'CODE') {
472 if ($s->{deparse}) {
473 require B::Deparse;
474 my $sub = 'sub ' . (B::Deparse->new)->coderef2text($val);
475 $pad = $s->{sep} . $s->{pad} . $s->{apad} . $s->{xpad} x ($s->{level} - 1);
476 $sub =~ s/\n/$pad/gse;
477 $out .= $sub;
478 } else {
479 $out .= 'sub { "DUMMY" }';
480 carp "Encountered CODE ref, using dummy placeholder" if $s->{purity};
481 }
482 }
483 else {
484 croak "Can\'t handle $realtype type.";
485 }
486
487 if ($realpack and !$no_bless) { # we have a blessed ref
488 $out .= ', ' . _quote($realpack) . ' )';
489 $out .= '->' . $s->{toaster} . '()' if $s->{toaster} ne '';
490 $s->{apad} = $blesspad;
491 }
492 $s->{level}--;
493
494 }
495 else { # simple scalar
496
497 my $ref = \$_[1];
498 my $v;
499 # first, catalog the scalar
500 if ($name ne '') {
501 $id = format_refaddr($ref);
502 if (exists $s->{seen}{$id}) {
503 if ($s->{seen}{$id}[2]) {
504 $out = $s->{seen}{$id}[0];
505 #warn "[<$out]\n";
506 return "\${$out}";
507 }
508 }
509 else {
510 #warn "[>\\$name]\n";
511 $s->{seen}{$id} = ["\\$name", $ref];
512 }
513 }
514 $ref = \$val;
515 if (ref($ref) eq 'GLOB') { # glob
516 my $name = substr($val, 1);
517 if ($name =~ /^[A-Za-z_][\w:]*$/ && $name ne 'main::') {
518 $name =~ s/^main::/::/;
519 $sname = $name;
520 }
521 else {
522 $sname = $s->_dump(
523 $name eq 'main::' || $] < 5.007 && $name eq "main::\0"
524 ? ''
525 : $name,
526 "",
527 );
528 $sname = '{' . $sname . '}';
529 }
530 if ($s->{purity}) {
531 my $k;
532 local ($s->{level}) = 0;
533 for $k (qw(SCALAR ARRAY HASH)) {
534 my $gval = *$val{$k};
535 next unless defined $gval;
536 next if $k eq "SCALAR" && ! defined $$gval; # always there
537
538 # _dump can push into @post, so we hold our place using $postlen
539 my $postlen = scalar @post;
540 $post[$postlen] = "\*$sname = ";
541 local ($s->{apad}) = " " x length($post[$postlen]) if $s->{indent} >= 2;
542 $post[$postlen] .= $s->_dump($gval, "\*$sname\{$k\}");
543 }
544 }
545 $out .= '*' . $sname;
546 }
547 elsif (!defined($val)) {
548 $out .= "undef";
549 }
550 elsif (defined &_vstring and $v = _vstring($val)
551 and !_bad_vsmg || eval $v eq $val) {
552 $out .= $v;
553 }
554 elsif (!defined &_vstring
555 and ref $ref eq 'VSTRING' || eval{Scalar::Util::isvstring($val)}) {
556 $out .= sprintf "%vd", $val;
557 }
558 elsif ($val =~ /^(?:0|-?[1-9]\d{0,8})\z/) { # safe decimal number
559 $out .= $val;
560 }
561 else { # string
562 if ($s->{useqq} or $val =~ tr/\0-\377//c) {
563 # Fall back to qq if there's Unicode
564 $out .= qquote($val, $s->{useqq});
565 }
566 else {
567 $out .= _quote($val);
568 }
569 }
570 }
571 if ($id) {
572 # if we made it this far, $id was added to seen list at current
573 # level, so remove it to get deep copies
574 if ($s->{deepcopy}) {
575 delete($s->{seen}{$id});
576 }
577 elsif ($name) {
578 $s->{seen}{$id}[2] = 1;
579 }
580 }
581 return $out;
582}
583
584#
585# non-OO style of earlier version
586#
587sub Dumper {
588 return Data::Dumper->Dump([@_]);
589}
590
591# compat stub
592sub DumperX {
593 return Data::Dumper->Dumpxs([@_], []);
594}
595
596sub Dumpf { return Data::Dumper->Dump(@_) }
597
598sub Dumpp { print Data::Dumper->Dump(@_) }
599
600#
601# reset the "seen" cache
602#
603sub Reset {
604 my($s) = shift;
605 $s->{seen} = {};
606 return $s;
607}
608
609sub Indent {
610 my($s, $v) = @_;
611 if (defined($v)) {
612 if ($v == 0) {
613 $s->{xpad} = "";
614 $s->{sep} = "";
615 }
616 else {
617 $s->{xpad} = " ";
618 $s->{sep} = "\n";
619 }
620 $s->{indent} = $v;
621 return $s;
622 }
623 else {
624 return $s->{indent};
625 }
626}
627
628sub Pair {
629 my($s, $v) = @_;
630 defined($v) ? (($s->{pair} = $v), return $s) : $s->{pair};
631}
632
633sub Pad {
634 my($s, $v) = @_;
635 defined($v) ? (($s->{pad} = $v), return $s) : $s->{pad};
636}
637
638sub Varname {
639 my($s, $v) = @_;
640 defined($v) ? (($s->{varname} = $v), return $s) : $s->{varname};
641}
642
643sub Purity {
644 my($s, $v) = @_;
645 defined($v) ? (($s->{purity} = $v), return $s) : $s->{purity};
646}
647
648sub Useqq {
649 my($s, $v) = @_;
650 defined($v) ? (($s->{useqq} = $v), return $s) : $s->{useqq};
651}
652
653sub Terse {
654 my($s, $v) = @_;
655 defined($v) ? (($s->{terse} = $v), return $s) : $s->{terse};
656}
657
658sub Freezer {
659 my($s, $v) = @_;
660 defined($v) ? (($s->{freezer} = $v), return $s) : $s->{freezer};
661}
662
663sub Toaster {
664 my($s, $v) = @_;
665 defined($v) ? (($s->{toaster} = $v), return $s) : $s->{toaster};
666}
667
668sub Deepcopy {
669 my($s, $v) = @_;
670 defined($v) ? (($s->{deepcopy} = $v), return $s) : $s->{deepcopy};
671}
672
673sub Quotekeys {
674 my($s, $v) = @_;
675 defined($v) ? (($s->{quotekeys} = $v), return $s) : $s->{quotekeys};
676}
677
678sub Bless {
679 my($s, $v) = @_;
680 defined($v) ? (($s->{'bless'} = $v), return $s) : $s->{'bless'};
681}
682
683sub Maxdepth {
684 my($s, $v) = @_;
685 defined($v) ? (($s->{'maxdepth'} = $v), return $s) : $s->{'maxdepth'};
686}
687
688sub Useperl {
689 my($s, $v) = @_;
690 defined($v) ? (($s->{'useperl'} = $v), return $s) : $s->{'useperl'};
691}
692
693sub Sortkeys {
694 my($s, $v) = @_;
695 defined($v) ? (($s->{'sortkeys'} = $v), return $s) : $s->{'sortkeys'};
696}
697
698sub Deparse {
699 my($s, $v) = @_;
700 defined($v) ? (($s->{'deparse'} = $v), return $s) : $s->{'deparse'};
701}
702
703# used by qquote below
704121µsmy %esc = (
705 "\a" => "\\a",
706 "\b" => "\\b",
707 "\t" => "\\t",
708 "\n" => "\\n",
709 "\f" => "\\f",
710 "\r" => "\\r",
711 "\e" => "\\e",
712);
713
714# put a string value in double quotes
715sub qquote {
716 local($_) = shift;
717 s/([\\\"\@\$])/\\$1/g;
71821.96ms2112µs
# spent 95µs (77+18) within Data::Dumper::BEGIN@718 which was called: # once (77µs+18µs) by XML::LibXML::Error::BEGIN@257 at line 718
my $bytes; { use bytes; $bytes = length }
# spent 95µs making 1 call to Data::Dumper::BEGIN@718 # spent 18µs making 1 call to bytes::import
719 s/([^\x00-\x7f])/'\x{'.sprintf("%x",ord($1)).'}'/ge if $bytes > length;
720 return qq("$_") unless
721 /[^ !"\#\$%&'()*+,\-.\/0-9:;<=>?\@A-Z[\\\]^_`a-z{|}~]/; # fast exit
722
723 my $high = shift || "";
724 s/([\a\b\t\n\f\r\e])/$esc{$1}/g;
725
726 if (ord('^')==94) { # ascii
727 # no need for 3 digits in escape for these
728 s/([\0-\037])(?!\d)/'\\'.sprintf('%o',ord($1))/eg;
729 s/([\0-\037\177])/'\\'.sprintf('%03o',ord($1))/eg;
730 # all but last branch below not supported --BEHAVIOR SUBJECT TO CHANGE--
731 if ($high eq "iso8859") {
732 s/([\200-\240])/'\\'.sprintf('%o',ord($1))/eg;
733 } elsif ($high eq "utf8") {
734# use utf8;
735# $str =~ s/([^\040-\176])/sprintf "\\x{%04x}", ord($1)/ge;
736 } elsif ($high eq "8bit") {
737 # leave it as it is
738 } else {
739 s/([\200-\377])/'\\'.sprintf('%03o',ord($1))/eg;
740 s/([^\040-\176])/sprintf "\\x{%04x}", ord($1)/ge;
741 }
742 }
743 else { # ebcdic
744 s{([^ !"\#\$%&'()*+,\-.\/0-9:;<=>?\@A-Z[\\\]^_`a-z{|}~])(?!\d)}
745 {my $v = ord($1); '\\'.sprintf(($v <= 037 ? '%o' : '%03o'), $v)}eg;
746 s{([^ !"\#\$%&'()*+,\-.\/0-9:;<=>?\@A-Z[\\\]^_`a-z{|}~])}
747 {'\\'.sprintf('%03o',ord($1))}eg;
748 }
749
750 return qq("$_");
751}
752
753# helper sub to sort hash keys in Perl < 5.8.0 where we don't have
754# access to sortsv() from XS
755sub _sortkeys { [ sort keys %{$_[0]} ] }
756
757152µs1;
758__END__
 
# spent 27µs within Data::Dumper::_vstring which was called: # once (27µs+0s) by Data::Dumper::BEGIN@275 at line 275
sub Data::Dumper::_vstring; # xsub
Report produced by the NYTProf 5.05 Perl profiler, developed by Tim Bunce and Adam Kaplan.