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