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