dist/Data-Dumper/Dumper.pm

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