package Data::Dumper;
-$VERSION = $VERSION = '2.09';
+$VERSION = $VERSION = '2.10';
#$| = 1;
my($sname);
my($out, $realpack, $realtype, $type, $ipad, $id, $blesspad);
- return "undef" unless defined $val;
-
$type = ref $val;
$out = "";
# prep it, if it looks like an object
if ($type =~ /[a-z_:]/) {
my $freezer = $s->{freezer};
- # UNIVERSAL::can should be used here, when we can require 5.004
- if ($freezer) {
- eval { $val->$freezer() };
- carp "WARNING(Freezer method call failed): $@" if $@;
- }
+ $val->$freezer() if $freezer && UNIVERSAL::can($val, $freezer);
}
($realpack, $realtype, $id) =
(overload::StrVal($val) =~ /^(?:(.*)\=)?([^=]*)\(([^\(]*)\)$/);
- # keep a tab on it so that we dont fall into recursive pit
- if (exists $s->{seen}{$id}) {
-# if ($s->{expdepth} < $s->{level}) {
- if ($s->{purity} and $s->{level} > 0) {
- $out = ($realtype eq 'HASH') ? '{}' :
- ($realtype eq 'ARRAY') ? '[]' :
- "''" ;
- push @post, $name . " = " . $s->{seen}{$id}[0];
- }
- else {
- $out = $s->{seen}{$id}[0];
- if ($name =~ /^([\@\%])/) {
- my $start = $1;
- if ($out =~ /^\\$start/) {
- $out = substr($out, 1);
+ # if it has a name, we need to either look it up, or keep a tab
+ # on it so we know when we hit it later
+ if (defined($name) and length($name)) {
+ # keep a tab on it so that we dont fall into recursive pit
+ if (exists $s->{seen}{$id}) {
+# if ($s->{expdepth} < $s->{level}) {
+ if ($s->{purity} and $s->{level} > 0) {
+ $out = ($realtype eq 'HASH') ? '{}' :
+ ($realtype eq 'ARRAY') ? '[]' :
+ "''" ;
+ push @post, $name . " = " . $s->{seen}{$id}[0];
}
else {
- $out = $start . '{' . $out . '}';
- }
- }
+ $out = $s->{seen}{$id}[0];
+ if ($name =~ /^([\@\%])/) {
+ my $start = $1;
+ if ($out =~ /^\\$start/) {
+ $out = substr($out, 1);
+ }
+ else {
+ $out = $start . '{' . $out . '}';
+ }
+ }
+ }
+ return $out;
+# }
+ }
+ else {
+ # store our name
+ $s->{seen}{$id} = [ (($name =~ /^[@%]/) ? ('\\' . $name ) :
+ ($realtype eq 'CODE' and
+ $name =~ /^[*](.*)$/) ? ('\\&' . $1 ) :
+ $name ),
+ $val ];
}
- return $out;
-# }
- }
- else {
- # store our name
- $s->{seen}{$id} = [ (($name =~ /^[@%]/) ? ('\\' . $name ) :
- ($realtype eq 'CODE' and
- $name =~ /^[*](.*)$/) ? ('\\&' . $1 ) :
- $name ),
- $val ];
}
$s->{level}++;
if ($realtype eq 'SCALAR') {
if ($realpack) {
- $out .= 'do{\\(my $o = ' . $s->_dump($$val, "") . ')}';
+ $out .= 'do{\\(my $o = ' . $s->_dump($$val, "\${$name}") . ')}';
}
else {
- $out .= '\\' . $s->_dump($$val, "");
+ $out .= '\\' . $s->_dump($$val, "\${$name}");
}
}
elsif ($realtype eq 'GLOB') {
- $out .= '\\' . $s->_dump($$val, "");
+ $out .= '\\' . $s->_dump($$val, "*{$name}");
}
elsif ($realtype eq 'ARRAY') {
my($v, $pad, $mname);
$out .= ($name =~ /^\@/) ? '(' : '[';
$pad = $s->{sep} . $s->{pad} . $s->{apad};
($name =~ /^\@(.*)$/) ? ($mname = "\$" . $1) :
- ($name =~ /[]}]$/) ? ($mname = $name) : ($mname = $name . '->');
+ # omit -> if $foo->[0]->{bar}, but not ${$foo->[0]}->{bar}
+ ($name =~ /^\\?[\%\@\*\$][^{].*[]}]$/) ? ($mname = $name) :
+ ($mname = $name . '->');
$mname .= '->' if $mname =~ /^\*.+\{[A-Z]+\}$/;
for $v (@$val) {
$sname = $mname . '[' . $i . ']';
$out .= ($name =~ /^\%/) ? '(' : '{';
$pad = $s->{sep} . $s->{pad} . $s->{apad};
$lpad = $s->{apad};
- ($name =~ /^\%(.*)$/) ? ($mname = "\$" . $1) :
- ($name =~ /[]}]$/) ? ($mname = $name) : ($mname = $name . '->');
+ ($name =~ /^\%(.*)$/) ? ($mname = "\$" . $1) :
+ # omit -> if $foo->[0]->{bar}, but not ${$foo->[0]}->{bar}
+ ($name =~ /^\\?[\%\@\*\$][^{].*[]}]$/) ? ($mname = $name) :
+ ($mname = $name . '->');
$mname .= '->' if $mname =~ /^\*.+\{[A-Z]+\}$/;
while (($k, $v) = each %$val) {
my $nk = $s->_dump($k, "");
if ($name ne '') {
($id) = ("$ref" =~ /\(([^\(]*)\)$/);
if (exists $s->{seen}{$id}) {
- $out = $s->{seen}{$id}[0];
- return $out;
+ if ($s->{seen}{$id}[2]) {
+ $out = $s->{seen}{$id}[0];
+ #warn "[<$out]\n";
+ return "\${$out}";
+ }
}
else {
- $s->{seen}{$id} = ["\\$name", $val];
+ #warn "[>\\$name]\n";
+ $s->{seen}{$id} = ["\\$name", $ref];
}
}
if (ref($ref) eq 'GLOB' or "$ref" =~ /=GLOB\([^()]+\)$/) { # glob
my $k;
local ($s->{level}) = 0;
for $k (qw(SCALAR ARRAY HASH)) {
+ my $gval = *$val{$k};
+ next unless defined $gval;
+ next if $k eq "SCALAR" && ! defined $$gval; # always there
+
# _dump can push into @post, so we hold our place using $postlen
my $postlen = scalar @post;
$post[$postlen] = "\*$sname = ";
local ($s->{apad}) = " " x length($post[$postlen]) if $s->{indent} >= 2;
- $post[$postlen] .= $s->_dump(*{$name}{$k}, "\*$sname\{$k\}");
+ $post[$postlen] .= $s->_dump($gval, "\*$sname\{$k\}");
}
}
$out .= '*' . $sname;
}
+ elsif (!defined($val)) {
+ $out .= "undef";
+ }
elsif ($val =~ /^-?[1-9]\d{0,8}$/) { # safe decimal number
$out .= $val;
}
else { # string
if ($s->{useqq}) {
- $out .= qquote($val);
+ $out .= qquote($val, $s->{useqq});
}
else {
$val =~ s/([\\\'])/\\$1/g;
}
}
}
-
- # if we made it this far, $id was added to seen list at current
- # level, so remove it to get deep copies
- delete($s->{seen}{$id}) if $id and $s->{deepcopy};
+ if ($id) {
+ # if we made it this far, $id was added to seen list at current
+ # level, so remove it to get deep copies
+ if ($s->{deepcopy}) {
+ delete($s->{seen}{$id});
+ }
+ elsif ($name) {
+ $s->{seen}{$id}[2] = 1;
+ }
+ }
return $out;
}
defined($v) ? (($s->{'bless'} = $v), return $s) : $s->{'bless'};
}
+# used by qquote below
+my %esc = (
+ "\a" => "\\a",
+ "\b" => "\\b",
+ "\t" => "\\t",
+ "\n" => "\\n",
+ "\f" => "\\f",
+ "\r" => "\\r",
+ "\e" => "\\e",
+);
+
# put a string value in double quotes
sub qquote {
local($_) = shift;
- s/([\\\"\@\$\%])/\\$1/g;
- s/\a/\\a/g;
- s/[\b]/\\b/g;
- s/\t/\\t/g;
- s/\n/\\n/g;
- s/\f/\\f/g;
- s/\r/\\r/g;
- s/\e/\\e/g;
-
-# this won't work!
-# s/([^\a\b\t\n\f\r\e\038-\176])/'\\'.sprintf('%03o',ord($1))/eg;
- s/([\000-\006\013\016-\032\034-\037\177\200-\377])/'\\'.sprintf('%03o',ord($1))/eg;
- return "\"$_\"";
+ s/([\\\"\@\$])/\\$1/g;
+ return qq("$_") unless /[^\040-\176]/; # 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;
+ }
+ return qq("$_");
}
1;
=head1 VERSION
-Version 2.09 (9 July 1998)
+Version 2.10 (31 Oct 1998)
=head1 SEE ALSO
projects / p5sagit/p5-mst-13.2.git / blobdiff