diff options
Diffstat (limited to 'Master/tlpkg/tlperl/lib/Scalar/Util.pm')
-rw-r--r-- | Master/tlpkg/tlperl/lib/Scalar/Util.pm | 52 |
1 files changed, 15 insertions, 37 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__ |