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 12use strict; 13use warnings; 14 15#$| = 1; 16 17use 5.008_001; 18require Exporter; 19 20use constant IS_PRE_516_PERL => $] < 5.016; 21 22use Carp (); 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 31BEGIN { 32 $VERSION = '2.183'; # Don't forget to set version and release 33 # date in POD below! 34 35 @ISA = qw(Exporter); 36 @EXPORT = qw(Dumper); 37 @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. 42 eval { 43 require XSLoader; 44 XSLoader::load( 'Data::Dumper' ); 45 1 46 } 47 or $Useperl = 1; 48} 49 50my $IS_ASCII = ord 'A' == 65; 51 52# module vars and their defaults 53$Indent = 2 unless defined $Indent; 54$Trailingcomma = 0 unless defined $Trailingcomma; 55$Purity = 0 unless defined $Purity; 56$Pad = "" unless defined $Pad; 57$Varname = "VAR" unless defined $Varname; 58$Useqq = 0 unless defined $Useqq; 59$Terse = 0 unless defined $Terse; 60$Freezer = "" unless defined $Freezer; 61$Toaster = "" unless defined $Toaster; 62$Deepcopy = 0 unless defined $Deepcopy; 63$Quotekeys = 1 unless defined $Quotekeys; 64$Bless = "bless" unless defined $Bless; 65#$Expdepth = 0 unless defined $Expdepth; 66$Maxdepth = 0 unless defined $Maxdepth; 67$Pair = ' => ' unless defined $Pair; 68$Useperl = 0 unless defined $Useperl; 69$Sortkeys = 0 unless defined $Sortkeys; 70$Deparse = 0 unless defined $Deparse; 71$Sparseseen = 0 unless defined $Sparseseen; 72$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. 258use constant _bad_vsmg => defined &_vstring && (_vstring(~v0)||'') eq "v0"; 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 (\\.) # anything backslash escaped 369 | (\$)(?![)|]|\z) # any unescaped $, except $| $) and end 370 | / # any unescaped / 371 > 372 { 373 $1 ? $1 374 : $2 ? '${\q($)}' 375 : '\\/' 376 }gex; 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 733my %esc = ( 734 "\a" => "\\a", 735 "\b" => "\\b", 736 "\t" => "\\t", 737 "\n" => "\\n", 738 "\f" => "\\f", 739 "\r" => "\\r", 740 "\e" => "\\e", 741); 742 743my $low_controls = ($IS_ASCII) 744 745 # This includes \177, because traditionally it has been 746 # output as octal, even though it isn't really a "low" 747 # control 748 ? qr/[\0-\x1f\177]/ 749 750 # EBCDIC low controls. 751 : qr/[\0-\x3f]/; 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 whose ordinals are less than SPACE, excluded below by the range 762 # \0-\x3f. On ASCII platforms this range just compiles as part of :ascii:. 763 # On EBCDIC platforms, there is just one outlier high ordinal control, and 764 # it gets output as \x{}. 765 my $bytes; { use bytes; $bytes = length } 766 s/([^[:ascii:]\0-\x3f])/sprintf("\\x{%x}",ord($1))/ge 767 if $bytes > length 768 769 # The above doesn't get the EBCDIC outlier high ordinal control when 770 # the string is UTF-8 but there are no UTF-8 variant characters in it. 771 # We want that to come out as \x{} anyway. We need is_utf8() to do 772 # this. 773 || (! $IS_ASCII && utf8::is_utf8($_)); 774 775 return qq("$_") unless /[[:^print:]]/; # fast exit if only printables 776 777 # Here, there is at least one non-printable to output. First, translate the 778 # escapes. 779 s/([\a\b\t\n\f\r\e])/$esc{$1}/g; 780 781 # no need for 3 digits in escape for octals not followed by a digit. 782 s/($low_controls)(?!\d)/'\\'.sprintf('%o',ord($1))/eg; 783 784 # But otherwise use 3 digits 785 s/($low_controls)/'\\'.sprintf('%03o',ord($1))/eg; 786 787 # all but last branch below not supported --BEHAVIOR SUBJECT TO CHANGE-- 788 my $high = shift || ""; 789 if ($high eq "iso8859") { # Doesn't escape the Latin1 printables 790 if ($IS_ASCII) { 791 s/([\200-\240])/'\\'.sprintf('%o',ord($1))/eg; 792 } 793 else { 794 my $high_control = utf8::unicode_to_native(0x9F); 795 s/$high_control/sprintf('\\%o',ord($1))/eg; 796 } 797 } elsif ($high eq "utf8") { 798# Some discussion of what to do here is in 799# https://rt.perl.org/Ticket/Display.html?id=113088 800# use utf8; 801# $str =~ s/([^\040-\176])/sprintf "\\x{%04x}", ord($1)/ge; 802 } elsif ($high eq "8bit") { 803 # leave it as it is 804 } else { 805 s/([[:^ascii:]])/'\\'.sprintf('%03o',ord($1))/eg; 806 #s/([^\040-\176])/sprintf "\\x{%04x}", ord($1)/ge; 807 } 808 809 return qq("$_"); 810} 811 812sub _refine_name { 813 my $s = shift; 814 my ($name, $val, $i) = @_; 815 if (defined $name) { 816 if ($name =~ /^[*](.*)$/) { 817 if (defined $val) { 818 $name = (ref $val eq 'ARRAY') ? ( "\@" . $1 ) : 819 (ref $val eq 'HASH') ? ( "\%" . $1 ) : 820 (ref $val eq 'CODE') ? ( "\*" . $1 ) : 821 ( "\$" . $1 ) ; 822 } 823 else { 824 $name = "\$" . $1; 825 } 826 } 827 elsif ($name !~ /^\$/) { 828 $name = "\$" . $name; 829 } 830 } 831 else { # no names provided 832 $name = "\$" . $s->{varname} . $i; 833 } 834 return $name; 835} 836 837sub _compose_out { 838 my $s = shift; 839 my ($valstr, $postref) = @_; 840 my $out = ""; 841 $out .= $s->{pad} . $valstr . $s->{sep}; 842 if (@{$postref}) { 843 $out .= $s->{pad} . 844 join(';' . $s->{sep} . $s->{pad}, @{$postref}) . 845 ';' . 846 $s->{sep}; 847 } 848 return $out; 849} 850 8511; 852__END__ 853 854=head1 NAME 855 856Data::Dumper - stringified perl data structures, suitable for both printing and C<eval> 857 858=head1 SYNOPSIS 859 860 use Data::Dumper; 861 862 # simple procedural interface 863 print Dumper($foo, $bar); 864 865 # extended usage with names 866 print Data::Dumper->Dump([$foo, $bar], [qw(foo *ary)]); 867 868 # configuration variables 869 { 870 local $Data::Dumper::Purity = 1; 871 eval Data::Dumper->Dump([$foo, $bar], [qw(foo *ary)]); 872 } 873 874 # OO usage 875 $d = Data::Dumper->new([$foo, $bar], [qw(foo *ary)]); 876 ... 877 print $d->Dump; 878 ... 879 $d->Purity(1)->Terse(1)->Deepcopy(1); 880 eval $d->Dump; 881 882 883=head1 DESCRIPTION 884 885Given a list of scalars or reference variables, writes out their contents in 886perl syntax. The references can also be objects. The content of each 887variable is output in a single Perl statement. Handles self-referential 888structures correctly. 889 890The return value can be C<eval>ed to get back an identical copy of the 891original reference structure. (Please do consider the security implications 892of eval'ing code from untrusted sources!) 893 894Any references that are the same as one of those passed in will be named 895C<$VAR>I<n> (where I<n> is a numeric suffix), and other duplicate references 896to substructures within C<$VAR>I<n> will be appropriately labeled using arrow 897notation. You can specify names for individual values to be dumped if you 898use the C<Dump()> method, or you can change the default C<$VAR> prefix to 899something else. See C<$Data::Dumper::Varname> and C<$Data::Dumper::Terse> 900below. 901 902The default output of self-referential structures can be C<eval>ed, but the 903nested references to C<$VAR>I<n> will be undefined, since a recursive 904structure cannot be constructed using one Perl statement. You should set the 905C<Purity> flag to 1 to get additional statements that will correctly fill in 906these references. Moreover, if C<eval>ed when strictures are in effect, 907you need to ensure that any variables it accesses are previously declared. 908 909In the extended usage form, the references to be dumped can be given 910user-specified names. If a name begins with a C<*>, the output will 911describe the dereferenced type of the supplied reference for hashes and 912arrays, and coderefs. Output of names will be avoided where possible if 913the C<Terse> flag is set. 914 915In many cases, methods that are used to set the internal state of the 916object will return the object itself, so method calls can be conveniently 917chained together. 918 919Several styles of output are possible, all controlled by setting 920the C<Indent> flag. See L<Configuration Variables or Methods> below 921for details. 922 923 924=head2 Methods 925 926=over 4 927 928=item I<PACKAGE>->new(I<ARRAYREF [>, I<ARRAYREF]>) 929 930Returns a newly created C<Data::Dumper> object. The first argument is an 931anonymous array of values to be dumped. The optional second argument is an 932anonymous array of names for the values. The names need not have a leading 933C<$> sign, and must be comprised of alphanumeric characters. You can begin 934a name with a C<*> to specify that the dereferenced type must be dumped 935instead of the reference itself, for ARRAY and HASH references. 936 937The prefix specified by C<$Data::Dumper::Varname> will be used with a 938numeric suffix if the name for a value is undefined. 939 940Data::Dumper will catalog all references encountered while dumping the 941values. Cross-references (in the form of names of substructures in perl 942syntax) will be inserted at all possible points, preserving any structural 943interdependencies in the original set of values. Structure traversal is 944depth-first, and proceeds in order from the first supplied value to 945the last. 946 947=item I<$OBJ>->Dump I<or> I<PACKAGE>->Dump(I<ARRAYREF [>, I<ARRAYREF]>) 948 949Returns the stringified form of the values stored in the object (preserving 950the order in which they were supplied to C<new>), subject to the 951configuration options below. In a list context, it returns a list 952of strings corresponding to the supplied values. 953 954The second form, for convenience, simply calls the C<new> method on its 955arguments before dumping the object immediately. 956 957=item I<$OBJ>->Seen(I<[HASHREF]>) 958 959Queries or adds to the internal table of already encountered references. 960You must use C<Reset> to explicitly clear the table if needed. Such 961references are not dumped; instead, their names are inserted wherever they 962are encountered subsequently. This is useful especially for properly 963dumping subroutine references. 964 965Expects an anonymous hash of name => value pairs. Same rules apply for names 966as in C<new>. If no argument is supplied, will return the "seen" list of 967name => value pairs, in a list context. Otherwise, returns the object 968itself. 969 970=item I<$OBJ>->Values(I<[ARRAYREF]>) 971 972Queries or replaces the internal array of values that will be dumped. When 973called without arguments, returns the values as a list. When called with a 974reference to an array of replacement values, returns the object itself. When 975called with any other type of argument, dies. 976 977=item I<$OBJ>->Names(I<[ARRAYREF]>) 978 979Queries or replaces the internal array of user supplied names for the values 980that will be dumped. When called without arguments, returns the names. When 981called with an array of replacement names, returns the object itself. If the 982number of replacement names exceeds the number of values to be named, the 983excess names will not be used. If the number of replacement names falls short 984of the number of values to be named, the list of replacement names will be 985exhausted and remaining values will not be renamed. When 986called with any other type of argument, dies. 987 988=item I<$OBJ>->Reset 989 990Clears the internal table of "seen" references and returns the object 991itself. 992 993=back 994 995=head2 Functions 996 997=over 4 998 999=item Dumper(I<LIST>) 1000 1001Returns the stringified form of the values in the list, subject to the 1002configuration options below. The values will be named C<$VAR>I<n> in the 1003output, where I<n> is a numeric suffix. Will return a list of strings 1004in a list context. 1005 1006=back 1007 1008=head2 Configuration Variables or Methods 1009 1010Several configuration variables can be used to control the kind of output 1011generated when using the procedural interface. These variables are usually 1012C<local>ized in a block so that other parts of the code are not affected by 1013the change. 1014 1015These variables determine the default state of the object created by calling 1016the C<new> method, but cannot be used to alter the state of the object 1017thereafter. The equivalent method names should be used instead to query 1018or set the internal state of the object. 1019 1020The method forms return the object itself when called with arguments, 1021so that they can be chained together nicely. 1022 1023=over 4 1024 1025=item * 1026 1027$Data::Dumper::Indent I<or> I<$OBJ>->Indent(I<[NEWVAL]>) 1028 1029Controls the style of indentation. It can be set to 0, 1, 2 or 3. Style 0 1030spews output without any newlines, indentation, or spaces between list items. 1031It is the most compact format possible that can still be called valid perl. 1032Style 1 outputs a readable form with newlines but no fancy indentation (each 1033level in the structure is simply indented by a fixed amount of whitespace). 1034Style 2 (the default) outputs a very readable form which lines up the hash 1035keys. Style 3 is like style 2, but also annotates the elements of arrays with 1036their index (but the comment is on its own line, so array output consumes 1037twice the number of lines). Style 2 is the default. 1038 1039=item * 1040 1041$Data::Dumper::Trailingcomma I<or> I<$OBJ>->Trailingcomma(I<[NEWVAL]>) 1042 1043Controls whether a comma is added after the last element of an array or 1044hash. Even when true, no comma is added between the last element of an array 1045or hash and a closing bracket when they appear on the same line. The default 1046is false. 1047 1048=item * 1049 1050$Data::Dumper::Purity I<or> I<$OBJ>->Purity(I<[NEWVAL]>) 1051 1052Controls the degree to which the output can be C<eval>ed to recreate the 1053supplied reference structures. Setting it to 1 will output additional perl 1054statements that will correctly recreate nested references. The default is 10550. 1056 1057=item * 1058 1059$Data::Dumper::Pad I<or> I<$OBJ>->Pad(I<[NEWVAL]>) 1060 1061Specifies the string that will be prefixed to every line of the output. 1062Empty string by default. 1063 1064=item * 1065 1066$Data::Dumper::Varname I<or> I<$OBJ>->Varname(I<[NEWVAL]>) 1067 1068Contains the prefix to use for tagging variable names in the output. The 1069default is "VAR". 1070 1071=item * 1072 1073$Data::Dumper::Useqq I<or> I<$OBJ>->Useqq(I<[NEWVAL]>) 1074 1075When set, enables the use of double quotes for representing string values. 1076Whitespace other than space will be represented as C<[\n\t\r]>, "unsafe" 1077characters will be backslashed, and unprintable characters will be output as 1078quoted octal integers. The default is 0. 1079 1080=item * 1081 1082$Data::Dumper::Terse I<or> I<$OBJ>->Terse(I<[NEWVAL]>) 1083 1084When set, Data::Dumper will emit single, non-self-referential values as 1085atoms/terms rather than statements. This means that the C<$VAR>I<n> names 1086will be avoided where possible, but be advised that such output may not 1087always be parseable by C<eval>. 1088 1089=item * 1090 1091$Data::Dumper::Freezer I<or> $I<OBJ>->Freezer(I<[NEWVAL]>) 1092 1093Can be set to a method name, or to an empty string to disable the feature. 1094Data::Dumper will invoke that method via the object before attempting to 1095stringify it. This method can alter the contents of the object (if, for 1096instance, it contains data allocated from C), and even rebless it in a 1097different package. The client is responsible for making sure the specified 1098method can be called via the object, and that the object ends up containing 1099only perl data types after the method has been called. Defaults to an empty 1100string. 1101 1102If an object does not support the method specified (determined using 1103UNIVERSAL::can()) then the call will be skipped. If the method dies a 1104warning will be generated. 1105 1106=item * 1107 1108$Data::Dumper::Toaster I<or> $I<OBJ>->Toaster(I<[NEWVAL]>) 1109 1110Can be set to a method name, or to an empty string to disable the feature. 1111Data::Dumper will emit a method call for any objects that are to be dumped 1112using the syntax C<bless(DATA, CLASS)-E<gt>METHOD()>. Note that this means that 1113the method specified will have to perform any modifications required on the 1114object (like creating new state within it, and/or reblessing it in a 1115different package) and then return it. The client is responsible for making 1116sure the method can be called via the object, and that it returns a valid 1117object. Defaults to an empty string. 1118 1119=item * 1120 1121$Data::Dumper::Deepcopy I<or> $I<OBJ>->Deepcopy(I<[NEWVAL]>) 1122 1123Can be set to a boolean value to enable deep copies of structures. 1124Cross-referencing will then only be done when absolutely essential 1125(i.e., to break reference cycles). Default is 0. 1126 1127=item * 1128 1129$Data::Dumper::Quotekeys I<or> $I<OBJ>->Quotekeys(I<[NEWVAL]>) 1130 1131Can be set to a boolean value to control whether hash keys are quoted. 1132A defined false value will avoid quoting hash keys when it looks like a simple 1133string. Default is 1, which will always enclose hash keys in quotes. 1134 1135=item * 1136 1137$Data::Dumper::Bless I<or> $I<OBJ>->Bless(I<[NEWVAL]>) 1138 1139Can be set to a string that specifies an alternative to the C<bless> 1140builtin operator used to create objects. A function with the specified 1141name should exist, and should accept the same arguments as the builtin. 1142Default is C<bless>. 1143 1144=item * 1145 1146$Data::Dumper::Pair I<or> $I<OBJ>->Pair(I<[NEWVAL]>) 1147 1148Can be set to a string that specifies the separator between hash keys 1149and values. To dump nested hash, array and scalar values to JavaScript, 1150use: C<$Data::Dumper::Pair = ' : ';>. Implementing C<bless> in JavaScript 1151is left as an exercise for the reader. 1152A function with the specified name exists, and accepts the same arguments 1153as the builtin. 1154 1155Default is: C< =E<gt> >. 1156 1157=item * 1158 1159$Data::Dumper::Maxdepth I<or> $I<OBJ>->Maxdepth(I<[NEWVAL]>) 1160 1161Can be set to a positive integer that specifies the depth beyond which 1162we don't venture into a structure. Has no effect when 1163C<Data::Dumper::Purity> is set. (Useful in debugger when we often don't 1164want to see more than enough). Default is 0, which means there is 1165no maximum depth. 1166 1167=item * 1168 1169$Data::Dumper::Maxrecurse I<or> $I<OBJ>->Maxrecurse(I<[NEWVAL]>) 1170 1171Can be set to a positive integer that specifies the depth beyond which 1172recursion into a structure will throw an exception. This is intended 1173as a security measure to prevent perl running out of stack space when 1174dumping an excessively deep structure. Can be set to 0 to remove the 1175limit. Default is 1000. 1176 1177=item * 1178 1179$Data::Dumper::Useperl I<or> $I<OBJ>->Useperl(I<[NEWVAL]>) 1180 1181Can be set to a boolean value which controls whether the pure Perl 1182implementation of C<Data::Dumper> is used. The C<Data::Dumper> module is 1183a dual implementation, with almost all functionality written in both 1184pure Perl and also in XS ('C'). Since the XS version is much faster, it 1185will always be used if possible. This option lets you override the 1186default behavior, usually for testing purposes only. Default is 0, which 1187means the XS implementation will be used if possible. 1188 1189=item * 1190 1191$Data::Dumper::Sortkeys I<or> $I<OBJ>->Sortkeys(I<[NEWVAL]>) 1192 1193Can be set to a boolean value to control whether hash keys are dumped in 1194sorted order. A true value will cause the keys of all hashes to be 1195dumped in Perl's default sort order. Can also be set to a subroutine 1196reference which will be called for each hash that is dumped. In this 1197case C<Data::Dumper> will call the subroutine once for each hash, 1198passing it the reference of the hash. The purpose of the subroutine is 1199to return a reference to an array of the keys that will be dumped, in 1200the order that they should be dumped. Using this feature, you can 1201control both the order of the keys, and which keys are actually used. In 1202other words, this subroutine acts as a filter by which you can exclude 1203certain keys from being dumped. Default is 0, which means that hash keys 1204are not sorted. 1205 1206=item * 1207 1208$Data::Dumper::Deparse I<or> $I<OBJ>->Deparse(I<[NEWVAL]>) 1209 1210Can be set to a boolean value to control whether code references are 1211turned into perl source code. If set to a true value, C<B::Deparse> 1212will be used to get the source of the code reference. In older versions, 1213using this option imposed a significant performance penalty when dumping 1214parts of a data structure other than code references, but that is no 1215longer the case. 1216 1217Caution : use this option only if you know that your coderefs will be 1218properly reconstructed by C<B::Deparse>. 1219 1220=item * 1221 1222$Data::Dumper::Sparseseen I<or> $I<OBJ>->Sparseseen(I<[NEWVAL]>) 1223 1224By default, Data::Dumper builds up the "seen" hash of scalars that 1225it has encountered during serialization. This is very expensive. 1226This seen hash is necessary to support and even just detect circular 1227references. It is exposed to the user via the C<Seen()> call both 1228for writing and reading. 1229 1230If you, as a user, do not need explicit access to the "seen" hash, 1231then you can set the C<Sparseseen> option to allow Data::Dumper 1232to eschew building the "seen" hash for scalars that are known not 1233to possess more than one reference. This speeds up serialization 1234considerably if you use the XS implementation. 1235 1236Note: If you turn on C<Sparseseen>, then you must not rely on the 1237content of the seen hash since its contents will be an 1238implementation detail! 1239 1240=back 1241 1242=head2 Exports 1243 1244=over 4 1245 1246=item Dumper 1247 1248=back 1249 1250=head1 EXAMPLES 1251 1252Run these code snippets to get a quick feel for the behavior of this 1253module. When you are through with these examples, you may want to 1254add or change the various configuration variables described above, 1255to see their behavior. (See the testsuite in the Data::Dumper 1256distribution for more examples.) 1257 1258 1259 use Data::Dumper; 1260 1261 package Foo; 1262 sub new {bless {'a' => 1, 'b' => sub { return "foo" }}, $_[0]}; 1263 1264 package Fuz; # a weird REF-REF-SCALAR object 1265 sub new {bless \($_ = \ 'fu\'z'), $_[0]}; 1266 1267 package main; 1268 $foo = Foo->new; 1269 $fuz = Fuz->new; 1270 $boo = [ 1, [], "abcd", \*foo, 1271 {1 => 'a', 023 => 'b', 0x45 => 'c'}, 1272 \\"p\q\'r", $foo, $fuz]; 1273 1274 ######## 1275 # simple usage 1276 ######## 1277 1278 $bar = eval(Dumper($boo)); 1279 print($@) if $@; 1280 print Dumper($boo), Dumper($bar); # pretty print (no array indices) 1281 1282 $Data::Dumper::Terse = 1; # don't output names where feasible 1283 $Data::Dumper::Indent = 0; # turn off all pretty print 1284 print Dumper($boo), "\n"; 1285 1286 $Data::Dumper::Indent = 1; # mild pretty print 1287 print Dumper($boo); 1288 1289 $Data::Dumper::Indent = 3; # pretty print with array indices 1290 print Dumper($boo); 1291 1292 $Data::Dumper::Useqq = 1; # print strings in double quotes 1293 print Dumper($boo); 1294 1295 $Data::Dumper::Pair = " : "; # specify hash key/value separator 1296 print Dumper($boo); 1297 1298 1299 ######## 1300 # recursive structures 1301 ######## 1302 1303 @c = ('c'); 1304 $c = \@c; 1305 $b = {}; 1306 $a = [1, $b, $c]; 1307 $b->{a} = $a; 1308 $b->{b} = $a->[1]; 1309 $b->{c} = $a->[2]; 1310 print Data::Dumper->Dump([$a,$b,$c], [qw(a b c)]); 1311 1312 1313 $Data::Dumper::Purity = 1; # fill in the holes for eval 1314 print Data::Dumper->Dump([$a, $b], [qw(*a b)]); # print as @a 1315 print Data::Dumper->Dump([$b, $a], [qw(*b a)]); # print as %b 1316 1317 1318 $Data::Dumper::Deepcopy = 1; # avoid cross-refs 1319 print Data::Dumper->Dump([$b, $a], [qw(*b a)]); 1320 1321 1322 $Data::Dumper::Purity = 0; # avoid cross-refs 1323 print Data::Dumper->Dump([$b, $a], [qw(*b a)]); 1324 1325 ######## 1326 # deep structures 1327 ######## 1328 1329 $a = "pearl"; 1330 $b = [ $a ]; 1331 $c = { 'b' => $b }; 1332 $d = [ $c ]; 1333 $e = { 'd' => $d }; 1334 $f = { 'e' => $e }; 1335 print Data::Dumper->Dump([$f], [qw(f)]); 1336 1337 $Data::Dumper::Maxdepth = 3; # no deeper than 3 refs down 1338 print Data::Dumper->Dump([$f], [qw(f)]); 1339 1340 1341 ######## 1342 # object-oriented usage 1343 ######## 1344 1345 $d = Data::Dumper->new([$a,$b], [qw(a b)]); 1346 $d->Seen({'*c' => $c}); # stash a ref without printing it 1347 $d->Indent(3); 1348 print $d->Dump; 1349 $d->Reset->Purity(0); # empty the seen cache 1350 print join "----\n", $d->Dump; 1351 1352 1353 ######## 1354 # persistence 1355 ######## 1356 1357 package Foo; 1358 sub new { bless { state => 'awake' }, shift } 1359 sub Freeze { 1360 my $s = shift; 1361 print STDERR "preparing to sleep\n"; 1362 $s->{state} = 'asleep'; 1363 return bless $s, 'Foo::ZZZ'; 1364 } 1365 1366 package Foo::ZZZ; 1367 sub Thaw { 1368 my $s = shift; 1369 print STDERR "waking up\n"; 1370 $s->{state} = 'awake'; 1371 return bless $s, 'Foo'; 1372 } 1373 1374 package main; 1375 use Data::Dumper; 1376 $a = Foo->new; 1377 $b = Data::Dumper->new([$a], ['c']); 1378 $b->Freezer('Freeze'); 1379 $b->Toaster('Thaw'); 1380 $c = $b->Dump; 1381 print $c; 1382 $d = eval $c; 1383 print Data::Dumper->Dump([$d], ['d']); 1384 1385 1386 ######## 1387 # symbol substitution (useful for recreating CODE refs) 1388 ######## 1389 1390 sub foo { print "foo speaking\n" } 1391 *other = \&foo; 1392 $bar = [ \&other ]; 1393 $d = Data::Dumper->new([\&other,$bar],['*other','bar']); 1394 $d->Seen({ '*foo' => \&foo }); 1395 print $d->Dump; 1396 1397 1398 ######## 1399 # sorting and filtering hash keys 1400 ######## 1401 1402 $Data::Dumper::Sortkeys = \&my_filter; 1403 my $foo = { map { (ord, "$_$_$_") } 'I'..'Q' }; 1404 my $bar = { %$foo }; 1405 my $baz = { reverse %$foo }; 1406 print Dumper [ $foo, $bar, $baz ]; 1407 1408 sub my_filter { 1409 my ($hash) = @_; 1410 # return an array ref containing the hash keys to dump 1411 # in the order that you want them to be dumped 1412 return [ 1413 # Sort the keys of %$foo in reverse numeric order 1414 $hash eq $foo ? (sort {$b <=> $a} keys %$hash) : 1415 # Only dump the odd number keys of %$bar 1416 $hash eq $bar ? (grep {$_ % 2} keys %$hash) : 1417 # Sort keys in default order for all other hashes 1418 (sort keys %$hash) 1419 ]; 1420 } 1421 1422=head1 BUGS 1423 1424Due to limitations of Perl subroutine call semantics, you cannot pass an 1425array or hash. Prepend it with a C<\> to pass its reference instead. This 1426will be remedied in time, now that Perl has subroutine prototypes. 1427For now, you need to use the extended usage form, and prepend the 1428name with a C<*> to output it as a hash or array. 1429 1430C<Data::Dumper> cheats with CODE references. If a code reference is 1431encountered in the structure being processed (and if you haven't set 1432the C<Deparse> flag), an anonymous subroutine that 1433contains the string '"DUMMY"' will be inserted in its place, and a warning 1434will be printed if C<Purity> is set. You can C<eval> the result, but bear 1435in mind that the anonymous sub that gets created is just a placeholder. 1436Even using the C<Deparse> flag will in some cases produce results that 1437behave differently after being passed to C<eval>; see the documentation 1438for L<B::Deparse>. 1439 1440SCALAR objects have the weirdest looking C<bless> workaround. 1441 1442=head2 NOTE 1443 1444Different runs of Perl will have different 1445ordering of hash keys. The change was done for greater security, 1446see L<perlsec/"Algorithmic Complexity Attacks">. This means that 1447different runs of Perl will have different Data::Dumper outputs if 1448the data contains hashes. If you need to have identical Data::Dumper 1449outputs from different runs of Perl, use the environment variable 1450PERL_HASH_SEED, see L<perlrun/PERL_HASH_SEED>. Using this restores 1451the old (platform-specific) ordering: an even prettier solution might 1452be to use the C<Sortkeys> filter of Data::Dumper. 1453 1454=head1 AUTHOR 1455 1456Gurusamy Sarathy gsar@activestate.com 1457 1458Copyright (c) 1996-2019 Gurusamy Sarathy. All rights reserved. 1459This program is free software; you can redistribute it and/or 1460modify it under the same terms as Perl itself. 1461 1462=head1 VERSION 1463 1464Version 2.183 1465 1466=head1 SEE ALSO 1467 1468perl(1) 1469 1470=cut 1471