Commit | Line | Data |
---|---|---|
2ff28616 | 1 | # Copyright (c) 1997-2007 Graham Barr <gbarr@pobox.com>. All rights reserved. |
f4a2945e JH |
2 | # This program is free software; you can redistribute it and/or |
3 | # modify it under the same terms as Perl itself. | |
e99e4210 SH |
4 | # |
5 | # Maintained since 2013 by Paul Evans <leonerd@leonerd.org.uk> | |
f4a2945e JH |
6 | |
7 | package Scalar::Util; | |
8 | ||
4984adac | 9 | use strict; |
e8164ee7 | 10 | use warnings; |
f4a2945e | 11 | require Exporter; |
f4a2945e | 12 | |
3630f57e | 13 | our @ISA = qw(Exporter); |
8b198969 | 14 | our @EXPORT_OK = qw( |
8c167fd9 CBW |
15 | blessed refaddr reftype weaken unweaken isweak |
16 | ||
d81c2d6a CBW |
17 | dualvar isdual isvstring looks_like_number openhandle readonly set_prototype |
18 | tainted | |
8b198969 | 19 | ); |
e8164ee7 | 20 | our $VERSION = "1.45"; |
09c2a9b8 GB |
21 | $VERSION = eval $VERSION; |
22 | ||
3d58dd24 SH |
23 | require List::Util; # List::Util loads the XS |
24 | List::Util->VERSION( $VERSION ); # Ensure we got the right XS version (RT#100863) | |
25 | ||
3630f57e CBW |
26 | our @EXPORT_FAIL; |
27 | ||
28 | unless (defined &weaken) { | |
29 | push @EXPORT_FAIL, qw(weaken); | |
30 | } | |
31 | unless (defined &isweak) { | |
32 | push @EXPORT_FAIL, qw(isweak isvstring); | |
33 | } | |
34 | unless (defined &isvstring) { | |
35 | push @EXPORT_FAIL, qw(isvstring); | |
2ff28616 GB |
36 | } |
37 | ||
09c2a9b8 | 38 | sub export_fail { |
3630f57e | 39 | if (grep { /^(?:weaken|isweak)$/ } @_ ) { |
09c2a9b8 GB |
40 | require Carp; |
41 | Carp::croak("Weak references are not implemented in the version of perl"); | |
42 | } | |
2ff28616 | 43 | |
3630f57e | 44 | if (grep { /^isvstring$/ } @_ ) { |
09c2a9b8 GB |
45 | require Carp; |
46 | Carp::croak("Vstrings are not implemented in the version of perl"); | |
47 | } | |
09c2a9b8 GB |
48 | |
49 | @_; | |
50 | } | |
f4a2945e | 51 | |
d81c2d6a CBW |
52 | # set_prototype has been moved to Sub::Util with a different interface |
53 | sub set_prototype(&$) | |
54 | { | |
55 | my ( $code, $proto ) = @_; | |
56 | return Sub::Util::set_prototype( $proto, $code ); | |
57 | } | |
58 | ||
f4a2945e JH |
59 | 1; |
60 | ||
61 | __END__ | |
62 | ||
63 | =head1 NAME | |
64 | ||
65 | Scalar::Util - A selection of general-utility scalar subroutines | |
66 | ||
67 | =head1 SYNOPSIS | |
68 | ||
8b198969 CBW |
69 | use Scalar::Util qw(blessed dualvar isdual readonly refaddr reftype |
70 | tainted weaken isweak isvstring looks_like_number | |
71 | set_prototype); | |
2ff28616 | 72 | # and other useful utils appearing below |
f4a2945e JH |
73 | |
74 | =head1 DESCRIPTION | |
75 | ||
8c167fd9 CBW |
76 | C<Scalar::Util> contains a selection of subroutines that people have expressed |
77 | would be nice to have in the perl core, but the usage would not really be high | |
e8164ee7 JH |
78 | enough to warrant the use of a keyword, and the size would be so small that |
79 | being individual extensions would be wasteful. | |
8c167fd9 CBW |
80 | |
81 | By default C<Scalar::Util> does not export any subroutines. | |
82 | ||
83 | =cut | |
84 | ||
85 | =head1 FUNCTIONS FOR REFERENCES | |
f4a2945e | 86 | |
8c167fd9 | 87 | The following functions all perform some useful activity on reference values. |
f4a2945e | 88 | |
d81c2d6a CBW |
89 | =head2 blessed |
90 | ||
91 | my $pkg = blessed( $ref ); | |
f4a2945e | 92 | |
e8164ee7 | 93 | If C<$ref> is a blessed reference, the name of the package that it is blessed |
8c167fd9 | 94 | into is returned. Otherwise C<undef> is returned. |
f4a2945e | 95 | |
8c167fd9 CBW |
96 | $scalar = "foo"; |
97 | $class = blessed $scalar; # undef | |
c29e891d | 98 | |
8c167fd9 CBW |
99 | $ref = []; |
100 | $class = blessed $ref; # undef | |
c29e891d | 101 | |
8c167fd9 CBW |
102 | $obj = bless [], "Foo"; |
103 | $class = blessed $obj; # "Foo" | |
c29e891d | 104 | |
ad434879 | 105 | Take care when using this function simply as a truth test (such as in |
8c167fd9 CBW |
106 | C<if(blessed $ref)...>) because the package name C<"0"> is defined yet false. |
107 | ||
d81c2d6a CBW |
108 | =head2 refaddr |
109 | ||
110 | my $addr = refaddr( $ref ); | |
8c167fd9 | 111 | |
e8164ee7 | 112 | If C<$ref> is reference, the internal memory address of the referenced value is |
8c167fd9 CBW |
113 | returned as a plain integer. Otherwise C<undef> is returned. |
114 | ||
115 | $addr = refaddr "string"; # undef | |
116 | $addr = refaddr \$var; # eg 12345678 | |
117 | $addr = refaddr []; # eg 23456784 | |
118 | ||
119 | $obj = bless {}, "Foo"; | |
120 | $addr = refaddr $obj; # eg 88123488 | |
121 | ||
d81c2d6a CBW |
122 | =head2 reftype |
123 | ||
124 | my $type = reftype( $ref ); | |
8c167fd9 | 125 | |
e8164ee7 | 126 | If C<$ref> is a reference, the basic Perl type of the variable referenced is |
8c167fd9 CBW |
127 | returned as a plain string (such as C<ARRAY> or C<HASH>). Otherwise C<undef> |
128 | is returned. | |
129 | ||
130 | $type = reftype "string"; # undef | |
131 | $type = reftype \$var; # SCALAR | |
132 | $type = reftype []; # ARRAY | |
133 | ||
134 | $obj = bless {}, "Foo"; | |
135 | $type = reftype $obj; # HASH | |
136 | ||
d81c2d6a | 137 | =head2 weaken |
8c167fd9 | 138 | |
d81c2d6a CBW |
139 | weaken( $ref ); |
140 | ||
141 | The lvalue C<$ref> will be turned into a weak reference. This means that it | |
e8164ee7 | 142 | will not hold a reference count on the object it references. Also, when the |
8c167fd9 CBW |
143 | reference count on that object reaches zero, the reference will be set to |
144 | undef. This function mutates the lvalue passed as its argument and returns no | |
145 | value. | |
146 | ||
147 | This is useful for keeping copies of references, but you don't want to prevent | |
148 | the object being DESTROY-ed at its usual time. | |
149 | ||
150 | { | |
151 | my $var; | |
152 | $ref = \$var; | |
153 | weaken($ref); # Make $ref a weak reference | |
154 | } | |
155 | # $ref is now undef | |
156 | ||
157 | Note that if you take a copy of a scalar with a weakened reference, the copy | |
158 | will be a strong reference. | |
159 | ||
160 | my $var; | |
161 | my $foo = \$var; | |
162 | weaken($foo); # Make $foo a weak reference | |
163 | my $bar = $foo; # $bar is now a strong reference | |
164 | ||
165 | This may be less obvious in other situations, such as C<grep()>, for instance | |
166 | when grepping through a list of weakened references to objects that may have | |
167 | been destroyed already: | |
168 | ||
169 | @object = grep { defined } @object; | |
170 | ||
171 | This will indeed remove all references to destroyed objects, but the remaining | |
172 | references to objects will be strong, causing the remaining objects to never be | |
173 | destroyed because there is now always a strong reference to them in the @object | |
174 | array. | |
175 | ||
d81c2d6a CBW |
176 | =head2 unweaken |
177 | ||
178 | unweaken( $ref ); | |
8c167fd9 | 179 | |
b823713c CBW |
180 | I<Since version 1.36.> |
181 | ||
8c167fd9 CBW |
182 | The lvalue C<REF> will be turned from a weak reference back into a normal |
183 | (strong) reference again. This function mutates the lvalue passed as its | |
184 | argument and returns no value. This undoes the action performed by | |
d81c2d6a | 185 | L</weaken>. |
8c167fd9 CBW |
186 | |
187 | This function is slightly neater and more convenient than the | |
188 | otherwise-equivalent code | |
189 | ||
190 | my $tmp = $REF; | |
191 | undef $REF; | |
192 | $REF = $tmp; | |
193 | ||
194 | (because in particular, simply assigning a weak reference back to itself does | |
195 | not work to unweaken it; C<$REF = $REF> does not work). | |
196 | ||
d81c2d6a CBW |
197 | =head2 isweak |
198 | ||
199 | my $weak = isweak( $ref ); | |
8c167fd9 CBW |
200 | |
201 | Returns true if C<$ref> is a weak reference. | |
202 | ||
203 | $ref = \$foo; | |
204 | $weak = isweak($ref); # false | |
205 | weaken($ref); | |
206 | $weak = isweak($ref); # true | |
ad434879 | 207 | |
8c167fd9 CBW |
208 | B<NOTE>: Copying a weak reference creates a normal, strong, reference. |
209 | ||
210 | $copy = $ref; | |
211 | $weak = isweak($copy); # false | |
f4a2945e | 212 | |
8c167fd9 CBW |
213 | =head1 OTHER FUNCTIONS |
214 | ||
d81c2d6a CBW |
215 | =head2 dualvar |
216 | ||
217 | my $var = dualvar( $num, $string ); | |
8c167fd9 CBW |
218 | |
219 | Returns a scalar that has the value C<$num> in a numeric context and the value | |
220 | C<$string> in a string context. | |
f4a2945e JH |
221 | |
222 | $foo = dualvar 10, "Hello"; | |
c29e891d GB |
223 | $num = $foo + 2; # 12 |
224 | $str = $foo . " world"; # Hello world | |
f4a2945e | 225 | |
d81c2d6a CBW |
226 | =head2 isdual |
227 | ||
228 | my $dual = isdual( $var ); | |
60f3865b | 229 | |
b823713c CBW |
230 | I<Since version 1.26.> |
231 | ||
8c167fd9 CBW |
232 | If C<$var> is a scalar that has both numeric and string values, the result is |
233 | true. | |
60f3865b | 234 | |
8b198969 CBW |
235 | $foo = dualvar 86, "Nix"; |
236 | $dual = isdual($foo); # true | |
60f3865b | 237 | |
8c167fd9 CBW |
238 | Note that a scalar can be made to have both string and numeric content through |
239 | numeric operations: | |
f4a2945e | 240 | |
8b198969 CBW |
241 | $foo = "10"; |
242 | $dual = isdual($foo); # false | |
243 | $bar = $foo + 0; | |
244 | $dual = isdual($foo); # true | |
f4a2945e | 245 | |
e8164ee7 JH |
246 | Note that although C<$!> appears to be a dual-valued variable, it is |
247 | actually implemented as a magical variable inside the interpreter: | |
c29e891d | 248 | |
8b198969 CBW |
249 | $! = 1; |
250 | print("$!\n"); # "Operation not permitted" | |
251 | $dual = isdual($!); # false | |
4984adac | 252 | |
8b198969 CBW |
253 | You can capture its numeric and string content using: |
254 | ||
255 | $err = dualvar $!, $!; | |
256 | $dual = isdual($err); # true | |
257 | ||
d81c2d6a CBW |
258 | =head2 isvstring |
259 | ||
260 | my $vstring = isvstring( $var ); | |
8b198969 | 261 | |
e8164ee7 | 262 | If C<$var> is a scalar which was coded as a vstring, the result is true. |
8b198969 CBW |
263 | |
264 | $vs = v49.46.48; | |
265 | $fmt = isvstring($vs) ? "%vd" : "%s"; #true | |
266 | printf($fmt,$vs); | |
4984adac | 267 | |
d81c2d6a CBW |
268 | =head2 looks_like_number |
269 | ||
270 | my $isnum = looks_like_number( $var ); | |
9e7deb6c | 271 | |
8c167fd9 | 272 | Returns true if perl thinks C<$var> is a number. See |
9e7deb6c GB |
273 | L<perlapi/looks_like_number>. |
274 | ||
d81c2d6a CBW |
275 | =head2 openhandle |
276 | ||
277 | my $fh = openhandle( $fh ); | |
c0f790df | 278 | |
8c167fd9 CBW |
279 | Returns C<$fh> itself if C<$fh> may be used as a filehandle and is open, or is |
280 | is a tied handle. Otherwise C<undef> is returned. | |
c0f790df | 281 | |
8b198969 CBW |
282 | $fh = openhandle(*STDIN); # \*STDIN |
283 | $fh = openhandle(\*STDIN); # \*STDIN | |
284 | $fh = openhandle(*NOTOPEN); # undef | |
285 | $fh = openhandle("scalar"); # undef | |
286 | ||
d81c2d6a CBW |
287 | =head2 readonly |
288 | ||
289 | my $ro = readonly( $var ); | |
ee4ffb48 | 290 | |
8c167fd9 | 291 | Returns true if C<$var> is readonly. |
ee4ffb48 | 292 | |
c29e891d GB |
293 | sub foo { readonly($_[0]) } |
294 | ||
295 | $readonly = foo($bar); # false | |
296 | $readonly = foo(0); # true | |
297 | ||
d81c2d6a CBW |
298 | =head2 set_prototype |
299 | ||
300 | my $code = set_prototype( $code, $prototype ); | |
f4a2945e | 301 | |
8c167fd9 CBW |
302 | Sets the prototype of the function given by the C<$code> reference, or deletes |
303 | it if C<$prototype> is C<undef>. Returns the C<$code> reference itself. | |
97605c51 GB |
304 | |
305 | set_prototype \&foo, '$$'; | |
306 | ||
d81c2d6a CBW |
307 | =head2 tainted |
308 | ||
309 | my $t = tainted( $var ); | |
ee4ffb48 | 310 | |
8c167fd9 | 311 | Return true if C<$var> is tainted. |
ee4ffb48 | 312 | |
c29e891d GB |
313 | $taint = tainted("constant"); # false |
314 | $taint = tainted($ENV{PWD}); # true if running under -T | |
315 | ||
2ff28616 GB |
316 | =head1 DIAGNOSTICS |
317 | ||
318 | Module use may give one of the following errors during import. | |
319 | ||
320 | =over | |
321 | ||
322 | =item Weak references are not implemented in the version of perl | |
323 | ||
8c167fd9 | 324 | The version of perl that you are using does not implement weak references, to |
d81c2d6a | 325 | use L</isweak> or L</weaken> you will need to use a newer release of perl. |
2ff28616 GB |
326 | |
327 | =item Vstrings are not implemented in the version of perl | |
328 | ||
329 | The version of perl that you are using does not implement Vstrings, to use | |
d81c2d6a | 330 | L</isvstring> you will need to use a newer release of perl. |
2ff28616 | 331 | |
2ff28616 GB |
332 | =back |
333 | ||
9c3c560b JH |
334 | =head1 KNOWN BUGS |
335 | ||
336 | There is a bug in perl5.6.0 with UV's that are >= 1<<31. This will | |
337 | show up as tests 8 and 9 of dualvar.t failing | |
338 | ||
ddf53ba4 GB |
339 | =head1 SEE ALSO |
340 | ||
341 | L<List::Util> | |
342 | ||
f4a2945e JH |
343 | =head1 COPYRIGHT |
344 | ||
2ff28616 | 345 | Copyright (c) 1997-2007 Graham Barr <gbarr@pobox.com>. All rights reserved. |
c29e891d | 346 | This program is free software; you can redistribute it and/or modify it |
f4a2945e JH |
347 | under the same terms as Perl itself. |
348 | ||
d81c2d6a | 349 | Additionally L</weaken> and L</isweak> which are |
f4a2945e JH |
350 | |
351 | Copyright (c) 1999 Tuomas J. Lukka <lukka@iki.fi>. All rights reserved. | |
352 | This program is free software; you can redistribute it and/or modify it | |
353 | under the same terms as perl itself. | |
354 | ||
d81c2d6a CBW |
355 | Copyright (C) 2004, 2008 Matthijs van Duin. All rights reserved. |
356 | Copyright (C) 2014 cPanel Inc. All rights reserved. | |
357 | This program is free software; you can redistribute it and/or modify | |
358 | it under the same terms as Perl itself. | |
359 | ||
f4a2945e | 360 | =cut |