summaryrefslogtreecommitdiff
path: root/systems/texlive/tlnet/tlpkg/tlperl/lib/Data/Dumper.pm
diff options
context:
space:
mode:
Diffstat (limited to 'systems/texlive/tlnet/tlpkg/tlperl/lib/Data/Dumper.pm')
-rw-r--r--systems/texlive/tlnet/tlpkg/tlperl/lib/Data/Dumper.pm131
1 files changed, 55 insertions, 76 deletions
diff --git a/systems/texlive/tlnet/tlpkg/tlperl/lib/Data/Dumper.pm b/systems/texlive/tlnet/tlpkg/tlperl/lib/Data/Dumper.pm
index 267cb92aae..bb6d3caedb 100644
--- a/systems/texlive/tlnet/tlpkg/tlperl/lib/Data/Dumper.pm
+++ b/systems/texlive/tlnet/tlpkg/tlperl/lib/Data/Dumper.pm
@@ -14,10 +14,11 @@ use warnings;
#$| = 1;
-use 5.006_001;
+use 5.008_001;
require Exporter;
use constant IS_PRE_516_PERL => $] < 5.016;
+use constant SUPPORTS_CORE_BOOLS => defined &builtin::is_bool;
use Carp ();
@@ -29,7 +30,7 @@ our ( $Indent, $Trailingcomma, $Purity, $Pad, $Varname, $Useqq, $Terse, $Freezer
our ( @ISA, @EXPORT, @EXPORT_OK, $VERSION );
BEGIN {
- $VERSION = '2.179'; # Don't forget to set version and release
+ $VERSION = '2.188'; # Don't forget to set version and release
# date in POD below!
@ISA = qw(Exporter);
@@ -123,46 +124,17 @@ sub new {
# 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.
-
-sub init_refaddr_format {
-}
-
sub format_refaddr {
require Scalar::Util;
pack "J", 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
-}
-
#
# add-to or query the table of already seen references
#
sub Seen {
my($s, $g) = @_;
if (defined($g) && (ref($g) eq 'HASH')) {
- init_refaddr_format();
my($k, $v, $id);
while (($k, $v) = each %$g) {
if (defined $v) {
@@ -252,7 +224,6 @@ sub Dumpperl {
my(@out, $val, $name);
my($i) = 0;
local(@post);
- init_refaddr_format();
$s = $s->new(@_) unless ref $s;
@@ -394,7 +365,16 @@ sub _dump {
else {
$pat = "$val";
}
- $pat =~ s <(\\.)|/> { $1 || '\\/' }ge;
+ $pat =~ s <
+ (\\.) # anything backslash escaped
+ | (\$)(?![)|]|\z) # any unescaped $, except $| $) and end
+ | / # any unescaped /
+ >
+ {
+ $1 ? $1
+ : $2 ? '${\q($)}'
+ : '\\/'
+ }gex;
$out .= "qr/$pat/$flags";
}
elsif ($realtype eq 'SCALAR' || $realtype eq 'REF'
@@ -545,7 +525,7 @@ sub _dump {
else {
local $s->{useqq} = IS_PRE_516_PERL && ($s->{useqq} || $name =~ /[^\x00-\x7f]/) ? 1 : $s->{useqq};
$sname = $s->_dump(
- $name eq 'main::' || $] < 5.007 && $name eq "main::\0"
+ $name eq 'main::'
? ''
: $name,
"",
@@ -572,13 +552,32 @@ sub _dump {
elsif (!defined($val)) {
$out .= "undef";
}
+ elsif (SUPPORTS_CORE_BOOLS && do {
+ BEGIN { SUPPORTS_CORE_BOOLS and warnings->unimport("experimental::builtin") }
+ builtin::is_bool($val)
+ }) {
+ $out .= $val ? '!!1' : '!!0';
+ }
+ # This calls the XSUB _vstring (if the XS code is loaded). I'm not *sure* if
+ # if belongs in the "Pure Perl" implementation. It sort of depends on what
+ # was meant by "Pure Perl", as this subroutine already relies Scalar::Util
+ # loading, which means that it has an XS dependency. De facto, it's the
+ # "Pure Perl" implementation of dumping (which uses XS helper code), as
+ # opposed to the C implementation (which calls out to Perl helper code).
+ # So in that sense this is fine - it just happens to be a local XS helper.
elsif (defined &_vstring and $v = _vstring($val)
and !_bad_vsmg || eval $v eq $val) {
$out .= $v;
}
+ # However the confusion comes here - if we *can't* find our XS helper, we
+ # fall back to this code, which generates different (worse) results. That's
+ # better than nothing, *but* it means that if you run the regression tests
+ # with Dumper.so missing, the test for "vstrings" fails, because this code
+ # here generates a different result. So there are actually "three" different
+ # implementations of Data::Dumper (kind of sort of) but we only test two.
elsif (!defined &_vstring
and ref $ref eq 'VSTRING' || eval{Scalar::Util::isvstring($val)}) {
- $out .= sprintf "%vd", $val;
+ $out .= sprintf "v%vd", $val;
}
# \d here would treat "1\x{660}" as a safe decimal number
elsif ($val =~ /^(?:0|-?[1-9][0-9]{0,8})\z/) { # safe decimal number
@@ -748,15 +747,15 @@ my %esc = (
"\e" => "\\e",
);
-my $low_controls = ($IS_ASCII)
-
- # This includes \177, because traditionally it has been
- # output as octal, even though it isn't really a "low"
- # control
- ? qr/[\0-\x1f\177]/
-
- # EBCDIC low controls.
- : qr/[\0-\x3f]/;
+# The low controls are considered to be everything below SPACE, plus the
+# outlier \c? control (but that wasn't properly in existence in early perls,
+# so reconstruct its value here. This abandons EBCDIC support for this
+# character for perls below 5.8)
+my $low_controls = join "", map { quotemeta chr $_ } 0.. (ord(" ") - 1);
+$low_controls .= ($] < 5.008 || $IS_ASCII)
+ ? "\x7f"
+ : chr utf8::unicode_to_native(0x9F);
+my $low_controls_re = qr/[$low_controls]/;
# put a string value in double quotes
sub qquote {
@@ -766,19 +765,10 @@ sub qquote {
# This efficiently changes the high ordinal characters to \x{} if the utf8
# flag is on. On ASCII platforms, the high ordinals are all the
# non-ASCII's. On EBCDIC platforms, we don't include in these the non-ASCII
- # controls whose ordinals are less than SPACE, excluded below by the range
- # \0-\x3f. On ASCII platforms this range just compiles as part of :ascii:.
- # On EBCDIC platforms, there is just one outlier high ordinal control, and
- # it gets output as \x{}.
+ # controls.
my $bytes; { use bytes; $bytes = length }
- s/([^[:ascii:]\0-\x3f])/sprintf("\\x{%x}",ord($1))/ge
- if $bytes > length
-
- # The above doesn't get the EBCDIC outlier high ordinal control when
- # the string is UTF-8 but there are no UTF-8 variant characters in it.
- # We want that to come out as \x{} anyway. We need is_utf8() to do
- # this.
- || (! $IS_ASCII && $] ge 5.008_001 && utf8::is_utf8($_));
+ s/([^[:ascii:]$low_controls])/sprintf("\\x{%x}",ord($1))/ge
+ if $bytes > length;
return qq("$_") unless /[[:^print:]]/; # fast exit if only printables
@@ -787,21 +777,17 @@ sub qquote {
s/([\a\b\t\n\f\r\e])/$esc{$1}/g;
# no need for 3 digits in escape for octals not followed by a digit.
- s/($low_controls)(?!\d)/'\\'.sprintf('%o',ord($1))/eg;
+ s/($low_controls_re)(?!\d)/'\\'.sprintf('%o',ord($1))/eg;
# But otherwise use 3 digits
- s/($low_controls)/'\\'.sprintf('%03o',ord($1))/eg;
+ s/($low_controls_re)/'\\'.sprintf('%03o',ord($1))/eg;
# all but last branch below not supported --BEHAVIOR SUBJECT TO CHANGE--
my $high = shift || "";
if ($high eq "iso8859") { # Doesn't escape the Latin1 printables
- if ($IS_ASCII) {
- s/([\200-\240])/'\\'.sprintf('%o',ord($1))/eg;
- }
- elsif ($] ge 5.007_003) {
- my $high_control = utf8::unicode_to_native(0x9F);
- s/$high_control/sprintf('\\%o',ord($1))/eg;
- }
+ # Could use /u and [:cntrl:] etc, if khw were confident it worked in
+ # early early perls
+ s/([\200-\240])/'\\'.sprintf('%o',ord($1))/eg if $IS_ASCII;
} elsif ($high eq "utf8") {
# Some discussion of what to do here is in
# https://rt.perl.org/Ticket/Display.html?id=113088
@@ -817,10 +803,6 @@ sub qquote {
return qq("$_");
}
-# helper sub to sort hash keys in Perl < 5.8.0 where we don't have
-# access to sortsv() from XS
-sub _sortkeys { [ sort keys %{$_[0]} ] }
-
sub _refine_name {
my $s = shift;
my ($name, $val, $i) = @_;
@@ -884,7 +866,7 @@ Data::Dumper - stringified perl data structures, suitable for both printing and
}
# OO usage
- $d = Data::Dumper->new([$foo, $bar], [qw(foo *ary)]);
+ my $d = Data::Dumper->new([$foo, $bar], [qw(foo *ary)]);
...
print $d->Dump;
...
@@ -909,7 +891,7 @@ to substructures within C<$VAR>I<n> will be appropriately labeled using arrow
notation. You can specify names for individual values to be dumped if you
use the C<Dump()> method, or you can change the default C<$VAR> prefix to
something else. See C<$Data::Dumper::Varname> and C<$Data::Dumper::Terse>
-below.
+in L</Configuration Variables or Methods> below.
The default output of self-referential structures can be C<eval>ed, but the
nested references to C<$VAR>I<n> will be undefined, since a recursive
@@ -1451,12 +1433,9 @@ for L<B::Deparse>.
SCALAR objects have the weirdest looking C<bless> workaround.
-Pure Perl version of C<Data::Dumper> escapes UTF-8 strings correctly
-only in Perl 5.8.0 and later.
-
=head2 NOTE
-Starting from Perl 5.8.1 different runs of Perl will have different
+Different runs of Perl will have different
ordering of hash keys. The change was done for greater security,
see L<perlsec/"Algorithmic Complexity Attacks">. This means that
different runs of Perl will have different Data::Dumper outputs if
@@ -1476,7 +1455,7 @@ modify it under the same terms as Perl itself.
=head1 VERSION
-Version 2.179
+Version 2.188
=head1 SEE ALSO