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