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