diff options
Diffstat (limited to 'Master/tlpkg/tlperl/lib/Data/Dumper.pm')
-rw-r--r-- | Master/tlpkg/tlperl/lib/Data/Dumper.pm | 103 |
1 files changed, 69 insertions, 34 deletions
diff --git a/Master/tlpkg/tlperl/lib/Data/Dumper.pm b/Master/tlpkg/tlperl/lib/Data/Dumper.pm index 1c68c987563..a0992776137 100644 --- a/Master/tlpkg/tlperl/lib/Data/Dumper.pm +++ b/Master/tlpkg/tlperl/lib/Data/Dumper.pm @@ -9,7 +9,9 @@ package Data::Dumper; -$VERSION = '2.130_02'; # Don't forget to set version and release date in POD! +BEGIN { + $VERSION = '2.135_06'; # Don't forget to set version and release +} # date in POD! #$| = 1; @@ -29,12 +31,12 @@ BEGIN { # toggled on load failure. eval { require XSLoader; - }; - $Useperl = 1 if $@; + XSLoader::load( 'Data::Dumper' ); + 1 + } + or $Useperl = 1; } -XSLoader::load( 'Data::Dumper' ) unless $Useperl; - # module vars and their defaults $Indent = 2 unless defined $Indent; $Purity = 0 unless defined $Purity; @@ -101,26 +103,39 @@ sub new { return bless($s, $c); } -if ($] >= 5.008) { - # Packed numeric addresses take less memory. Plus pack is faster than sprintf - *init_refaddr_format = sub {}; +# Packed numeric addresses take less memory. Plus pack is faster than sprintf + +# Most users of current versions of Data::Dumper will be 5.008 or later. +# Anyone on 5.6.1 and 5.6.2 upgrading will be rare (particularly judging by +# the bug reports from users on those platforms), so for the common case avoid +# complexity, and avoid even compiling the unneeded code. - *format_refaddr = sub { +sub init_refaddr_format { +} + +sub format_refaddr { require Scalar::Util; pack "J", Scalar::Util::refaddr(shift); - }; -} else { - *init_refaddr_format = sub { - require Config; - my $f = $Config::Config{uvxformat}; - $f =~ tr/"//d; - our $refaddr_format = "0x%" . $f; - }; - - *format_refaddr = sub { - require Scalar::Util; - sprintf our $refaddr_format, Scalar::Util::refaddr(shift); - } +}; + +if ($] < 5.008) { + eval <<'EOC' or die; + no warnings 'redefine'; + my $refaddr_format; + sub init_refaddr_format { + require Config; + my $f = $Config::Config{uvxformat}; + $f =~ tr/"//d; + $refaddr_format = "0x%" . $f; + } + + sub format_refaddr { + require Scalar::Util; + sprintf $refaddr_format, Scalar::Util::refaddr(shift); + } + + 1 +EOC } # @@ -255,6 +270,10 @@ sub _quote { return "'" . $val . "'"; } +# Old Perls (5.14-) have trouble resetting vstring magic when it is no +# longer valid. +use constant _bad_vsmg => defined &_vstring && (_vstring(~v0)||'') eq "v0"; + # # twist, toil and turn; # and recurse, of course. @@ -367,10 +386,11 @@ sub _dump { } else { $pat = "$val"; } - $pat =~ s,/,\\/,g; + $pat =~ s <(\\.)|/> { $1 || '\\/' }ge; $out .= "qr/$pat/"; } - elsif ($realtype eq 'SCALAR' || $realtype eq 'REF') { + elsif ($realtype eq 'SCALAR' || $realtype eq 'REF' + || $realtype eq 'VSTRING') { if ($realpack) { $out .= 'do{\\(my $o = ' . $s->_dump($$val, "\${$name}") . ')}'; } @@ -475,6 +495,7 @@ sub _dump { else { # simple scalar my $ref = \$_[1]; + my $v; # first, catalog the scalar if ($name ne '') { $id = format_refaddr($ref); @@ -490,14 +511,20 @@ sub _dump { $s->{seen}{$id} = ["\\$name", $ref]; } } - if (ref($ref) eq 'GLOB' or "$ref" =~ /=GLOB\([^()]+\)$/) { # glob + $ref = \$val; + if (ref($ref) eq 'GLOB') { # glob my $name = substr($val, 1); - if ($name =~ /^[A-Za-z_][\w:]*$/) { + if ($name =~ /^[A-Za-z_][\w:]*$/ && $name ne 'main::') { $name =~ s/^main::/::/; $sname = $name; } else { - $sname = $s->_dump($name, ""); + $sname = $s->_dump( + $name eq 'main::' || $] < 5.007 && $name eq "main::\0" + ? '' + : $name, + "", + ); $sname = '{' . $sname . '}'; } if ($s->{purity}) { @@ -520,6 +547,14 @@ sub _dump { elsif (!defined($val)) { $out .= "undef"; } + elsif (defined &_vstring and $v = _vstring($val) + and !_bad_vsmg || eval $v eq $val) { + $out .= $v; + } + elsif (!defined &_vstring + and ref $ref eq 'VSTRING' || eval{Scalar::Util::isvstring($val)}) { + $out .= sprintf "%vd", $val; + } elsif ($val =~ /^(?:0|-?[1-9]\d{0,8})\z/) { # safe decimal number $out .= $val; } @@ -1106,20 +1141,20 @@ distribution for more examples.) print($@) if $@; print Dumper($boo), Dumper($bar); # pretty print (no array indices) - $Data::Dumper::Terse = 1; # don't output names where feasible - $Data::Dumper::Indent = 0; # turn off all pretty print + $Data::Dumper::Terse = 1; # don't output names where feasible + $Data::Dumper::Indent = 0; # turn off all pretty print print Dumper($boo), "\n"; - $Data::Dumper::Indent = 1; # mild pretty print + $Data::Dumper::Indent = 1; # mild pretty print print Dumper($boo); - $Data::Dumper::Indent = 3; # pretty print with array indices + $Data::Dumper::Indent = 3; # pretty print with array indices print Dumper($boo); - $Data::Dumper::Useqq = 1; # print strings in double quotes + $Data::Dumper::Useqq = 1; # print strings in double quotes print Dumper($boo); - $Data::Dumper::Pair = " : "; # specify hash key/value separator + $Data::Dumper::Pair = " : "; # specify hash key/value separator print Dumper($boo); @@ -1297,7 +1332,7 @@ modify it under the same terms as Perl itself. =head1 VERSION -Version 2.130_02 (Dec 20 2010) +Version 2.135_06 (March 20 2012) =head1 SEE ALSO |