summaryrefslogtreecommitdiff
path: root/Master/tlpkg/tlperl/lib/Scalar
diff options
context:
space:
mode:
authorKarl Berry <karl@freefriends.org>2012-11-20 18:08:54 +0000
committerKarl Berry <karl@freefriends.org>2012-11-20 18:08:54 +0000
commitc5add2ea5067382269ae6f19e345fda0b9a7bd21 (patch)
tree02f512fda46d93079c9dc59c0d76f0e398150f83 /Master/tlpkg/tlperl/lib/Scalar
parent6c35e87bdc5a3f64833dbbc42e7d42e683db9d5b (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.pm52
-rw-r--r--Master/tlpkg/tlperl/lib/Scalar/Util/PP.pm108
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;