Commit | Line | Data |
3fea05b9 |
1 | # Scalar::Util.pm |
2 | # |
3 | # Copyright (c) 1997-2007 Graham Barr <gbarr@pobox.com>. All rights reserved. |
4 | # This program is free software; you can redistribute it and/or |
5 | # modify it under the same terms as Perl itself. |
6 | |
7 | package Scalar::Util; |
8 | |
9 | use strict; |
10 | use vars qw(@ISA @EXPORT_OK $VERSION @EXPORT_FAIL); |
11 | require Exporter; |
12 | require List::Util; # List::Util loads the XS |
13 | |
14 | @ISA = qw(Exporter); |
15 | @EXPORT_OK = qw(blessed dualvar reftype weaken isweak tainted readonly openhandle refaddr isvstring looks_like_number set_prototype); |
16 | $VERSION = "1.22"; |
17 | $VERSION = eval $VERSION; |
18 | |
19 | unless (defined &dualvar) { |
20 | # Load Pure Perl version if XS not loaded |
21 | require Scalar::Util::PP; |
22 | Scalar::Util::PP->import; |
23 | push @EXPORT_FAIL, qw(weaken isweak dualvar isvstring set_prototype); |
24 | } |
25 | |
26 | sub export_fail { |
27 | if (grep { /dualvar/ } @EXPORT_FAIL) { # no XS loaded |
28 | my $pat = join("|", @EXPORT_FAIL); |
29 | if (my ($err) = grep { /^($pat)$/ } @_ ) { |
30 | require Carp; |
31 | Carp::croak("$err is only available with the XS version of Scalar::Util"); |
32 | } |
33 | } |
34 | |
35 | if (grep { /^(weaken|isweak)$/ } @_ ) { |
36 | require Carp; |
37 | Carp::croak("Weak references are not implemented in the version of perl"); |
38 | } |
39 | |
40 | if (grep { /^(isvstring)$/ } @_ ) { |
41 | require Carp; |
42 | Carp::croak("Vstrings are not implemented in the version of perl"); |
43 | } |
44 | |
45 | @_; |
46 | } |
47 | |
48 | sub openhandle ($) { |
49 | my $fh = shift; |
50 | my $rt = reftype($fh) || ''; |
51 | |
52 | return defined(fileno($fh)) ? $fh : undef |
53 | if $rt eq 'IO'; |
54 | |
55 | if (reftype(\$fh) eq 'GLOB') { # handle openhandle(*DATA) |
56 | $fh = \(my $tmp=$fh); |
57 | } |
58 | elsif ($rt ne 'GLOB') { |
59 | return undef; |
60 | } |
61 | |
62 | (tied(*$fh) or defined(fileno($fh))) |
63 | ? $fh : undef; |
64 | } |
65 | |
66 | 1; |
67 | |
68 | __END__ |
69 | |
70 | =head1 NAME |
71 | |
72 | Scalar::Util - A selection of general-utility scalar subroutines |
73 | |
74 | =head1 SYNOPSIS |
75 | |
76 | use Scalar::Util qw(blessed dualvar isweak readonly refaddr reftype tainted |
77 | weaken isvstring looks_like_number set_prototype); |
78 | # and other useful utils appearing below |
79 | |
80 | =head1 DESCRIPTION |
81 | |
82 | C<Scalar::Util> contains a selection of subroutines that people have |
83 | expressed would be nice to have in the perl core, but the usage would |
84 | not really be high enough to warrant the use of a keyword, and the size |
85 | so small such that being individual extensions would be wasteful. |
86 | |
87 | By default C<Scalar::Util> does not export any subroutines. The |
88 | subroutines defined are |
89 | |
90 | =over 4 |
91 | |
92 | =item blessed EXPR |
93 | |
94 | If EXPR evaluates to a blessed reference the name of the package |
95 | that it is blessed into is returned. Otherwise C<undef> is returned. |
96 | |
97 | $scalar = "foo"; |
98 | $class = blessed $scalar; # undef |
99 | |
100 | $ref = []; |
101 | $class = blessed $ref; # undef |
102 | |
103 | $obj = bless [], "Foo"; |
104 | $class = blessed $obj; # "Foo" |
105 | |
106 | =item dualvar NUM, STRING |
107 | |
108 | Returns a scalar that has the value NUM in a numeric context and the |
109 | value STRING in a string context. |
110 | |
111 | $foo = dualvar 10, "Hello"; |
112 | $num = $foo + 2; # 12 |
113 | $str = $foo . " world"; # Hello world |
114 | |
115 | =item isvstring EXPR |
116 | |
117 | If EXPR is a scalar which was coded as a vstring the result is true. |
118 | |
119 | $vs = v49.46.48; |
120 | $fmt = isvstring($vs) ? "%vd" : "%s"; #true |
121 | printf($fmt,$vs); |
122 | |
123 | =item isweak EXPR |
124 | |
125 | If EXPR is a scalar which is a weak reference the result is true. |
126 | |
127 | $ref = \$foo; |
128 | $weak = isweak($ref); # false |
129 | weaken($ref); |
130 | $weak = isweak($ref); # true |
131 | |
132 | B<NOTE>: Copying a weak reference creates a normal, strong, reference. |
133 | |
134 | $copy = $ref; |
135 | $weak = isweak($copy); # false |
136 | |
137 | =item looks_like_number EXPR |
138 | |
139 | Returns true if perl thinks EXPR is a number. See |
140 | L<perlapi/looks_like_number>. |
141 | |
142 | =item openhandle FH |
143 | |
144 | Returns FH if FH may be used as a filehandle and is open, or FH is a tied |
145 | handle. Otherwise C<undef> is returned. |
146 | |
147 | $fh = openhandle(*STDIN); # \*STDIN |
148 | $fh = openhandle(\*STDIN); # \*STDIN |
149 | $fh = openhandle(*NOTOPEN); # undef |
150 | $fh = openhandle("scalar"); # undef |
151 | |
152 | =item readonly SCALAR |
153 | |
154 | Returns true if SCALAR is readonly. |
155 | |
156 | sub foo { readonly($_[0]) } |
157 | |
158 | $readonly = foo($bar); # false |
159 | $readonly = foo(0); # true |
160 | |
161 | =item refaddr EXPR |
162 | |
163 | If EXPR evaluates to a reference the internal memory address of |
164 | the referenced value is returned. Otherwise C<undef> is returned. |
165 | |
166 | $addr = refaddr "string"; # undef |
167 | $addr = refaddr \$var; # eg 12345678 |
168 | $addr = refaddr []; # eg 23456784 |
169 | |
170 | $obj = bless {}, "Foo"; |
171 | $addr = refaddr $obj; # eg 88123488 |
172 | |
173 | =item reftype EXPR |
174 | |
175 | If EXPR evaluates to a reference the type of the variable referenced |
176 | is returned. Otherwise C<undef> is returned. |
177 | |
178 | $type = reftype "string"; # undef |
179 | $type = reftype \$var; # SCALAR |
180 | $type = reftype []; # ARRAY |
181 | |
182 | $obj = bless {}, "Foo"; |
183 | $type = reftype $obj; # HASH |
184 | |
185 | =item set_prototype CODEREF, PROTOTYPE |
186 | |
187 | Sets the prototype of the given function, or deletes it if PROTOTYPE is |
188 | undef. Returns the CODEREF. |
189 | |
190 | set_prototype \&foo, '$$'; |
191 | |
192 | =item tainted EXPR |
193 | |
194 | Return true if the result of EXPR is tainted |
195 | |
196 | $taint = tainted("constant"); # false |
197 | $taint = tainted($ENV{PWD}); # true if running under -T |
198 | |
199 | =item weaken REF |
200 | |
201 | REF will be turned into a weak reference. This means that it will not |
202 | hold a reference count on the object it references. Also when the reference |
203 | count on that object reaches zero, REF will be set to undef. |
204 | |
205 | This is useful for keeping copies of references , but you don't want to |
206 | prevent the object being DESTROY-ed at its usual time. |
207 | |
208 | { |
209 | my $var; |
210 | $ref = \$var; |
211 | weaken($ref); # Make $ref a weak reference |
212 | } |
213 | # $ref is now undef |
214 | |
215 | Note that if you take a copy of a scalar with a weakened reference, |
216 | the copy will be a strong reference. |
217 | |
218 | my $var; |
219 | my $foo = \$var; |
220 | weaken($foo); # Make $foo a weak reference |
221 | my $bar = $foo; # $bar is now a strong reference |
222 | |
223 | This may be less obvious in other situations, such as C<grep()>, for instance |
224 | when grepping through a list of weakened references to objects that may have |
225 | been destroyed already: |
226 | |
227 | @object = grep { defined } @object; |
228 | |
229 | This will indeed remove all references to destroyed objects, but the remaining |
230 | references to objects will be strong, causing the remaining objects to never |
231 | be destroyed because there is now always a strong reference to them in the |
232 | @object array. |
233 | |
234 | =back |
235 | |
236 | =head1 DIAGNOSTICS |
237 | |
238 | Module use may give one of the following errors during import. |
239 | |
240 | =over |
241 | |
242 | =item Weak references are not implemented in the version of perl |
243 | |
244 | The version of perl that you are using does not implement weak references, to use |
245 | C<isweak> or C<weaken> you will need to use a newer release of perl. |
246 | |
247 | =item Vstrings are not implemented in the version of perl |
248 | |
249 | The version of perl that you are using does not implement Vstrings, to use |
250 | C<isvstring> you will need to use a newer release of perl. |
251 | |
252 | =item C<NAME> is only available with the XS version of Scalar::Util |
253 | |
254 | C<Scalar::Util> contains both perl and C implementations of many of its functions |
255 | so that those without access to a C compiler may still use it. However some of the functions |
256 | are only available when a C compiler was available to compile the XS version of the extension. |
257 | |
258 | At present that list is: weaken, isweak, dualvar, isvstring, set_prototype |
259 | |
260 | =back |
261 | |
262 | =head1 KNOWN BUGS |
263 | |
264 | There is a bug in perl5.6.0 with UV's that are >= 1<<31. This will |
265 | show up as tests 8 and 9 of dualvar.t failing |
266 | |
267 | =head1 SEE ALSO |
268 | |
269 | L<List::Util> |
270 | |
271 | =head1 COPYRIGHT |
272 | |
273 | Copyright (c) 1997-2007 Graham Barr <gbarr@pobox.com>. All rights reserved. |
274 | This program is free software; you can redistribute it and/or modify it |
275 | under the same terms as Perl itself. |
276 | |
277 | Except weaken and isweak which are |
278 | |
279 | Copyright (c) 1999 Tuomas J. Lukka <lukka@iki.fi>. All rights reserved. |
280 | This program is free software; you can redistribute it and/or modify it |
281 | under the same terms as perl itself. |
282 | |
283 | =cut |