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