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.006_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.179'; # 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 126# Most users of current versions of Data::Dumper will be 5.008 or later. 127# Anyone on 5.6.1 and 5.6.2 upgrading will be rare (particularly judging by 128# the bug reports from users on those platforms), so for the common case avoid 129# complexity, and avoid even compiling the unneeded code. 130 131sub init_refaddr_format { 132} 133 134sub format_refaddr { 135 require Scalar::Util; 136 pack "J", Scalar::Util::refaddr(shift); 137}; 138 139if ($] < 5.008) { 140 eval <<'EOC' or die; 141 no warnings 'redefine'; 142 my $refaddr_format; 143 sub init_refaddr_format { 144 require Config; 145 my $f = $Config::Config{uvxformat}; 146 $f =~ tr/"//d; 147 $refaddr_format = "0x%" . $f; 148 } 149 150 sub format_refaddr { 151 require Scalar::Util; 152 sprintf $refaddr_format, Scalar::Util::refaddr(shift); 153 } 154 155 1 156EOC 157} 158 159# 160# add-to or query the table of already seen references 161# 162sub Seen { 163 my($s, $g) = @_; 164 if (defined($g) && (ref($g) eq 'HASH')) { 165 init_refaddr_format(); 166 my($k, $v, $id); 167 while (($k, $v) = each %$g) { 168 if (defined $v) { 169 if (ref $v) { 170 $id = format_refaddr($v); 171 if ($k =~ /^[*](.*)$/) { 172 $k = (ref $v eq 'ARRAY') ? ( "\\\@" . $1 ) : 173 (ref $v eq 'HASH') ? ( "\\\%" . $1 ) : 174 (ref $v eq 'CODE') ? ( "\\\&" . $1 ) : 175 ( "\$" . $1 ) ; 176 } 177 elsif ($k !~ /^\$/) { 178 $k = "\$" . $k; 179 } 180 $s->{seen}{$id} = [$k, $v]; 181 } 182 else { 183 Carp::carp("Only refs supported, ignoring non-ref item \$$k"); 184 } 185 } 186 else { 187 Carp::carp("Value of ref must be defined; ignoring undefined item \$$k"); 188 } 189 } 190 return $s; 191 } 192 else { 193 return map { @$_ } values %{$s->{seen}}; 194 } 195} 196 197# 198# set or query the values to be dumped 199# 200sub Values { 201 my($s, $v) = @_; 202 if (defined($v)) { 203 if (ref($v) eq 'ARRAY') { 204 $s->{todump} = [@$v]; # make a copy 205 return $s; 206 } 207 else { 208 Carp::croak("Argument to Values, if provided, must be array ref"); 209 } 210 } 211 else { 212 return @{$s->{todump}}; 213 } 214} 215 216# 217# set or query the names of the values to be dumped 218# 219sub Names { 220 my($s, $n) = @_; 221 if (defined($n)) { 222 if (ref($n) eq 'ARRAY') { 223 $s->{names} = [@$n]; # make a copy 224 return $s; 225 } 226 else { 227 Carp::croak("Argument to Names, if provided, must be array ref"); 228 } 229 } 230 else { 231 return @{$s->{names}}; 232 } 233} 234 235sub DESTROY {} 236 237sub Dump { 238 return &Dumpxs 239 unless $Data::Dumper::Useperl || (ref($_[0]) && $_[0]->{useperl}) 240 # Use pure perl version on earlier releases on EBCDIC platforms 241 || (! $IS_ASCII && $] lt 5.021_010); 242 return &Dumpperl; 243} 244 245# 246# dump the refs in the current dumper object. 247# expects same args as new() if called via package name. 248# 249our @post; 250sub Dumpperl { 251 my($s) = shift; 252 my(@out, $val, $name); 253 my($i) = 0; 254 local(@post); 255 init_refaddr_format(); 256 257 $s = $s->new(@_) unless ref $s; 258 259 for $val (@{$s->{todump}}) { 260 @post = (); 261 $name = $s->{names}[$i++]; 262 $name = $s->_refine_name($name, $val, $i); 263 264 my $valstr; 265 { 266 local($s->{apad}) = $s->{apad}; 267 $s->{apad} .= ' ' x (length($name) + 3) if $s->{indent} >= 2 and !$s->{terse}; 268 $valstr = $s->_dump($val, $name); 269 } 270 271 $valstr = "$name = " . $valstr . ';' if @post or !$s->{terse}; 272 my $out = $s->_compose_out($valstr, \@post); 273 274 push @out, $out; 275 } 276 return wantarray ? @out : join('', @out); 277} 278 279# wrap string in single quotes (escaping if needed) 280sub _quote { 281 my $val = shift; 282 $val =~ s/([\\\'])/\\$1/g; 283 return "'" . $val . "'"; 284} 285 286# Old Perls (5.14-) have trouble resetting vstring magic when it is no 287# longer valid. 288use constant _bad_vsmg => defined &_vstring && (_vstring(~v0)||'') eq "v0"; 289 290# 291# twist, toil and turn; 292# and recurse, of course. 293# sometimes sordidly; 294# and curse if no recourse. 295# 296sub _dump { 297 my($s, $val, $name) = @_; 298 my($out, $type, $id, $sname); 299 300 $type = ref $val; 301 $out = ""; 302 303 if ($type) { 304 305 # Call the freezer method if it's specified and the object has the 306 # method. Trap errors and warn() instead of die()ing, like the XS 307 # implementation. 308 my $freezer = $s->{freezer}; 309 if ($freezer and UNIVERSAL::can($val, $freezer)) { 310 eval { $val->$freezer() }; 311 warn "WARNING(Freezer method call failed): $@" if $@; 312 } 313 314 require Scalar::Util; 315 my $realpack = Scalar::Util::blessed($val); 316 my $realtype = $realpack ? Scalar::Util::reftype($val) : ref $val; 317 $id = format_refaddr($val); 318 319 # Note: By this point $name is always defined and of non-zero length. 320 # Keep a tab on it so that we do not fall into recursive pit. 321 if (exists $s->{seen}{$id}) { 322 if ($s->{purity} and $s->{level} > 0) { 323 $out = ($realtype eq 'HASH') ? '{}' : 324 ($realtype eq 'ARRAY') ? '[]' : 325 'do{my $o}' ; 326 push @post, $name . " = " . $s->{seen}{$id}[0]; 327 } 328 else { 329 $out = $s->{seen}{$id}[0]; 330 if ($name =~ /^([\@\%])/) { 331 my $start = $1; 332 if ($out =~ /^\\$start/) { 333 $out = substr($out, 1); 334 } 335 else { 336 $out = $start . '{' . $out . '}'; 337 } 338 } 339 } 340 return $out; 341 } 342 else { 343 # store our name 344 $s->{seen}{$id} = [ ( 345 ($name =~ /^[@%]/) 346 ? ('\\' . $name ) 347 : ($realtype eq 'CODE' and $name =~ /^[*](.*)$/) 348 ? ('\\&' . $1 ) 349 : $name 350 ), $val ]; 351 } 352 my $no_bless = 0; 353 my $is_regex = 0; 354 if ( $realpack and ($] >= 5.009005 ? re::is_regexp($val) : $realpack eq 'Regexp') ) { 355 $is_regex = 1; 356 $no_bless = $realpack eq 'Regexp'; 357 } 358 359 # If purity is not set and maxdepth is set, then check depth: 360 # if we have reached maximum depth, return the string 361 # representation of the thing we are currently examining 362 # at this depth (i.e., 'Foo=ARRAY(0xdeadbeef)'). 363 if (!$s->{purity} 364 and defined($s->{maxdepth}) 365 and $s->{maxdepth} > 0 366 and $s->{level} >= $s->{maxdepth}) 367 { 368 return qq['$val']; 369 } 370 371 # avoid recursing infinitely [perl #122111] 372 if ($s->{maxrecurse} > 0 373 and $s->{level} >= $s->{maxrecurse}) { 374 die "Recursion limit of $s->{maxrecurse} exceeded"; 375 } 376 377 # we have a blessed ref 378 my ($blesspad); 379 if ($realpack and !$no_bless) { 380 $out = $s->{'bless'} . '( '; 381 $blesspad = $s->{apad}; 382 $s->{apad} .= ' ' if ($s->{indent} >= 2); 383 } 384 385 $s->{level}++; 386 my $ipad = $s->{xpad} x $s->{level}; 387 388 if ($is_regex) { 389 my $pat; 390 my $flags = ""; 391 if (defined(*re::regexp_pattern{CODE})) { 392 ($pat, $flags) = re::regexp_pattern($val); 393 } 394 else { 395 $pat = "$val"; 396 } 397 $pat =~ s <(\\.)|/> { $1 || '\\/' }ge; 398 $out .= "qr/$pat/$flags"; 399 } 400 elsif ($realtype eq 'SCALAR' || $realtype eq 'REF' 401 || $realtype eq 'VSTRING') { 402 if ($realpack) { 403 $out .= 'do{\\(my $o = ' . $s->_dump($$val, "\${$name}") . ')}'; 404 } 405 else { 406 $out .= '\\' . $s->_dump($$val, "\${$name}"); 407 } 408 } 409 elsif ($realtype eq 'GLOB') { 410 $out .= '\\' . $s->_dump($$val, "*{$name}"); 411 } 412 elsif ($realtype eq 'ARRAY') { 413 my($pad, $mname); 414 my($i) = 0; 415 $out .= ($name =~ /^\@/) ? '(' : '['; 416 $pad = $s->{sep} . $s->{pad} . $s->{apad}; 417 ($name =~ /^\@(.*)$/) ? ($mname = "\$" . $1) : 418 # omit -> if $foo->[0]->{bar}, but not ${$foo->[0]}->{bar} 419 ($name =~ /^\\?[\%\@\*\$][^{].*[]}]$/) ? ($mname = $name) : 420 ($mname = $name . '->'); 421 $mname .= '->' if $mname =~ /^\*.+\{[A-Z]+\}$/; 422 for my $v (@$val) { 423 $sname = $mname . '[' . $i . ']'; 424 $out .= $pad . $ipad . '#' . $i 425 if $s->{indent} >= 3; 426 $out .= $pad . $ipad . $s->_dump($v, $sname); 427 $out .= "," 428 if $i++ < $#$val 429 || ($s->{trailingcomma} && $s->{indent} >= 1); 430 } 431 $out .= $pad . ($s->{xpad} x ($s->{level} - 1)) if $i; 432 $out .= ($name =~ /^\@/) ? ')' : ']'; 433 } 434 elsif ($realtype eq 'HASH') { 435 my ($k, $v, $pad, $lpad, $mname, $pair); 436 $out .= ($name =~ /^\%/) ? '(' : '{'; 437 $pad = $s->{sep} . $s->{pad} . $s->{apad}; 438 $lpad = $s->{apad}; 439 $pair = $s->{pair}; 440 ($name =~ /^\%(.*)$/) ? ($mname = "\$" . $1) : 441 # omit -> if $foo->[0]->{bar}, but not ${$foo->[0]}->{bar} 442 ($name =~ /^\\?[\%\@\*\$][^{].*[]}]$/) ? ($mname = $name) : 443 ($mname = $name . '->'); 444 $mname .= '->' if $mname =~ /^\*.+\{[A-Z]+\}$/; 445 my $sortkeys = defined($s->{sortkeys}) ? $s->{sortkeys} : ''; 446 my $keys = []; 447 if ($sortkeys) { 448 if (ref($s->{sortkeys}) eq 'CODE') { 449 $keys = $s->{sortkeys}($val); 450 unless (ref($keys) eq 'ARRAY') { 451 Carp::carp("Sortkeys subroutine did not return ARRAYREF"); 452 $keys = []; 453 } 454 } 455 else { 456 $keys = [ sort keys %$val ]; 457 } 458 } 459 460 # Ensure hash iterator is reset 461 keys(%$val); 462 463 my $key; 464 while (($k, $v) = ! $sortkeys ? (each %$val) : 465 @$keys ? ($key = shift(@$keys), $val->{$key}) : 466 () ) 467 { 468 my $nk = $s->_dump($k, ""); 469 470 # _dump doesn't quote numbers of this form 471 if ($s->{quotekeys} && $nk =~ /^(?:0|-?[1-9][0-9]{0,8})\z/) { 472 $nk = $s->{useqq} ? qq("$nk") : qq('$nk'); 473 } 474 elsif (!$s->{quotekeys} and $nk =~ /^[\"\']([A-Za-z_]\w*)[\"\']$/) { 475 $nk = $1 476 } 477 478 $sname = $mname . '{' . $nk . '}'; 479 $out .= $pad . $ipad . $nk . $pair; 480 481 # temporarily alter apad 482 $s->{apad} .= (" " x (length($nk) + 4)) 483 if $s->{indent} >= 2; 484 $out .= $s->_dump($val->{$k}, $sname) . ","; 485 $s->{apad} = $lpad 486 if $s->{indent} >= 2; 487 } 488 if (substr($out, -1) eq ',') { 489 chop $out if !$s->{trailingcomma} || !$s->{indent}; 490 $out .= $pad . ($s->{xpad} x ($s->{level} - 1)); 491 } 492 $out .= ($name =~ /^\%/) ? ')' : '}'; 493 } 494 elsif ($realtype eq 'CODE') { 495 if ($s->{deparse}) { 496 require B::Deparse; 497 my $sub = 'sub ' . (B::Deparse->new)->coderef2text($val); 498 my $pad = $s->{sep} . $s->{pad} . $s->{apad} . $s->{xpad} x ($s->{level} - 1); 499 $sub =~ s/\n/$pad/gs; 500 $out .= $sub; 501 } 502 else { 503 $out .= 'sub { "DUMMY" }'; 504 Carp::carp("Encountered CODE ref, using dummy placeholder") if $s->{purity}; 505 } 506 } 507 else { 508 Carp::croak("Can't handle '$realtype' type"); 509 } 510 511 if ($realpack and !$no_bless) { # we have a blessed ref 512 $out .= ', ' . _quote($realpack) . ' )'; 513 $out .= '->' . $s->{toaster} . '()' 514 if $s->{toaster} ne ''; 515 $s->{apad} = $blesspad; 516 } 517 $s->{level}--; 518 } 519 else { # simple scalar 520 521 my $ref = \$_[1]; 522 my $v; 523 # first, catalog the scalar 524 if ($name ne '') { 525 $id = format_refaddr($ref); 526 if (exists $s->{seen}{$id}) { 527 if ($s->{seen}{$id}[2]) { 528 $out = $s->{seen}{$id}[0]; 529 #warn "[<$out]\n"; 530 return "\${$out}"; 531 } 532 } 533 else { 534 #warn "[>\\$name]\n"; 535 $s->{seen}{$id} = ["\\$name", $ref]; 536 } 537 } 538 $ref = \$val; 539 if (ref($ref) eq 'GLOB') { # glob 540 my $name = substr($val, 1); 541 $name =~ s/^main::(?!\z)/::/; 542 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::') { 543 $sname = $name; 544 } 545 else { 546 local $s->{useqq} = IS_PRE_516_PERL && ($s->{useqq} || $name =~ /[^\x00-\x7f]/) ? 1 : $s->{useqq}; 547 $sname = $s->_dump( 548 $name eq 'main::' || $] < 5.007 && $name eq "main::\0" 549 ? '' 550 : $name, 551 "", 552 ); 553 $sname = '{' . $sname . '}'; 554 } 555 if ($s->{purity}) { 556 my $k; 557 local ($s->{level}) = 0; 558 for $k (qw(SCALAR ARRAY HASH)) { 559 my $gval = *$val{$k}; 560 next unless defined $gval; 561 next if $k eq "SCALAR" && ! defined $$gval; # always there 562 563 # _dump can push into @post, so we hold our place using $postlen 564 my $postlen = scalar @post; 565 $post[$postlen] = "\*$sname = "; 566 local ($s->{apad}) = " " x length($post[$postlen]) if $s->{indent} >= 2; 567 $post[$postlen] .= $s->_dump($gval, "\*$sname\{$k\}"); 568 } 569 } 570 $out .= '*' . $sname; 571 } 572 elsif (!defined($val)) { 573 $out .= "undef"; 574 } 575 elsif (defined &_vstring and $v = _vstring($val) 576 and !_bad_vsmg || eval $v eq $val) { 577 $out .= $v; 578 } 579 elsif (!defined &_vstring 580 and ref $ref eq 'VSTRING' || eval{Scalar::Util::isvstring($val)}) { 581 $out .= sprintf "%vd", $val; 582 } 583 # \d here would treat "1\x{660}" as a safe decimal number 584 elsif ($val =~ /^(?:0|-?[1-9][0-9]{0,8})\z/) { # safe decimal number 585 $out .= $val; 586 } 587 else { # string 588 if ($s->{useqq} or $val =~ tr/\0-\377//c) { 589 # Fall back to qq if there's Unicode 590 $out .= qquote($val, $s->{useqq}); 591 } 592 else { 593 $out .= _quote($val); 594 } 595 } 596 } 597 if ($id) { 598 # if we made it this far, $id was added to seen list at current 599 # level, so remove it to get deep copies 600 if ($s->{deepcopy}) { 601 delete($s->{seen}{$id}); 602 } 603 elsif ($name) { 604 $s->{seen}{$id}[2] = 1; 605 } 606 } 607 return $out; 608} 609 610# 611# non-OO style of earlier version 612# 613sub Dumper { 614 return Data::Dumper->Dump([@_]); 615} 616 617# compat stub 618sub DumperX { 619 return Data::Dumper->Dumpxs([@_], []); 620} 621 622# 623# reset the "seen" cache 624# 625sub Reset { 626 my($s) = shift; 627 $s->{seen} = {}; 628 return $s; 629} 630 631sub Indent { 632 my($s, $v) = @_; 633 if (@_ >= 2) { 634 if ($v == 0) { 635 $s->{xpad} = ""; 636 $s->{sep} = ""; 637 } 638 else { 639 $s->{xpad} = " "; 640 $s->{sep} = "\n"; 641 } 642 $s->{indent} = $v; 643 return $s; 644 } 645 else { 646 return $s->{indent}; 647 } 648} 649 650sub Trailingcomma { 651 my($s, $v) = @_; 652 @_ >= 2 ? (($s->{trailingcomma} = $v), return $s) : $s->{trailingcomma}; 653} 654 655sub Pair { 656 my($s, $v) = @_; 657 @_ >= 2 ? (($s->{pair} = $v), return $s) : $s->{pair}; 658} 659 660sub Pad { 661 my($s, $v) = @_; 662 @_ >= 2 ? (($s->{pad} = $v), return $s) : $s->{pad}; 663} 664 665sub Varname { 666 my($s, $v) = @_; 667 @_ >= 2 ? (($s->{varname} = $v), return $s) : $s->{varname}; 668} 669 670sub Purity { 671 my($s, $v) = @_; 672 @_ >= 2 ? (($s->{purity} = $v), return $s) : $s->{purity}; 673} 674 675sub Useqq { 676 my($s, $v) = @_; 677 @_ >= 2 ? (($s->{useqq} = $v), return $s) : $s->{useqq}; 678} 679 680sub Terse { 681 my($s, $v) = @_; 682 @_ >= 2 ? (($s->{terse} = $v), return $s) : $s->{terse}; 683} 684 685sub Freezer { 686 my($s, $v) = @_; 687 @_ >= 2 ? (($s->{freezer} = $v), return $s) : $s->{freezer}; 688} 689 690sub Toaster { 691 my($s, $v) = @_; 692 @_ >= 2 ? (($s->{toaster} = $v), return $s) : $s->{toaster}; 693} 694 695sub Deepcopy { 696 my($s, $v) = @_; 697 @_ >= 2 ? (($s->{deepcopy} = $v), return $s) : $s->{deepcopy}; 698} 699 700sub Quotekeys { 701 my($s, $v) = @_; 702 @_ >= 2 ? (($s->{quotekeys} = $v), return $s) : $s->{quotekeys}; 703} 704 705sub Bless { 706 my($s, $v) = @_; 707 @_ >= 2 ? (($s->{'bless'} = $v), return $s) : $s->{'bless'}; 708} 709 710sub Maxdepth { 711 my($s, $v) = @_; 712 @_ >= 2 ? (($s->{'maxdepth'} = $v), return $s) : $s->{'maxdepth'}; 713} 714 715sub Maxrecurse { 716 my($s, $v) = @_; 717 @_ >= 2 ? (($s->{'maxrecurse'} = $v), return $s) : $s->{'maxrecurse'}; 718} 719 720sub Useperl { 721 my($s, $v) = @_; 722 @_ >= 2 ? (($s->{'useperl'} = $v), return $s) : $s->{'useperl'}; 723} 724 725sub Sortkeys { 726 my($s, $v) = @_; 727 @_ >= 2 ? (($s->{'sortkeys'} = $v), return $s) : $s->{'sortkeys'}; 728} 729 730sub Deparse { 731 my($s, $v) = @_; 732 @_ >= 2 ? (($s->{'deparse'} = $v), return $s) : $s->{'deparse'}; 733} 734 735sub Sparseseen { 736 my($s, $v) = @_; 737 @_ >= 2 ? (($s->{'noseen'} = $v), return $s) : $s->{'noseen'}; 738} 739 740# used by qquote below 741my %esc = ( 742 "\a" => "\\a", 743 "\b" => "\\b", 744 "\t" => "\\t", 745 "\n" => "\\n", 746 "\f" => "\\f", 747 "\r" => "\\r", 748 "\e" => "\\e", 749); 750 751my $low_controls = ($IS_ASCII) 752 753 # This includes \177, because traditionally it has been 754 # output as octal, even though it isn't really a "low" 755 # control 756 ? qr/[\0-\x1f\177]/ 757 758 # EBCDIC low controls. 759 : qr/[\0-\x3f]/; 760 761# put a string value in double quotes 762sub qquote { 763 local($_) = shift; 764 s/([\\\"\@\$])/\\$1/g; 765 766 # This efficiently changes the high ordinal characters to \x{} if the utf8 767 # flag is on. On ASCII platforms, the high ordinals are all the 768 # non-ASCII's. On EBCDIC platforms, we don't include in these the non-ASCII 769 # controls whose ordinals are less than SPACE, excluded below by the range 770 # \0-\x3f. On ASCII platforms this range just compiles as part of :ascii:. 771 # On EBCDIC platforms, there is just one outlier high ordinal control, and 772 # it gets output as \x{}. 773 my $bytes; { use bytes; $bytes = length } 774 s/([^[:ascii:]\0-\x3f])/sprintf("\\x{%x}",ord($1))/ge 775 if $bytes > length 776 777 # The above doesn't get the EBCDIC outlier high ordinal control when 778 # the string is UTF-8 but there are no UTF-8 variant characters in it. 779 # We want that to come out as \x{} anyway. We need is_utf8() to do 780 # this. 781 || (! $IS_ASCII && $] ge 5.008_001 && utf8::is_utf8($_)); 782 783 return qq("$_") unless /[[:^print:]]/; # fast exit if only printables 784 785 # Here, there is at least one non-printable to output. First, translate the 786 # escapes. 787 s/([\a\b\t\n\f\r\e])/$esc{$1}/g; 788 789 # no need for 3 digits in escape for octals not followed by a digit. 790 s/($low_controls)(?!\d)/'\\'.sprintf('%o',ord($1))/eg; 791 792 # But otherwise use 3 digits 793 s/($low_controls)/'\\'.sprintf('%03o',ord($1))/eg; 794 795 # all but last branch below not supported --BEHAVIOR SUBJECT TO CHANGE-- 796 my $high = shift || ""; 797 if ($high eq "iso8859") { # Doesn't escape the Latin1 printables 798 if ($IS_ASCII) { 799 s/([\200-\240])/'\\'.sprintf('%o',ord($1))/eg; 800 } 801 elsif ($] ge 5.007_003) { 802 my $high_control = utf8::unicode_to_native(0x9F); 803 s/$high_control/sprintf('\\%o',ord($1))/eg; 804 } 805 } elsif ($high eq "utf8") { 806# Some discussion of what to do here is in 807# https://rt.perl.org/Ticket/Display.html?id=113088 808# use utf8; 809# $str =~ s/([^\040-\176])/sprintf "\\x{%04x}", ord($1)/ge; 810 } elsif ($high eq "8bit") { 811 # leave it as it is 812 } else { 813 s/([[:^ascii:]])/'\\'.sprintf('%03o',ord($1))/eg; 814 #s/([^\040-\176])/sprintf "\\x{%04x}", ord($1)/ge; 815 } 816 817 return qq("$_"); 818} 819 820# helper sub to sort hash keys in Perl < 5.8.0 where we don't have 821# access to sortsv() from XS 822sub _sortkeys { [ sort keys %{$_[0]} ] } 823 824sub _refine_name { 825 my $s = shift; 826 my ($name, $val, $i) = @_; 827 if (defined $name) { 828 if ($name =~ /^[*](.*)$/) { 829 if (defined $val) { 830 $name = (ref $val eq 'ARRAY') ? ( "\@" . $1 ) : 831 (ref $val eq 'HASH') ? ( "\%" . $1 ) : 832 (ref $val eq 'CODE') ? ( "\*" . $1 ) : 833 ( "\$" . $1 ) ; 834 } 835 else { 836 $name = "\$" . $1; 837 } 838 } 839 elsif ($name !~ /^\$/) { 840 $name = "\$" . $name; 841 } 842 } 843 else { # no names provided 844 $name = "\$" . $s->{varname} . $i; 845 } 846 return $name; 847} 848 849sub _compose_out { 850 my $s = shift; 851 my ($valstr, $postref) = @_; 852 my $out = ""; 853 $out .= $s->{pad} . $valstr . $s->{sep}; 854 if (@{$postref}) { 855 $out .= $s->{pad} . 856 join(';' . $s->{sep} . $s->{pad}, @{$postref}) . 857 ';' . 858 $s->{sep}; 859 } 860 return $out; 861} 862 8631; 864__END__ 865 866=head1 NAME 867 868Data::Dumper - stringified perl data structures, suitable for both printing and C<eval> 869 870=head1 SYNOPSIS 871 872 use Data::Dumper; 873 874 # simple procedural interface 875 print Dumper($foo, $bar); 876 877 # extended usage with names 878 print Data::Dumper->Dump([$foo, $bar], [qw(foo *ary)]); 879 880 # configuration variables 881 { 882 local $Data::Dumper::Purity = 1; 883 eval Data::Dumper->Dump([$foo, $bar], [qw(foo *ary)]); 884 } 885 886 # OO usage 887 $d = Data::Dumper->new([$foo, $bar], [qw(foo *ary)]); 888 ... 889 print $d->Dump; 890 ... 891 $d->Purity(1)->Terse(1)->Deepcopy(1); 892 eval $d->Dump; 893 894 895=head1 DESCRIPTION 896 897Given a list of scalars or reference variables, writes out their contents in 898perl syntax. The references can also be objects. The content of each 899variable is output in a single Perl statement. Handles self-referential 900structures correctly. 901 902The return value can be C<eval>ed to get back an identical copy of the 903original reference structure. (Please do consider the security implications 904of eval'ing code from untrusted sources!) 905 906Any references that are the same as one of those passed in will be named 907C<$VAR>I<n> (where I<n> is a numeric suffix), and other duplicate references 908to substructures within C<$VAR>I<n> will be appropriately labeled using arrow 909notation. You can specify names for individual values to be dumped if you 910use the C<Dump()> method, or you can change the default C<$VAR> prefix to 911something else. See C<$Data::Dumper::Varname> and C<$Data::Dumper::Terse> 912below. 913 914The default output of self-referential structures can be C<eval>ed, but the 915nested references to C<$VAR>I<n> will be undefined, since a recursive 916structure cannot be constructed using one Perl statement. You should set the 917C<Purity> flag to 1 to get additional statements that will correctly fill in 918these references. Moreover, if C<eval>ed when strictures are in effect, 919you need to ensure that any variables it accesses are previously declared. 920 921In the extended usage form, the references to be dumped can be given 922user-specified names. If a name begins with a C<*>, the output will 923describe the dereferenced type of the supplied reference for hashes and 924arrays, and coderefs. Output of names will be avoided where possible if 925the C<Terse> flag is set. 926 927In many cases, methods that are used to set the internal state of the 928object will return the object itself, so method calls can be conveniently 929chained together. 930 931Several styles of output are possible, all controlled by setting 932the C<Indent> flag. See L<Configuration Variables or Methods> below 933for details. 934 935 936=head2 Methods 937 938=over 4 939 940=item I<PACKAGE>->new(I<ARRAYREF [>, I<ARRAYREF]>) 941 942Returns a newly created C<Data::Dumper> object. The first argument is an 943anonymous array of values to be dumped. The optional second argument is an 944anonymous array of names for the values. The names need not have a leading 945C<$> sign, and must be comprised of alphanumeric characters. You can begin 946a name with a C<*> to specify that the dereferenced type must be dumped 947instead of the reference itself, for ARRAY and HASH references. 948 949The prefix specified by C<$Data::Dumper::Varname> will be used with a 950numeric suffix if the name for a value is undefined. 951 952Data::Dumper will catalog all references encountered while dumping the 953values. Cross-references (in the form of names of substructures in perl 954syntax) will be inserted at all possible points, preserving any structural 955interdependencies in the original set of values. Structure traversal is 956depth-first, and proceeds in order from the first supplied value to 957the last. 958 959=item I<$OBJ>->Dump I<or> I<PACKAGE>->Dump(I<ARRAYREF [>, I<ARRAYREF]>) 960 961Returns the stringified form of the values stored in the object (preserving 962the order in which they were supplied to C<new>), subject to the 963configuration options below. In a list context, it returns a list 964of strings corresponding to the supplied values. 965 966The second form, for convenience, simply calls the C<new> method on its 967arguments before dumping the object immediately. 968 969=item I<$OBJ>->Seen(I<[HASHREF]>) 970 971Queries or adds to the internal table of already encountered references. 972You must use C<Reset> to explicitly clear the table if needed. Such 973references are not dumped; instead, their names are inserted wherever they 974are encountered subsequently. This is useful especially for properly 975dumping subroutine references. 976 977Expects an anonymous hash of name => value pairs. Same rules apply for names 978as in C<new>. If no argument is supplied, will return the "seen" list of 979name => value pairs, in a list context. Otherwise, returns the object 980itself. 981 982=item I<$OBJ>->Values(I<[ARRAYREF]>) 983 984Queries or replaces the internal array of values that will be dumped. When 985called without arguments, returns the values as a list. When called with a 986reference to an array of replacement values, returns the object itself. When 987called with any other type of argument, dies. 988 989=item I<$OBJ>->Names(I<[ARRAYREF]>) 990 991Queries or replaces the internal array of user supplied names for the values 992that will be dumped. When called without arguments, returns the names. When 993called with an array of replacement names, returns the object itself. If the 994number of replacement names exceeds the number of values to be named, the 995excess names will not be used. If the number of replacement names falls short 996of the number of values to be named, the list of replacement names will be 997exhausted and remaining values will not be renamed. When 998called with any other type of argument, dies. 999 1000=item I<$OBJ>->Reset 1001 1002Clears the internal table of "seen" references and returns the object 1003itself. 1004 1005=back 1006 1007=head2 Functions 1008 1009=over 4 1010 1011=item Dumper(I<LIST>) 1012 1013Returns the stringified form of the values in the list, subject to the 1014configuration options below. The values will be named C<$VAR>I<n> in the 1015output, where I<n> is a numeric suffix. Will return a list of strings 1016in a list context. 1017 1018=back 1019 1020=head2 Configuration Variables or Methods 1021 1022Several configuration variables can be used to control the kind of output 1023generated when using the procedural interface. These variables are usually 1024C<local>ized in a block so that other parts of the code are not affected by 1025the change. 1026 1027These variables determine the default state of the object created by calling 1028the C<new> method, but cannot be used to alter the state of the object 1029thereafter. The equivalent method names should be used instead to query 1030or set the internal state of the object. 1031 1032The method forms return the object itself when called with arguments, 1033so that they can be chained together nicely. 1034 1035=over 4 1036 1037=item * 1038 1039$Data::Dumper::Indent I<or> I<$OBJ>->Indent(I<[NEWVAL]>) 1040 1041Controls the style of indentation. It can be set to 0, 1, 2 or 3. Style 0 1042spews output without any newlines, indentation, or spaces between list items. 1043It is the most compact format possible that can still be called valid perl. 1044Style 1 outputs a readable form with newlines but no fancy indentation (each 1045level in the structure is simply indented by a fixed amount of whitespace). 1046Style 2 (the default) outputs a very readable form which lines up the hash 1047keys. Style 3 is like style 2, but also annotates the elements of arrays with 1048their index (but the comment is on its own line, so array output consumes 1049twice the number of lines). Style 2 is the default. 1050 1051=item * 1052 1053$Data::Dumper::Trailingcomma I<or> I<$OBJ>->Trailingcomma(I<[NEWVAL]>) 1054 1055Controls whether a comma is added after the last element of an array or 1056hash. Even when true, no comma is added between the last element of an array 1057or hash and a closing bracket when they appear on the same line. The default 1058is false. 1059 1060=item * 1061 1062$Data::Dumper::Purity I<or> I<$OBJ>->Purity(I<[NEWVAL]>) 1063 1064Controls the degree to which the output can be C<eval>ed to recreate the 1065supplied reference structures. Setting it to 1 will output additional perl 1066statements that will correctly recreate nested references. The default is 10670. 1068 1069=item * 1070 1071$Data::Dumper::Pad I<or> I<$OBJ>->Pad(I<[NEWVAL]>) 1072 1073Specifies the string that will be prefixed to every line of the output. 1074Empty string by default. 1075 1076=item * 1077 1078$Data::Dumper::Varname I<or> I<$OBJ>->Varname(I<[NEWVAL]>) 1079 1080Contains the prefix to use for tagging variable names in the output. The 1081default is "VAR". 1082 1083=item * 1084 1085$Data::Dumper::Useqq I<or> I<$OBJ>->Useqq(I<[NEWVAL]>) 1086 1087When set, enables the use of double quotes for representing string values. 1088Whitespace other than space will be represented as C<[\n\t\r]>, "unsafe" 1089characters will be backslashed, and unprintable characters will be output as 1090quoted octal integers. The default is 0. 1091 1092=item * 1093 1094$Data::Dumper::Terse I<or> I<$OBJ>->Terse(I<[NEWVAL]>) 1095 1096When set, Data::Dumper will emit single, non-self-referential values as 1097atoms/terms rather than statements. This means that the C<$VAR>I<n> names 1098will be avoided where possible, but be advised that such output may not 1099always be parseable by C<eval>. 1100 1101=item * 1102 1103$Data::Dumper::Freezer I<or> $I<OBJ>->Freezer(I<[NEWVAL]>) 1104 1105Can be set to a method name, or to an empty string to disable the feature. 1106Data::Dumper will invoke that method via the object before attempting to 1107stringify it. This method can alter the contents of the object (if, for 1108instance, it contains data allocated from C), and even rebless it in a 1109different package. The client is responsible for making sure the specified 1110method can be called via the object, and that the object ends up containing 1111only perl data types after the method has been called. Defaults to an empty 1112string. 1113 1114If an object does not support the method specified (determined using 1115UNIVERSAL::can()) then the call will be skipped. If the method dies a 1116warning will be generated. 1117 1118=item * 1119 1120$Data::Dumper::Toaster I<or> $I<OBJ>->Toaster(I<[NEWVAL]>) 1121 1122Can be set to a method name, or to an empty string to disable the feature. 1123Data::Dumper will emit a method call for any objects that are to be dumped 1124using the syntax C<bless(DATA, CLASS)-E<gt>METHOD()>. Note that this means that 1125the method specified will have to perform any modifications required on the 1126object (like creating new state within it, and/or reblessing it in a 1127different package) and then return it. The client is responsible for making 1128sure the method can be called via the object, and that it returns a valid 1129object. Defaults to an empty string. 1130 1131=item * 1132 1133$Data::Dumper::Deepcopy I<or> $I<OBJ>->Deepcopy(I<[NEWVAL]>) 1134 1135Can be set to a boolean value to enable deep copies of structures. 1136Cross-referencing will then only be done when absolutely essential 1137(i.e., to break reference cycles). Default is 0. 1138 1139=item * 1140 1141$Data::Dumper::Quotekeys I<or> $I<OBJ>->Quotekeys(I<[NEWVAL]>) 1142 1143Can be set to a boolean value to control whether hash keys are quoted. 1144A defined false value will avoid quoting hash keys when it looks like a simple 1145string. Default is 1, which will always enclose hash keys in quotes. 1146 1147=item * 1148 1149$Data::Dumper::Bless I<or> $I<OBJ>->Bless(I<[NEWVAL]>) 1150 1151Can be set to a string that specifies an alternative to the C<bless> 1152builtin operator used to create objects. A function with the specified 1153name should exist, and should accept the same arguments as the builtin. 1154Default is C<bless>. 1155 1156=item * 1157 1158$Data::Dumper::Pair I<or> $I<OBJ>->Pair(I<[NEWVAL]>) 1159 1160Can be set to a string that specifies the separator between hash keys 1161and values. To dump nested hash, array and scalar values to JavaScript, 1162use: C<$Data::Dumper::Pair = ' : ';>. Implementing C<bless> in JavaScript 1163is left as an exercise for the reader. 1164A function with the specified name exists, and accepts the same arguments 1165as the builtin. 1166 1167Default is: C< =E<gt> >. 1168 1169=item * 1170 1171$Data::Dumper::Maxdepth I<or> $I<OBJ>->Maxdepth(I<[NEWVAL]>) 1172 1173Can be set to a positive integer that specifies the depth beyond which 1174we don't venture into a structure. Has no effect when 1175C<Data::Dumper::Purity> is set. (Useful in debugger when we often don't 1176want to see more than enough). Default is 0, which means there is 1177no maximum depth. 1178 1179=item * 1180 1181$Data::Dumper::Maxrecurse I<or> $I<OBJ>->Maxrecurse(I<[NEWVAL]>) 1182 1183Can be set to a positive integer that specifies the depth beyond which 1184recursion into a structure will throw an exception. This is intended 1185as a security measure to prevent perl running out of stack space when 1186dumping an excessively deep structure. Can be set to 0 to remove the 1187limit. Default is 1000. 1188 1189=item * 1190 1191$Data::Dumper::Useperl I<or> $I<OBJ>->Useperl(I<[NEWVAL]>) 1192 1193Can be set to a boolean value which controls whether the pure Perl 1194implementation of C<Data::Dumper> is used. The C<Data::Dumper> module is 1195a dual implementation, with almost all functionality written in both 1196pure Perl and also in XS ('C'). Since the XS version is much faster, it 1197will always be used if possible. This option lets you override the 1198default behavior, usually for testing purposes only. Default is 0, which 1199means the XS implementation will be used if possible. 1200 1201=item * 1202 1203$Data::Dumper::Sortkeys I<or> $I<OBJ>->Sortkeys(I<[NEWVAL]>) 1204 1205Can be set to a boolean value to control whether hash keys are dumped in 1206sorted order. A true value will cause the keys of all hashes to be 1207dumped in Perl's default sort order. Can also be set to a subroutine 1208reference which will be called for each hash that is dumped. In this 1209case C<Data::Dumper> will call the subroutine once for each hash, 1210passing it the reference of the hash. The purpose of the subroutine is 1211to return a reference to an array of the keys that will be dumped, in 1212the order that they should be dumped. Using this feature, you can 1213control both the order of the keys, and which keys are actually used. In 1214other words, this subroutine acts as a filter by which you can exclude 1215certain keys from being dumped. Default is 0, which means that hash keys 1216are not sorted. 1217 1218=item * 1219 1220$Data::Dumper::Deparse I<or> $I<OBJ>->Deparse(I<[NEWVAL]>) 1221 1222Can be set to a boolean value to control whether code references are 1223turned into perl source code. If set to a true value, C<B::Deparse> 1224will be used to get the source of the code reference. In older versions, 1225using this option imposed a significant performance penalty when dumping 1226parts of a data structure other than code references, but that is no 1227longer the case. 1228 1229Caution : use this option only if you know that your coderefs will be 1230properly reconstructed by C<B::Deparse>. 1231 1232=item * 1233 1234$Data::Dumper::Sparseseen I<or> $I<OBJ>->Sparseseen(I<[NEWVAL]>) 1235 1236By default, Data::Dumper builds up the "seen" hash of scalars that 1237it has encountered during serialization. This is very expensive. 1238This seen hash is necessary to support and even just detect circular 1239references. It is exposed to the user via the C<Seen()> call both 1240for writing and reading. 1241 1242If you, as a user, do not need explicit access to the "seen" hash, 1243then you can set the C<Sparseseen> option to allow Data::Dumper 1244to eschew building the "seen" hash for scalars that are known not 1245to possess more than one reference. This speeds up serialization 1246considerably if you use the XS implementation. 1247 1248Note: If you turn on C<Sparseseen>, then you must not rely on the 1249content of the seen hash since its contents will be an 1250implementation detail! 1251 1252=back 1253 1254=head2 Exports 1255 1256=over 4 1257 1258=item Dumper 1259 1260=back 1261 1262=head1 EXAMPLES 1263 1264Run these code snippets to get a quick feel for the behavior of this 1265module. When you are through with these examples, you may want to 1266add or change the various configuration variables described above, 1267to see their behavior. (See the testsuite in the Data::Dumper 1268distribution for more examples.) 1269 1270 1271 use Data::Dumper; 1272 1273 package Foo; 1274 sub new {bless {'a' => 1, 'b' => sub { return "foo" }}, $_[0]}; 1275 1276 package Fuz; # a weird REF-REF-SCALAR object 1277 sub new {bless \($_ = \ 'fu\'z'), $_[0]}; 1278 1279 package main; 1280 $foo = Foo->new; 1281 $fuz = Fuz->new; 1282 $boo = [ 1, [], "abcd", \*foo, 1283 {1 => 'a', 023 => 'b', 0x45 => 'c'}, 1284 \\"p\q\'r", $foo, $fuz]; 1285 1286 ######## 1287 # simple usage 1288 ######## 1289 1290 $bar = eval(Dumper($boo)); 1291 print($@) if $@; 1292 print Dumper($boo), Dumper($bar); # pretty print (no array indices) 1293 1294 $Data::Dumper::Terse = 1; # don't output names where feasible 1295 $Data::Dumper::Indent = 0; # turn off all pretty print 1296 print Dumper($boo), "\n"; 1297 1298 $Data::Dumper::Indent = 1; # mild pretty print 1299 print Dumper($boo); 1300 1301 $Data::Dumper::Indent = 3; # pretty print with array indices 1302 print Dumper($boo); 1303 1304 $Data::Dumper::Useqq = 1; # print strings in double quotes 1305 print Dumper($boo); 1306 1307 $Data::Dumper::Pair = " : "; # specify hash key/value separator 1308 print Dumper($boo); 1309 1310 1311 ######## 1312 # recursive structures 1313 ######## 1314 1315 @c = ('c'); 1316 $c = \@c; 1317 $b = {}; 1318 $a = [1, $b, $c]; 1319 $b->{a} = $a; 1320 $b->{b} = $a->[1]; 1321 $b->{c} = $a->[2]; 1322 print Data::Dumper->Dump([$a,$b,$c], [qw(a b c)]); 1323 1324 1325 $Data::Dumper::Purity = 1; # fill in the holes for eval 1326 print Data::Dumper->Dump([$a, $b], [qw(*a b)]); # print as @a 1327 print Data::Dumper->Dump([$b, $a], [qw(*b a)]); # print as %b 1328 1329 1330 $Data::Dumper::Deepcopy = 1; # avoid cross-refs 1331 print Data::Dumper->Dump([$b, $a], [qw(*b a)]); 1332 1333 1334 $Data::Dumper::Purity = 0; # avoid cross-refs 1335 print Data::Dumper->Dump([$b, $a], [qw(*b a)]); 1336 1337 ######## 1338 # deep structures 1339 ######## 1340 1341 $a = "pearl"; 1342 $b = [ $a ]; 1343 $c = { 'b' => $b }; 1344 $d = [ $c ]; 1345 $e = { 'd' => $d }; 1346 $f = { 'e' => $e }; 1347 print Data::Dumper->Dump([$f], [qw(f)]); 1348 1349 $Data::Dumper::Maxdepth = 3; # no deeper than 3 refs down 1350 print Data::Dumper->Dump([$f], [qw(f)]); 1351 1352 1353 ######## 1354 # object-oriented usage 1355 ######## 1356 1357 $d = Data::Dumper->new([$a,$b], [qw(a b)]); 1358 $d->Seen({'*c' => $c}); # stash a ref without printing it 1359 $d->Indent(3); 1360 print $d->Dump; 1361 $d->Reset->Purity(0); # empty the seen cache 1362 print join "----\n", $d->Dump; 1363 1364 1365 ######## 1366 # persistence 1367 ######## 1368 1369 package Foo; 1370 sub new { bless { state => 'awake' }, shift } 1371 sub Freeze { 1372 my $s = shift; 1373 print STDERR "preparing to sleep\n"; 1374 $s->{state} = 'asleep'; 1375 return bless $s, 'Foo::ZZZ'; 1376 } 1377 1378 package Foo::ZZZ; 1379 sub Thaw { 1380 my $s = shift; 1381 print STDERR "waking up\n"; 1382 $s->{state} = 'awake'; 1383 return bless $s, 'Foo'; 1384 } 1385 1386 package main; 1387 use Data::Dumper; 1388 $a = Foo->new; 1389 $b = Data::Dumper->new([$a], ['c']); 1390 $b->Freezer('Freeze'); 1391 $b->Toaster('Thaw'); 1392 $c = $b->Dump; 1393 print $c; 1394 $d = eval $c; 1395 print Data::Dumper->Dump([$d], ['d']); 1396 1397 1398 ######## 1399 # symbol substitution (useful for recreating CODE refs) 1400 ######## 1401 1402 sub foo { print "foo speaking\n" } 1403 *other = \&foo; 1404 $bar = [ \&other ]; 1405 $d = Data::Dumper->new([\&other,$bar],['*other','bar']); 1406 $d->Seen({ '*foo' => \&foo }); 1407 print $d->Dump; 1408 1409 1410 ######## 1411 # sorting and filtering hash keys 1412 ######## 1413 1414 $Data::Dumper::Sortkeys = \&my_filter; 1415 my $foo = { map { (ord, "$_$_$_") } 'I'..'Q' }; 1416 my $bar = { %$foo }; 1417 my $baz = { reverse %$foo }; 1418 print Dumper [ $foo, $bar, $baz ]; 1419 1420 sub my_filter { 1421 my ($hash) = @_; 1422 # return an array ref containing the hash keys to dump 1423 # in the order that you want them to be dumped 1424 return [ 1425 # Sort the keys of %$foo in reverse numeric order 1426 $hash eq $foo ? (sort {$b <=> $a} keys %$hash) : 1427 # Only dump the odd number keys of %$bar 1428 $hash eq $bar ? (grep {$_ % 2} keys %$hash) : 1429 # Sort keys in default order for all other hashes 1430 (sort keys %$hash) 1431 ]; 1432 } 1433 1434=head1 BUGS 1435 1436Due to limitations of Perl subroutine call semantics, you cannot pass an 1437array or hash. Prepend it with a C<\> to pass its reference instead. This 1438will be remedied in time, now that Perl has subroutine prototypes. 1439For now, you need to use the extended usage form, and prepend the 1440name with a C<*> to output it as a hash or array. 1441 1442C<Data::Dumper> cheats with CODE references. If a code reference is 1443encountered in the structure being processed (and if you haven't set 1444the C<Deparse> flag), an anonymous subroutine that 1445contains the string '"DUMMY"' will be inserted in its place, and a warning 1446will be printed if C<Purity> is set. You can C<eval> the result, but bear 1447in mind that the anonymous sub that gets created is just a placeholder. 1448Even using the C<Deparse> flag will in some cases produce results that 1449behave differently after being passed to C<eval>; see the documentation 1450for L<B::Deparse>. 1451 1452SCALAR objects have the weirdest looking C<bless> workaround. 1453 1454Pure Perl version of C<Data::Dumper> escapes UTF-8 strings correctly 1455only in Perl 5.8.0 and later. 1456 1457=head2 NOTE 1458 1459Starting from Perl 5.8.1 different runs of Perl will have different 1460ordering of hash keys. The change was done for greater security, 1461see L<perlsec/"Algorithmic Complexity Attacks">. This means that 1462different runs of Perl will have different Data::Dumper outputs if 1463the data contains hashes. If you need to have identical Data::Dumper 1464outputs from different runs of Perl, use the environment variable 1465PERL_HASH_SEED, see L<perlrun/PERL_HASH_SEED>. Using this restores 1466the old (platform-specific) ordering: an even prettier solution might 1467be to use the C<Sortkeys> filter of Data::Dumper. 1468 1469=head1 AUTHOR 1470 1471Gurusamy Sarathy gsar@activestate.com 1472 1473Copyright (c) 1996-2019 Gurusamy Sarathy. All rights reserved. 1474This program is free software; you can redistribute it and/or 1475modify it under the same terms as Perl itself. 1476 1477=head1 VERSION 1478 1479Version 2.179 1480 1481=head1 SEE ALSO 1482 1483perl(1) 1484 1485=cut 1486