diff options
author | Karl Berry <karl@freefriends.org> | 2012-11-20 18:08:54 +0000 |
---|---|---|
committer | Karl Berry <karl@freefriends.org> | 2012-11-20 18:08:54 +0000 |
commit | c5add2ea5067382269ae6f19e345fda0b9a7bd21 (patch) | |
tree | 02f512fda46d93079c9dc59c0d76f0e398150f83 /Master/tlpkg/tlperl/lib/Scalar | |
parent | 6c35e87bdc5a3f64833dbbc42e7d42e683db9d5b (diff) |
perl 5.16.2, compiled without optimization for Windows (from siep)
git-svn-id: svn://tug.org/texlive/trunk@28315 c570f23f-e606-0410-a88d-b1316a301751
Diffstat (limited to 'Master/tlpkg/tlperl/lib/Scalar')
-rw-r--r-- | Master/tlpkg/tlperl/lib/Scalar/Util.pm | 52 | ||||
-rw-r--r-- | Master/tlpkg/tlperl/lib/Scalar/Util/PP.pm | 108 |
2 files changed, 15 insertions, 145 deletions
diff --git a/Master/tlpkg/tlperl/lib/Scalar/Util.pm b/Master/tlpkg/tlperl/lib/Scalar/Util.pm index 24138ca4d85..ab97fe5446b 100644 --- a/Master/tlpkg/tlperl/lib/Scalar/Util.pm +++ b/Master/tlpkg/tlperl/lib/Scalar/Util.pm @@ -7,37 +7,33 @@ package Scalar::Util; use strict; -use vars qw(@ISA @EXPORT_OK $VERSION @EXPORT_FAIL); require Exporter; require List::Util; # List::Util loads the XS -@ISA = qw(Exporter); -@EXPORT_OK = qw(blessed dualvar reftype weaken isweak tainted readonly openhandle refaddr isvstring looks_like_number set_prototype); -$VERSION = "1.23"; +our @ISA = qw(Exporter); +our @EXPORT_OK = qw(blessed dualvar reftype weaken isweak tainted readonly openhandle refaddr isvstring looks_like_number set_prototype); +our $VERSION = "1.25"; $VERSION = eval $VERSION; -unless (defined &dualvar) { - # Load Pure Perl version if XS not loaded - require Scalar::Util::PP; - Scalar::Util::PP->import; - push @EXPORT_FAIL, qw(weaken isweak dualvar isvstring set_prototype); +our @EXPORT_FAIL; + +unless (defined &weaken) { + push @EXPORT_FAIL, qw(weaken); +} +unless (defined &isweak) { + push @EXPORT_FAIL, qw(isweak isvstring); +} +unless (defined &isvstring) { + push @EXPORT_FAIL, qw(isvstring); } sub export_fail { - if (grep { /dualvar/ } @EXPORT_FAIL) { # no XS loaded - my $pat = join("|", @EXPORT_FAIL); - if (my ($err) = grep { /^($pat)$/ } @_ ) { - require Carp; - Carp::croak("$err is only available with the XS version of Scalar::Util"); - } - } - - if (grep { /^(weaken|isweak)$/ } @_ ) { + if (grep { /^(?:weaken|isweak)$/ } @_ ) { require Carp; Carp::croak("Weak references are not implemented in the version of perl"); } - if (grep { /^(isvstring)$/ } @_ ) { + if (grep { /^isvstring$/ } @_ ) { require Carp; Carp::croak("Vstrings are not implemented in the version of perl"); } @@ -45,24 +41,6 @@ sub export_fail { @_; } -sub openhandle ($) { - my $fh = shift; - my $rt = reftype($fh) || ''; - - return defined(fileno($fh)) ? $fh : undef - if $rt eq 'IO'; - - if (reftype(\$fh) eq 'GLOB') { # handle openhandle(*DATA) - $fh = \(my $tmp=$fh); - } - elsif ($rt ne 'GLOB') { - return undef; - } - - (tied(*$fh) or defined(fileno($fh))) - ? $fh : undef; -} - 1; __END__ diff --git a/Master/tlpkg/tlperl/lib/Scalar/Util/PP.pm b/Master/tlpkg/tlperl/lib/Scalar/Util/PP.pm deleted file mode 100644 index 7850e1b812d..00000000000 --- a/Master/tlpkg/tlperl/lib/Scalar/Util/PP.pm +++ /dev/null @@ -1,108 +0,0 @@ -# Scalar::Util::PP.pm -# -# Copyright (c) 1997-2009 Graham Barr <gbarr@pobox.com>. All rights reserved. -# This program is free software; you can redistribute it and/or -# modify it under the same terms as Perl itself. -# -# This module is normally only loaded if the XS module is not available - -package Scalar::Util::PP; - -use strict; -use warnings; -use vars qw(@ISA @EXPORT $VERSION $recurse); -require Exporter; -use B qw(svref_2object); - -@ISA = qw(Exporter); -@EXPORT = qw(blessed reftype tainted readonly refaddr looks_like_number); -$VERSION = "1.23"; -$VERSION = eval $VERSION; - -sub blessed ($) { - return undef unless length(ref($_[0])); - my $b = svref_2object($_[0]); - return undef unless $b->isa('B::PVMG'); - my $s = $b->SvSTASH; - return $s->isa('B::HV') ? $s->NAME : undef; -} - -sub refaddr($) { - return undef unless length(ref($_[0])); - - my $addr; - if(defined(my $pkg = blessed($_[0]))) { - $addr .= bless $_[0], 'Scalar::Util::Fake'; - bless $_[0], $pkg; - } - else { - $addr .= $_[0] - } - - $addr =~ /0x(\w+)/; - local $^W; - no warnings 'portable'; - hex($1); -} - -{ - my %tmap = qw( - B::NULL SCALAR - - B::HV HASH - B::AV ARRAY - B::CV CODE - B::IO IO - B::GV GLOB - B::REGEXP REGEXP - ); - - sub reftype ($) { - my $r = shift; - - return undef unless length(ref($r)); - - my $t = ref(svref_2object($r)); - - return - exists $tmap{$t} ? $tmap{$t} - : length(ref($$r)) ? 'REF' - : 'SCALAR'; - } -} - -sub tainted { - local($@, $SIG{__DIE__}, $SIG{__WARN__}); - local $^W = 0; - no warnings; - eval { kill 0 * $_[0] }; - $@ =~ /^Insecure/; -} - -sub readonly { - return 0 if tied($_[0]) || (ref(\($_[0])) ne "SCALAR"); - - local($@, $SIG{__DIE__}, $SIG{__WARN__}); - my $tmp = $_[0]; - - !eval { $_[0] = $tmp; 1 }; -} - -sub looks_like_number { - local $_ = shift; - - # checks from perlfaq4 - return 0 if !defined($_); - if (ref($_)) { - require overload; - return overload::Overloaded($_) ? defined(0 + $_) : 0; - } - return 1 if (/^[+-]?[0-9]+$/); # is a +/- integer - return 1 if (/^([+-]?)(?=[0-9]|\.[0-9])[0-9]*(\.[0-9]*)?([Ee]([+-]?[0-9]+))?$/); # a C float - return 1 if ($] >= 5.008 and /^(Inf(inity)?|NaN)$/i) or ($] >= 5.006001 and /^Inf$/i); - - 0; -} - - -1; |