1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
57
58
59
60
61
62
63
64
65
66
67
68
69
70
71
72
73
74
75
76
77
78
79
80
81
82
83
84
85
86
87
88
89
90
91
92
93
94
95
96
97
98
99
100
101
102
103
104
105
106
107
108
109
110
111
112
113
114
115
116
117
118
119
120
121
122
123
124
125
126
127
128
129
130
131
132
133
134
135
136
137
138
139
140
141
142
143
144
145
146
147
148
149
|
#line 1 "inc/Scalar/Util.pm - /System/Library/Perl/5.8.6/darwin-thread-multi-2level/Scalar/Util.pm"
# Scalar::Util.pm
#
# Copyright (c) 1997-2005 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.
package Scalar::Util;
use strict;
use vars qw(@ISA @EXPORT_OK $VERSION);
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.18";
$VERSION = eval $VERSION;
sub export_fail {
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");
}
if (grep { /^(dualvar|set_prototype)$/ } @_ ) {
require Carp;
Carp::croak("$1 is only avaliable with the XS version");
}
@_;
}
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;
}
eval <<'ESQ' unless defined &dualvar;
use vars qw(@EXPORT_FAIL);
push @EXPORT_FAIL, qw(weaken isweak dualvar isvstring set_prototype);
# The code beyond here is only used if the XS is not installed
# Hope nobody defines a sub by this name
sub UNIVERSAL::a_sub_not_likely_to_be_here { ref($_[0]) }
sub blessed ($) {
local($@, $SIG{__DIE__}, $SIG{__WARN__});
length(ref($_[0]))
? eval { $_[0]->a_sub_not_likely_to_be_here }
: undef
}
sub refaddr($) {
my $pkg = ref($_[0]) or return undef;
if (blessed($_[0])) {
bless $_[0], 'Scalar::Util::Fake';
}
else {
$pkg = undef;
}
"$_[0]" =~ /0x(\w+)/;
my $i = do { local $^W; hex $1 };
bless $_[0], $pkg if defined $pkg;
$i;
}
sub reftype ($) {
local($@, $SIG{__DIE__}, $SIG{__WARN__});
my $r = shift;
my $t;
length($t = ref($r)) or return undef;
# This eval will fail if the reference is not blessed
eval { $r->a_sub_not_likely_to_be_here; 1 }
? do {
$t = eval {
# we have a GLOB or an IO. Stringify a GLOB gives it's name
my $q = *$r;
$q =~ /^\*/ ? "GLOB" : "IO";
}
or do {
# OK, if we don't have a GLOB what parts of
# a glob will it populate.
# NOTE: A glob always has a SCALAR
local *glob = $r;
defined *glob{ARRAY} && "ARRAY"
or defined *glob{HASH} && "HASH"
or defined *glob{CODE} && "CODE"
or length(ref(${$r})) ? "REF" : "SCALAR";
}
}
: $t
}
sub tainted {
local($@, $SIG{__DIE__}, $SIG{__WARN__});
local $^W = 0;
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($_) or ref($_);
return 1 if (/^[+-]?\d+$/); # is a +/- integer
return 1 if (/^([+-]?)(?=\d|\.\d)\d*(\.\d*)?([Ee]([+-]?\d+))?$/); # a C float
return 1 if ($] >= 5.008 and /^(Inf(inity)?|NaN)$/i) or ($] >= 5.006001 and /^Inf$/i);
0;
}
ESQ
1;
__END__
#line 338
|
