package Data::Dumper;
-$VERSION = $VERSION = '2.101';
+$VERSION = '2.101';
#$| = 1;
-require 5.004;
+require 5.005_64;
require Exporter;
-require DynaLoader;
+use XSLoader ();
require overload;
use Carp;
-@ISA = qw(Exporter DynaLoader);
+@ISA = qw(Exporter);
@EXPORT = qw(Dumper);
@EXPORT_OK = qw(DumperX);
-bootstrap Data::Dumper;
+XSLoader::load 'Data::Dumper';
# module vars and their defaults
$Indent = 2 unless defined $Indent;
if ($type) {
# prep it, if it looks like an object
- if ($type =~ /[a-z_:]/) {
- my $freezer = $s->{freezer};
- $val->$freezer() if $freezer && UNIVERSAL::can($val, $freezer);
+ if (my $freezer = $s->{freezer}) {
+ $val->$freezer() if UNIVERSAL::can($val, $freezer);
}
($realpack, $realtype, $id) =
if ($s->{purity} and $s->{level} > 0) {
$out = ($realtype eq 'HASH') ? '{}' :
($realtype eq 'ARRAY') ? '[]' :
- "''" ;
+ 'do{my $o}' ;
push @post, $name . " = " . $s->{seen}{$id}[0];
}
else {
sub qquote {
local($_) = shift;
s/([\\\"\@\$])/\\$1/g;
- return qq("$_") unless /[^\040-\176]/; # fast exit
+ return qq("$_") unless
+ /[^ !"\#\$%&'()*+,\-.\/0-9:;<=>?\@A-Z[\\\]^_`a-z{|}~]/; # fast exit
my $high = shift || "";
s/([\a\b\t\n\f\r\e])/$esc{$1}/g;
- # no need for 3 digits in escape for these
- s/([\0-\037])(?!\d)/'\\'.sprintf('%o',ord($1))/eg;
-
- s/([\0-\037\177])/'\\'.sprintf('%03o',ord($1))/eg;
- if ($high eq "iso8859") {
- s/([\200-\240])/'\\'.sprintf('%o',ord($1))/eg;
- } elsif ($high eq "utf8") {
-# use utf8;
-# $str =~ s/([^\040-\176])/sprintf "\\x{%04x}", ord($1)/ge;
- } elsif ($high eq "8bit") {
- # leave it as it is
- } else {
- s/([\0-\037\177-\377])/'\\'.sprintf('%03o',ord($1))/eg;
+ if (ord('^')==94) { # ascii
+ # no need for 3 digits in escape for these
+ s/([\0-\037])(?!\d)/'\\'.sprintf('%o',ord($1))/eg;
+ s/([\0-\037\177])/'\\'.sprintf('%03o',ord($1))/eg;
+ # all but last branch below not supported --BEHAVIOR SUBJECT TO CHANGE--
+ if ($high eq "iso8859") {
+ s/([\200-\240])/'\\'.sprintf('%o',ord($1))/eg;
+ } elsif ($high eq "utf8") {
+# use utf8;
+# $str =~ s/([^\040-\176])/sprintf "\\x{%04x}", ord($1)/ge;
+ } elsif ($high eq "8bit") {
+ # leave it as it is
+ } else {
+ s/([\200-\377])/'\\'.sprintf('%03o',ord($1))/eg;
+ }
+ }
+ else { # ebcdic
+ s{([^ !"\#\$%&'()*+,\-.\/0-9:;<=>?\@A-Z[\\\]^_`a-z{|}~])(?!\d)}
+ {my $v = ord($1); '\\'.sprintf(($v <= 037 ? '%o' : '%03o'), $v)}eg;
+ s{([^ !"\#\$%&'()*+,\-.\/0-9:;<=>?\@A-Z[\\\]^_`a-z{|}~])}
+ {'\\'.sprintf('%03o',ord($1))}eg;
}
+
return qq("$_");
}
$boo = [ 1, [], "abcd", \*foo,
{1 => 'a', 023 => 'b', 0x45 => 'c'},
\\"p\q\'r", $foo, $fuz];
-
+
########
# simple usage
########
$Data::Dumper::Useqq = 1; # print strings in double quotes
print Dumper($boo);
-
-
+
+
########
# recursive structures
########
-
+
@c = ('c');
$c = \@c;
$b = {};
$b->{b} = $a->[1];
$b->{c} = $a->[2];
print Data::Dumper->Dump([$a,$b,$c], [qw(a b c)]);
-
-
+
+
$Data::Dumper::Purity = 1; # fill in the holes for eval
print Data::Dumper->Dump([$a, $b], [qw(*a b)]); # print as @a
print Data::Dumper->Dump([$b, $a], [qw(*b a)]); # print as %b
-
-
+
+
$Data::Dumper::Deepcopy = 1; # avoid cross-refs
print Data::Dumper->Dump([$b, $a], [qw(*b a)]);
-
-
+
+
$Data::Dumper::Purity = 0; # avoid cross-refs
print Data::Dumper->Dump([$b, $a], [qw(*b a)]);
-
+
########
# deep structures
########
-
+
$a = "pearl";
$b = [ $a ];
$c = { 'b' => $b };
$Data::Dumper::Maxdepth = 3; # no deeper than 3 refs down
print Data::Dumper->Dump([$f], [qw(f)]);
-
+
########
# object-oriented usage
########
-
+
$d = Data::Dumper->new([$a,$b], [qw(a b)]);
$d->Seen({'*c' => $c}); # stash a ref without printing it
$d->Indent(3);
print $d->Dump;
$d->Reset->Purity(0); # empty the seen cache
print join "----\n", $d->Dump;
-
-
+
+
########
# persistence
########
-
+
package Foo;
sub new { bless { state => 'awake' }, shift }
sub Freeze {
$s->{state} = 'asleep';
return bless $s, 'Foo::ZZZ';
}
-
+
package Foo::ZZZ;
sub Thaw {
my $s = shift;
$s->{state} = 'awake';
return bless $s, 'Foo';
}
-
+
package Foo;
use Data::Dumper;
$a = Foo->new;
print $c;
$d = eval $c;
print Data::Dumper->Dump([$d], ['d']);
-
-
+
+
########
# symbol substitution (useful for recreating CODE refs)
########
-
+
sub foo { print "foo speaking\n" }
*other = \&foo;
$bar = [ \&other ];
=head1 AUTHOR
-Gurusamy Sarathy gsar@umich.edu
+Gurusamy Sarathy gsar@activestate.com
Copyright (c) 1996-98 Gurusamy Sarathy. All rights reserved.
This program is free software; you can redistribute it and/or