From 316ee97c621496b0fe3267f57cce81bee44ca1e6 Mon Sep 17 00:00:00 2001 From: Siep Kroonenberg Date: Thu, 17 Feb 2011 12:20:49 +0000 Subject: Moving old tlperl prior to committing new one git-svn-id: svn://tug.org/texlive/trunk@21422 c570f23f-e606-0410-a88d-b1316a301751 --- Master/tlpkg/tlperl/lib/Scalar/Util.pm | 283 ------------------------------ Master/tlpkg/tlperl/lib/Scalar/Util/PP.pm | 109 ------------ 2 files changed, 392 deletions(-) delete mode 100755 Master/tlpkg/tlperl/lib/Scalar/Util.pm delete mode 100755 Master/tlpkg/tlperl/lib/Scalar/Util/PP.pm (limited to 'Master/tlpkg/tlperl/lib/Scalar') diff --git a/Master/tlpkg/tlperl/lib/Scalar/Util.pm b/Master/tlpkg/tlperl/lib/Scalar/Util.pm deleted file mode 100755 index 24f146f2b3f..00000000000 --- a/Master/tlpkg/tlperl/lib/Scalar/Util.pm +++ /dev/null @@ -1,283 +0,0 @@ -# Scalar::Util.pm -# -# Copyright (c) 1997-2007 Graham Barr . All rights reserved. -# This program is free software; you can redistribute it and/or -# modify it under the same terms as Perl itself. - -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.22"; -$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); -} - -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)$/ } @_ ) { - require Carp; - Carp::croak("Weak references are not implemented in the version of perl"); - } - - if (grep { /^(isvstring)$/ } @_ ) { - require Carp; - Carp::croak("Vstrings are not implemented in the version of perl"); - } - - @_; -} - -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__ - -=head1 NAME - -Scalar::Util - A selection of general-utility scalar subroutines - -=head1 SYNOPSIS - - use Scalar::Util qw(blessed dualvar isweak readonly refaddr reftype tainted - weaken isvstring looks_like_number set_prototype); - # and other useful utils appearing below - -=head1 DESCRIPTION - -C contains a selection of subroutines that people have -expressed would be nice to have in the perl core, but the usage would -not really be high enough to warrant the use of a keyword, and the size -so small such that being individual extensions would be wasteful. - -By default C does not export any subroutines. The -subroutines defined are - -=over 4 - -=item blessed EXPR - -If EXPR evaluates to a blessed reference the name of the package -that it is blessed into is returned. Otherwise C is returned. - - $scalar = "foo"; - $class = blessed $scalar; # undef - - $ref = []; - $class = blessed $ref; # undef - - $obj = bless [], "Foo"; - $class = blessed $obj; # "Foo" - -=item dualvar NUM, STRING - -Returns a scalar that has the value NUM in a numeric context and the -value STRING in a string context. - - $foo = dualvar 10, "Hello"; - $num = $foo + 2; # 12 - $str = $foo . " world"; # Hello world - -=item isvstring EXPR - -If EXPR is a scalar which was coded as a vstring the result is true. - - $vs = v49.46.48; - $fmt = isvstring($vs) ? "%vd" : "%s"; #true - printf($fmt,$vs); - -=item isweak EXPR - -If EXPR is a scalar which is a weak reference the result is true. - - $ref = \$foo; - $weak = isweak($ref); # false - weaken($ref); - $weak = isweak($ref); # true - -B: Copying a weak reference creates a normal, strong, reference. - - $copy = $ref; - $weak = isweak($copy); # false - -=item looks_like_number EXPR - -Returns true if perl thinks EXPR is a number. See -L. - -=item openhandle FH - -Returns FH if FH may be used as a filehandle and is open, or FH is a tied -handle. Otherwise C is returned. - - $fh = openhandle(*STDIN); # \*STDIN - $fh = openhandle(\*STDIN); # \*STDIN - $fh = openhandle(*NOTOPEN); # undef - $fh = openhandle("scalar"); # undef - -=item readonly SCALAR - -Returns true if SCALAR is readonly. - - sub foo { readonly($_[0]) } - - $readonly = foo($bar); # false - $readonly = foo(0); # true - -=item refaddr EXPR - -If EXPR evaluates to a reference the internal memory address of -the referenced value is returned. Otherwise C is returned. - - $addr = refaddr "string"; # undef - $addr = refaddr \$var; # eg 12345678 - $addr = refaddr []; # eg 23456784 - - $obj = bless {}, "Foo"; - $addr = refaddr $obj; # eg 88123488 - -=item reftype EXPR - -If EXPR evaluates to a reference the type of the variable referenced -is returned. Otherwise C is returned. - - $type = reftype "string"; # undef - $type = reftype \$var; # SCALAR - $type = reftype []; # ARRAY - - $obj = bless {}, "Foo"; - $type = reftype $obj; # HASH - -=item set_prototype CODEREF, PROTOTYPE - -Sets the prototype of the given function, or deletes it if PROTOTYPE is -undef. Returns the CODEREF. - - set_prototype \&foo, '$$'; - -=item tainted EXPR - -Return true if the result of EXPR is tainted - - $taint = tainted("constant"); # false - $taint = tainted($ENV{PWD}); # true if running under -T - -=item weaken REF - -REF will be turned into a weak reference. This means that it will not -hold a reference count on the object it references. Also when the reference -count on that object reaches zero, REF will be set to undef. - -This is useful for keeping copies of references , but you don't want to -prevent the object being DESTROY-ed at its usual time. - - { - my $var; - $ref = \$var; - weaken($ref); # Make $ref a weak reference - } - # $ref is now undef - -Note that if you take a copy of a scalar with a weakened reference, -the copy will be a strong reference. - - my $var; - my $foo = \$var; - weaken($foo); # Make $foo a weak reference - my $bar = $foo; # $bar is now a strong reference - -This may be less obvious in other situations, such as C, for instance -when grepping through a list of weakened references to objects that may have -been destroyed already: - - @object = grep { defined } @object; - -This will indeed remove all references to destroyed objects, but the remaining -references to objects will be strong, causing the remaining objects to never -be destroyed because there is now always a strong reference to them in the -@object array. - -=back - -=head1 DIAGNOSTICS - -Module use may give one of the following errors during import. - -=over - -=item Weak references are not implemented in the version of perl - -The version of perl that you are using does not implement weak references, to use -C or C you will need to use a newer release of perl. - -=item Vstrings are not implemented in the version of perl - -The version of perl that you are using does not implement Vstrings, to use -C you will need to use a newer release of perl. - -=item C is only available with the XS version of Scalar::Util - -C contains both perl and C implementations of many of its functions -so that those without access to a C compiler may still use it. However some of the functions -are only available when a C compiler was available to compile the XS version of the extension. - -At present that list is: weaken, isweak, dualvar, isvstring, set_prototype - -=back - -=head1 KNOWN BUGS - -There is a bug in perl5.6.0 with UV's that are >= 1<<31. This will -show up as tests 8 and 9 of dualvar.t failing - -=head1 SEE ALSO - -L - -=head1 COPYRIGHT - -Copyright (c) 1997-2007 Graham Barr . All rights reserved. -This program is free software; you can redistribute it and/or modify it -under the same terms as Perl itself. - -Except weaken and isweak which are - -Copyright (c) 1999 Tuomas J. Lukka . All rights reserved. -This program is free software; you can redistribute it and/or modify it -under the same terms as perl itself. - -=cut diff --git a/Master/tlpkg/tlperl/lib/Scalar/Util/PP.pm b/Master/tlpkg/tlperl/lib/Scalar/Util/PP.pm deleted file mode 100755 index e94fe86f21c..00000000000 --- a/Master/tlpkg/tlperl/lib/Scalar/Util/PP.pm +++ /dev/null @@ -1,109 +0,0 @@ -# Scalar::Util::PP.pm -# -# Copyright (c) 1997-2009 Graham Barr . 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.22"; -$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; - hex($1); -} - -{ - my %tmap = qw( - B::HV HASH - B::AV ARRAY - B::CV CODE - B::IO IO - B::NULL SCALAR - B::NV SCALAR - B::PV SCALAR - B::GV GLOB - B::RV REF - 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; -- cgit v1.2.3