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})$/) { # safe decimal number
 450       $out .= $val;
 451     }
 452     else {                               # string
 453       if ($s->{useqq}) {
 454         $out .= qquote($val, $s->{useqq});
 455       }
 456       else {
 457         $val =~ s/([\\\'])/\\$1/g;
 458         $out .= '\'' . $val .  '\'';
 459       }
 460     }
 461   }
 462   if ($id) {
 463     # if we made it this far, $id was added to seen list at current
 464     # level, so remove it to get deep copies
 465     if ($s->{deepcopy}) {
 466       delete($s->{seen}{$id});
 467     }
 468     elsif ($name) {
 469       $s->{seen}{$id}[2] = 1;
 470     }
 471   }
 472   return $out;
 473 }
 474
 475 #
 476 # non-OO style of earlier version
 477 #
 478 sub Dumper {
 479   return Data::Dumper->Dump([@_]);
 480 }
 481
 482 # compat stub
 483 sub DumperX {
 484   return Data::Dumper->Dumpxs([@_], []);
 485 }
 486
 487 sub Dumpf { return Data::Dumper->Dump(@_) }
 488
 489 sub Dumpp { print Data::Dumper->Dump(@_) }
 490
 491 #
 492 # reset the "seen" cache
 493 #
 494 sub Reset {
 495   my($s) = shift;
 496   $s->{seen} = {};
 497   return $s;
 498 }
 499
 500 sub Indent {
 501   my($s, $v) = @_;
 502   if (defined($v)) {
 503     if ($v == 0) {
 504       $s->{xpad} = "";
 505       $s->{sep} = "";
 506     }
 507     else {
 508       $s->{xpad} = "  ";
 509       $s->{sep} = "\n";
 510     }
 511     $s->{indent} = $v;
 512     return $s;
 513   }
 514   else {
 515     return $s->{indent};
 516   }
 517 }
 518
 519 sub Pad {
 520   my($s, $v) = @_;
 521   defined($v) ? (($s->{pad} = $v), return $s) : $s->{pad};
 522 }
 523
 524 sub Varname {
 525   my($s, $v) = @_;
 526   defined($v) ? (($s->{varname} = $v), return $s) : $s->{varname};
 527 }
 528
 529 sub Purity {
 530   my($s, $v) = @_;
 531   defined($v) ? (($s->{purity} = $v), return $s) : $s->{purity};
 532 }
 533
 534 sub Useqq {
 535   my($s, $v) = @_;
 536   defined($v) ? (($s->{useqq} = $v), return $s) : $s->{useqq};
 537 }
 538
 539 sub Terse {
 540   my($s, $v) = @_;
 541   defined($v) ? (($s->{terse} = $v), return $s) : $s->{terse};
 542 }
 543
 544 sub Freezer {
 545   my($s, $v) = @_;
 546   defined($v) ? (($s->{freezer} = $v), return $s) : $s->{freezer};
 547 }
 548
 549 sub Toaster {
 550   my($s, $v) = @_;
 551   defined($v) ? (($s->{toaster} = $v), return $s) : $s->{toaster};
 552 }
 553
 554 sub Deepcopy {
 555   my($s, $v) = @_;
 556   defined($v) ? (($s->{deepcopy} = $v), return $s) : $s->{deepcopy};
 557 }
 558
 559 sub Quotekeys {
 560   my($s, $v) = @_;
 561   defined($v) ? (($s->{quotekeys} = $v), return $s) : $s->{quotekeys};
 562 }
 563
 564 sub Bless {
 565   my($s, $v) = @_;
 566   defined($v) ? (($s->{'bless'} = $v), return $s) : $s->{'bless'};
 567 }
 568
 569 sub Maxdepth {
 570   my($s, $v) = @_;
 571   defined($v) ? (($s->{'maxdepth'} = $v), return $s) : $s->{'maxdepth'};
 572 }
 573
 574 sub Useperl {
 575   my($s, $v) = @_;
 576   defined($v) ? (($s->{'useperl'} = $v), return $s) : $s->{'useperl'};
 577 }
 578
 579 sub Sortkeys {
 580   my($s, $v) = @_;
 581   defined($v) ? (($s->{'sortkeys'} = $v), return $s) : $s->{'sortkeys'};
 582 }
 583
 584 sub Deparse {
 585   my($s, $v) = @_;
 586   defined($v) ? (($s->{'deparse'} = $v), return $s) : $s->{'deparse'};
 587 }
 588
 589 # used by qquote below
 590 my %esc = (
 591     "\a" => "\\a",
 592     "\b" => "\\b",
 593     "\t" => "\\t",
 594     "\n" => "\\n",
 595     "\f" => "\\f",
 596     "\r" => "\\r",
 597     "\e" => "\\e",
 598 );
 599
 600 # put a string value in double quotes
 601 sub qquote {
 602   local($_) = shift;
 603   s/([\\\"\@\$])/\\$1/g;
 604   my $bytes; { use bytes; $bytes = length }
 605   s/([^\x00-\x7f])/'\x{'.sprintf("%x",ord($1)).'}'/ge if $bytes > length;
 606   return qq("$_") unless
 607     /[^ !"\#\$%&'()*+,\-.\/0-9:;<=>?\@A-Z[\\\]^_`a-z{|}~]/;  # fast exit
 608
 609   my $high = shift || "";
 610   s/([\a\b\t\n\f\r\e])/$esc{$1}/g;
 611
 612   if (ord('^')==94)  { # ascii
 613     # no need for 3 digits in escape for these
 614     s/([\0-\037])(?!\d)/'\\'.sprintf('%o',ord($1))/eg;
 615     s/([\0-\037\177])/'\\'.sprintf('%03o',ord($1))/eg;
 616     # all but last branch below not supported --BEHAVIOR SUBJECT TO CHANGE--
 617     if ($high eq "iso8859") {
 618       s/([\200-\240])/'\\'.sprintf('%o',ord($1))/eg;
 619     } elsif ($high eq "utf8") {
 620 #     use utf8;
 621 #     $str =~ s/([^\040-\176])/sprintf "\\x{%04x}", ord($1)/ge;
 622     } elsif ($high eq "8bit") {
 623         # leave it as it is
 624     } else {
 625       s/([\200-\377])/'\\'.sprintf('%03o',ord($1))/eg;
 626     }
 627   }
 628   else { # ebcdic
 629       s{([^ !"\#\$%&'()*+,\-.\/0-9:;<=>?\@A-Z[\\\]^_`a-z{|}~])(?!\d)}
 630        {my $v = ord($1); '\\'.sprintf(($v <= 037 ? '%o' : '%03o'), $v)}eg;
 631       s{([^ !"\#\$%&'()*+,\-.\/0-9:;<=>?\@A-Z[\\\]^_`a-z{|}~])}
 632        {'\\'.sprintf('%03o',ord($1))}eg;
 633   }
 634
 635   return qq("$_");
 636 }
 637
 638 1;
 639 __END__
 640
 641 =head1 NAME
 642
 643 Data::Dumper - stringified perl data structures, suitable for both printing and C<eval>
 644
 645 =head1 SYNOPSIS
 646
 647     use Data::Dumper;
 648
 649     # simple procedural interface
 650     print Dumper($foo, $bar);
 651
 652     # extended usage with names
 653     print Data::Dumper->Dump([$foo, $bar], [qw(foo *ary)]);
 654
 655     # configuration variables
 656     {
 657       local $Data::Dump::Purity = 1;
 658       eval Data::Dumper->Dump([$foo, $bar], [qw(foo *ary)]);
 659     }
 660
 661     # OO usage
 662     $d = Data::Dumper->new([$foo, $bar], [qw(foo *ary)]);
 663        ...
 664     print $d->Dump;
 665        ...
 666     $d->Purity(1)->Terse(1)->Deepcopy(1);
 667     eval $d->Dump;
 668
 669
 670 =head1 DESCRIPTION
 671
 672 Given a list of scalars or reference variables, writes out their contents in
 673 perl syntax. The references can also be objects.  The contents of each
 674 variable is output in a single Perl statement.  Handles self-referential
 675 structures correctly.
 676
 677 The return value can be C<eval>ed to get back an identical copy of the
 678 original reference structure.
 679
 680 Any references that are the same as one of those passed in will be named
 681 C<$VAR>I<n> (where I<n> is a numeric suffix), and other duplicate references
 682 to substructures within C<$VAR>I<n> will be appropriately labeled using arrow
 683 notation.  You can specify names for individual values to be dumped if you
 684 use the C<Dump()> method, or you can change the default C<$VAR> prefix to
 685 something else.  See C<$Data::Dumper::Varname> and C<$Data::Dumper::Terse>
 686 below.
 687
 688 The default output of self-referential structures can be C<eval>ed, but the
 689 nested references to C<$VAR>I<n> will be undefined, since a recursive
 690 structure cannot be constructed using one Perl statement.  You should set the
 691 C<Purity> flag to 1 to get additional statements that will correctly fill in
 692 these references.
 693
 694 In the extended usage form, the references to be dumped can be given
 695 user-specified names.  If a name begins with a C<*>, the output will
 696 describe the dereferenced type of the supplied reference for hashes and
 697 arrays, and coderefs.  Output of names will be avoided where possible if
 698 the C<Terse> flag is set.
 699
 700 In many cases, methods that are used to set the internal state of the
 701 object will return the object itself, so method calls can be conveniently
 702 chained together.
 703
 704 Several styles of output are possible, all controlled by setting
 705 the C<Indent> flag.  See L<Configuration Variables or Methods> below
 706 for details.
 707
 708
 709 =head2 Methods
 710
 711 =over 4
 712
 713 =item I<PACKAGE>->new(I<ARRAYREF [>, I<ARRAYREF]>)
 714
 715 Returns a newly created C<Data::Dumper> object.  The first argument is an
 716 anonymous array of values to be dumped.  The optional second argument is an
 717 anonymous array of names for the values.  The names need not have a leading
 718 C<$> sign, and must be comprised of alphanumeric characters.  You can begin
 719 a name with a C<*> to specify that the dereferenced type must be dumped
 720 instead of the reference itself, for ARRAY and HASH references.
 721
 722 The prefix specified by C<$Data::Dumper::Varname> will be used with a
 723 numeric suffix if the name for a value is undefined.
 724
 725 Data::Dumper will catalog all references encountered while dumping the
 726 values. Cross-references (in the form of names of substructures in perl
 727 syntax) will be inserted at all possible points, preserving any structural
 728 interdependencies in the original set of values.  Structure traversal is
 729 depth-first,  and proceeds in order from the first supplied value to
 730 the last.
 731
 732 =item I<$OBJ>->Dump  I<or>  I<PACKAGE>->Dump(I<ARRAYREF [>, I<ARRAYREF]>)
 733
 734 Returns the stringified form of the values stored in the object (preserving
 735 the order in which they were supplied to C<new>), subject to the
 736 configuration options below.  In a list context, it returns a list
 737 of strings corresponding to the supplied values.
 738
 739 The second form, for convenience, simply calls the C<new> method on its
 740 arguments before dumping the object immediately.
 741
 742 =item I<$OBJ>->Seen(I<[HASHREF]>)
 743
 744 Queries or adds to the internal table of already encountered references.
 745 You must use C<Reset> to explicitly clear the table if needed.  Such
 746 references are not dumped; instead, their names are inserted wherever they
 747 are encountered subsequently.  This is useful especially for properly
 748 dumping subroutine references.
 749
 750 Expects a anonymous hash of name => value pairs.  Same rules apply for names
 751 as in C<new>.  If no argument is supplied, will return the "seen" list of
 752 name => value pairs, in a list context.  Otherwise, returns the object
 753 itself.
 754
 755 =item I<$OBJ>->Values(I<[ARRAYREF]>)
 756
 757 Queries or replaces the internal array of values that will be dumped.
 758 When called without arguments, returns the values.  Otherwise, returns the
 759 object itself.
 760
 761 =item I<$OBJ>->Names(I<[ARRAYREF]>)
 762
 763 Queries or replaces the internal array of user supplied names for the values
 764 that will be dumped.  When called without arguments, returns the names.
 765 Otherwise, returns the object itself.
 766
 767 =item I<$OBJ>->Reset
 768
 769 Clears the internal table of "seen" references and returns the object
 770 itself.
 771
 772 =back
 773
 774 =head2 Functions
 775
 776 =over 4
 777
 778 =item Dumper(I<LIST>)
 779
 780 Returns the stringified form of the values in the list, subject to the
 781 configuration options below.  The values will be named C<$VAR>I<n> in the
 782 output, where I<n> is a numeric suffix.  Will return a list of strings
 783 in a list context.
 784
 785 =back
 786
 787 =head2 Configuration Variables or Methods
 788
 789 Several configuration variables can be used to control the kind of output
 790 generated when using the procedural interface.  These variables are usually
 791 C<local>ized in a block so that other parts of the code are not affected by
 792 the change.
 793
 794 These variables determine the default state of the object created by calling
 795 the C<new> method, but cannot be used to alter the state of the object
 796 thereafter.  The equivalent method names should be used instead to query
 797 or set the internal state of the object.
 798
 799 The method forms return the object itself when called with arguments,
 800 so that they can be chained together nicely.
 801
 802 =over 4
 803
 804 =item $Data::Dumper::Indent  I<or>  I<$OBJ>->Indent(I<[NEWVAL]>)
 805
 806 Controls the style of indentation.  It can be set to 0, 1, 2 or 3.  Style 0
 807 spews output without any newlines, indentation, or spaces between list
 808 items.  It is the most compact format possible that can still be called
 809 valid perl.  Style 1 outputs a readable form with newlines but no fancy
 810 indentation (each level in the structure is simply indented by a fixed
 811 amount of whitespace).  Style 2 (the default) outputs a very readable form
 812 which takes into account the length of hash keys (so the hash value lines
 813 up).  Style 3 is like style 2, but also annotates the elements of arrays
 814 with their index (but the comment is on its own line, so array output
 815 consumes twice the number of lines).  Style 2 is the default.
 816
 817 =item $Data::Dumper::Purity  I<or>  I<$OBJ>->Purity(I<[NEWVAL]>)
 818
 819 Controls the degree to which the output can be C<eval>ed to recreate the
 820 supplied reference structures.  Setting it to 1 will output additional perl
 821 statements that will correctly recreate nested references.  The default is
 822 0.
 823
 824 =item $Data::Dumper::Pad  I<or>  I<$OBJ>->Pad(I<[NEWVAL]>)
 825
 826 Specifies the string that will be prefixed to every line of the output.
 827 Empty string by default.
 828
 829 =item $Data::Dumper::Varname  I<or>  I<$OBJ>->Varname(I<[NEWVAL]>)
 830
 831 Contains the prefix to use for tagging variable names in the output. The
 832 default is "VAR".
 833
 834 =item $Data::Dumper::Useqq  I<or>  I<$OBJ>->Useqq(I<[NEWVAL]>)
 835
 836 When set, enables the use of double quotes for representing string values.
 837 Whitespace other than space will be represented as C<[\n\t\r]>, "unsafe"
 838 characters will be backslashed, and unprintable characters will be output as
 839 quoted octal integers.  Since setting this variable imposes a performance
 840 penalty, the default is 0.  C<Dump()> will run slower if this flag is set,
 841 since the fast XSUB implementation doesn't support it yet.
 842
 843 =item $Data::Dumper::Terse  I<or>  I<$OBJ>->Terse(I<[NEWVAL]>)
 844
 845 When set, Data::Dumper will emit single, non-self-referential values as
 846 atoms/terms rather than statements.  This means that the C<$VAR>I<n> names
 847 will be avoided where possible, but be advised that such output may not
 848 always be parseable by C<eval>.
 849
 850 =item $Data::Dumper::Freezer  I<or>  $I<OBJ>->Freezer(I<[NEWVAL]>)
 851
 852 Can be set to a method name, or to an empty string to disable the feature.
 853 Data::Dumper will invoke that method via the object before attempting to
 854 stringify it.  This method can alter the contents of the object (if, for
 855 instance, it contains data allocated from C), and even rebless it in a
 856 different package.  The client is responsible for making sure the specified
 857 method can be called via the object, and that the object ends up containing
 858 only perl data types after the method has been called.  Defaults to an empty
 859 string.
 860
 861 =item $Data::Dumper::Toaster  I<or>  $I<OBJ>->Toaster(I<[NEWVAL]>)
 862
 863 Can be set to a method name, or to an empty string to disable the feature.
 864 Data::Dumper will emit a method call for any objects that are to be dumped
 865 using the syntax C<bless(DATA, CLASS)-E<gt>METHOD()>.  Note that this means that
 866 the method specified will have to perform any modifications required on the
 867 object (like creating new state within it, and/or reblessing it in a
 868 different package) and then return it.  The client is responsible for making
 869 sure the method can be called via the object, and that it returns a valid
 870 object.  Defaults to an empty string.
 871
 872 =item $Data::Dumper::Deepcopy  I<or>  $I<OBJ>->Deepcopy(I<[NEWVAL]>)
 873
 874 Can be set to a boolean value to enable deep copies of structures.
 875 Cross-referencing will then only be done when absolutely essential
 876 (i.e., to break reference cycles).  Default is 0.
 877
 878 =item $Data::Dumper::Quotekeys  I<or>  $I<OBJ>->Quotekeys(I<[NEWVAL]>)
 879
 880 Can be set to a boolean value to control whether hash keys are quoted.
 881 A false value will avoid quoting hash keys when it looks like a simple
 882 string.  Default is 1, which will always enclose hash keys in quotes.
 883
 884 =item $Data::Dumper::Bless  I<or>  $I<OBJ>->Bless(I<[NEWVAL]>)
 885
 886 Can be set to a string that specifies an alternative to the C<bless>
 887 builtin operator used to create objects.  A function with the specified
 888 name should exist, and should accept the same arguments as the builtin.
 889 Default is C<bless>.
 890
 891 =item $Data::Dumper::Maxdepth  I<or>  $I<OBJ>->Maxdepth(I<[NEWVAL]>)
 892
 893 Can be set to a positive integer that specifies the depth beyond which
 894 which we don't venture into a structure.  Has no effect when
 895 C<Data::Dumper::Purity> is set.  (Useful in debugger when we often don't
 896 want to see more than enough).  Default is 0, which means there is
 897 no maximum depth.
 898
 899 =item $Data::Dumper::Useperl  I<or>  $I<OBJ>->Useperl(I<[NEWVAL]>)
 900
 901 Can be set to a boolean value which controls whether the pure Perl
 902 implementation of C<Data::Dumper> is used. The C<Data::Dumper> module is
 903 a dual implementation, with almost all functionality written in both
 904 pure Perl and also in XS ('C'). Since the XS version is much faster, it
 905 will always be used if possible. This option lets you override the
 906 default behavior, usually for testing purposes only. Default is 0, which
 907 means the XS implementation will be used if possible.
 908
 909 =item $Data::Dumper::Sortkeys  I<or>  $I<OBJ>->Sortkeys(I<[NEWVAL]>)
 910
 911 Can be set to a boolean value to control whether hash keys are dumped in
 912 sorted order. A true value will cause the keys of all hashes to be
 913 dumped in Perl's default sort order. Can also be set to a subroutine
 914 reference which will be called for each hash that is dumped. In this
 915 case C<Data::Dumper> will call the subroutine once for each hash,
 916 passing it the reference of the hash. The purpose of the subroutine is
 917 to return a reference to an array of the keys that will be dumped, in
 918 the order that they should be dumped. Using this feature, you can
 919 control both the order of the keys, and which keys are actually used. In
 920 other words, this subroutine acts as a filter by which you can exclude
 921 certain keys from being dumped. Default is 0, which means that hash keys
 922 are not sorted.
 923
 924 =item $Data::Dumper::Deparse  I<or>  $I<OBJ>->Deparse(I<[NEWVAL]>)
 925
 926 Can be set to a boolean value to control whether code references are
 927 turned into perl source code. If set to a true value, C<B::Deparse>
 928 will be used to get the source of the code reference. Using this option
 929 will force using the Perl implementation of the dumper, since the fast
 930 XSUB implementation doesn't support it.
 931
 932 Caution : use this option only if you know that your coderefs will be
 933 properly reconstructed by C<B::Deparse>.
 934
 935 =back
 936
 937 =head2 Exports
 938
 939 =over 4
 940
 941 =item Dumper
 942
 943 =back
 944
 945 =head1 EXAMPLES
 946
 947 Run these code snippets to get a quick feel for the behavior of this
 948 module.  When you are through with these examples, you may want to
 949 add or change the various configuration variables described above,
 950 to see their behavior.  (See the testsuite in the Data::Dumper
 951 distribution for more examples.)
 952
 953
 954     use Data::Dumper;
 955
 956     package Foo;
 957     sub new {bless {'a' => 1, 'b' => sub { return "foo" }}, $_[0]};
 958
 959     package Fuz;                       # a weird REF-REF-SCALAR object
 960     sub new {bless \($_ = \ 'fu\'z'), $_[0]};
 961
 962     package main;
 963     $foo = Foo->new;
 964     $fuz = Fuz->new;
 965     $boo = [ 1, [], "abcd", \*foo,
 966              {1 => 'a', 023 => 'b', 0x45 => 'c'},
 967              \\"p\q\'r", $foo, $fuz];
 968
 969     ########
 970     # simple usage
 971     ########
 972
 973     $bar = eval(Dumper($boo));
 974     print($@) if $@;
 975     print Dumper($boo), Dumper($bar);  # pretty print (no array indices)
 976
 977     $Data::Dumper::Terse = 1;          # don't output names where feasible
 978     $Data::Dumper::Indent = 0;         # turn off all pretty print
 979     print Dumper($boo), "\n";
 980
 981     $Data::Dumper::Indent = 1;         # mild pretty print
 982     print Dumper($boo);
 983
 984     $Data::Dumper::Indent = 3;         # pretty print with array indices
 985     print Dumper($boo);
 986
 987     $Data::Dumper::Useqq = 1;          # print strings in double quotes
 988     print Dumper($boo);
 989
 990
 991     ########
 992     # recursive structures
 993     ########
 994
 995     @c = ('c');
 996     $c = \@c;
 997     $b = {};
 998     $a = [1, $b, $c];
 999     $b->{a} = $a;
1000     $b->{b} = $a->[1];
1001     $b->{c} = $a->[2];
1002     print Data::Dumper->Dump([$a,$b,$c], [qw(a b c)]);
1003
1004
1005     $Data::Dumper::Purity = 1;         # fill in the holes for eval
1006     print Data::Dumper->Dump([$a, $b], [qw(*a b)]); # print as @a
1007     print Data::Dumper->Dump([$b, $a], [qw(*b a)]); # print as %b
1008
1009
1010     $Data::Dumper::Deepcopy = 1;       # avoid cross-refs
1011     print Data::Dumper->Dump([$b, $a], [qw(*b a)]);
1012
1013
1014     $Data::Dumper::Purity = 0;         # avoid cross-refs
1015     print Data::Dumper->Dump([$b, $a], [qw(*b a)]);
1016
1017     ########
1018     # deep structures
1019     ########
1020
1021     $a = "pearl";
1022     $b = [ $a ];
1023     $c = { 'b' => $b };
1024     $d = [ $c ];
1025     $e = { 'd' => $d };
1026     $f = { 'e' => $e };
1027     print Data::Dumper->Dump([$f], [qw(f)]);
1028
1029     $Data::Dumper::Maxdepth = 3;       # no deeper than 3 refs down
1030     print Data::Dumper->Dump([$f], [qw(f)]);
1031
1032
1033     ########
1034     # object-oriented usage
1035     ########
1036
1037     $d = Data::Dumper->new([$a,$b], [qw(a b)]);
1038     $d->Seen({'*c' => $c});            # stash a ref without printing it
1039     $d->Indent(3);
1040     print $d->Dump;
1041     $d->Reset->Purity(0);              # empty the seen cache
1042     print join "----\n", $d->Dump;
1043
1044
1045     ########
1046     # persistence
1047     ########
1048
1049     package Foo;
1050     sub new { bless { state => 'awake' }, shift }
1051     sub Freeze {
1052         my $s = shift;
1053         print STDERR "preparing to sleep\n";
1054         $s->{state} = 'asleep';
1055         return bless $s, 'Foo::ZZZ';
1056     }
1057
1058     package Foo::ZZZ;
1059     sub Thaw {
1060         my $s = shift;
1061         print STDERR "waking up\n";
1062         $s->{state} = 'awake';
1063         return bless $s, 'Foo';
1064     }
1065
1066     package Foo;
1067     use Data::Dumper;
1068     $a = Foo->new;
1069     $b = Data::Dumper->new([$a], ['c']);
1070     $b->Freezer('Freeze');
1071     $b->Toaster('Thaw');
1072     $c = $b->Dump;
1073     print $c;
1074     $d = eval $c;
1075     print Data::Dumper->Dump([$d], ['d']);
1076
1077
1078     ########
1079     # symbol substitution (useful for recreating CODE refs)
1080     ########
1081
1082     sub foo { print "foo speaking\n" }
1083     *other = \&foo;
1084     $bar = [ \&other ];
1085     $d = Data::Dumper->new([\&other,$bar],['*other','bar']);
1086     $d->Seen({ '*foo' => \&foo });
1087     print $d->Dump;
1088
1089
1090     ########
1091     # sorting and filtering hash keys
1092     ########
1093
1094     $Data::Dumper::Sortkeys = \&my_filter;
1095     my $foo = { map { (ord, "$_$_$_") } 'I'..'Q' };
1096     my $bar = { %$foo };
1097     my $baz = { reverse %$foo };
1098     print Dumper [ $foo, $bar, $baz ];
1099
1100     sub my_filter {
1101         my ($hash) = @_;
1102         # return an array ref containing the hash keys to dump
1103         # in the order that you want them to be dumped
1104         return [
1105           # Sort the keys of %$foo in reverse numeric order
1106             $hash eq $foo ? (sort {$b <=> $a} keys %$hash) :
1107           # Only dump the odd number keys of %$bar
1108             $hash eq $bar ? (grep {$_ % 2} keys %$hash) :
1109           # Sort keys in default order for all other hashes
1110             (sort keys %$hash)
1111         ];
1112     }
1113
1114 =head1 BUGS
1115
1116 Due to limitations of Perl subroutine call semantics, you cannot pass an
1117 array or hash.  Prepend it with a C<\> to pass its reference instead.  This
1118 will be remedied in time, now that Perl has subroutine prototypes.
1119 For now, you need to use the extended usage form, and prepend the
1120 name with a C<*> to output it as a hash or array.
1121
1122 C<Data::Dumper> cheats with CODE references.  If a code reference is
1123 encountered in the structure being processed (and if you haven't set
1124 the C<Deparse> flag), an anonymous subroutine that
1125 contains the string '"DUMMY"' will be inserted in its place, and a warning
1126 will be printed if C<Purity> is set.  You can C<eval> the result, but bear
1127 in mind that the anonymous sub that gets created is just a placeholder.
1128 Someday, perl will have a switch to cache-on-demand the string
1129 representation of a compiled piece of code, I hope.  If you have prior
1130 knowledge of all the code refs that your data structures are likely
1131 to have, you can use the C<Seen> method to pre-seed the internal reference
1132 table and make the dumped output point to them, instead.  See L<EXAMPLES>
1133 above.
1134
1135 The C<Useqq> and C<Deparse> flags makes Dump() run slower, since the
1136 XSUB implementation does not support them.
1137
1138 SCALAR objects have the weirdest looking C<bless> workaround.
1139
1140
1141 =head1 AUTHOR
1142
1143 Gurusamy Sarathy        gsar@activestate.com
1144
1145 Copyright (c) 1996-98 Gurusamy Sarathy. All rights reserved.
1146 This program is free software; you can redistribute it and/or
1147 modify it under the same terms as Perl itself.
1148
1149
1150 =head1 VERSION
1151
1152 Version 2.12   (unreleased)
1153
1154 =head1 SEE ALSO
1155
1156 perl(1)
1157
1158 =cut