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