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