Commit | Line | Data |
---|---|---|
86530b38 AT |
1 | # Scalar::Util.pm |
2 | # | |
3 | # Copyright (c) 1997-2001 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 | require Exporter; | |
10 | require List::Util; # List::Util loads the XS | |
11 | ||
12 | our @ISA = qw(Exporter); | |
13 | our @EXPORT_OK = qw(blessed dualvar reftype weaken isweak tainted readonly openhandle); | |
14 | our $VERSION = $List::Util::VERSION; | |
15 | ||
16 | sub openhandle ($) { | |
17 | my $fh = shift; | |
18 | my $rt = reftype($fh) || ''; | |
19 | ||
20 | return defined(fileno($fh)) ? $fh : undef | |
21 | if $rt eq 'IO'; | |
22 | ||
23 | if (reftype(\$fh) eq 'GLOB') { # handle openhandle(*DATA) | |
24 | $fh = \(my $tmp=$fh); | |
25 | } | |
26 | elsif ($rt ne 'GLOB') { | |
27 | return undef; | |
28 | } | |
29 | ||
30 | (tied(*$fh) or defined(fileno($fh))) | |
31 | ? $fh : undef; | |
32 | } | |
33 | ||
34 | 1; | |
35 | ||
36 | __END__ | |
37 | ||
38 | =head1 NAME | |
39 | ||
40 | Scalar::Util - A selection of general-utility scalar subroutines | |
41 | ||
42 | =head1 SYNOPSIS | |
43 | ||
44 | use Scalar::Util qw(blessed dualvar isweak readonly reftype tainted weaken); | |
45 | ||
46 | =head1 DESCRIPTION | |
47 | ||
48 | C<Scalar::Util> contains a selection of subroutines that people have | |
49 | expressed would be nice to have in the perl core, but the usage would | |
50 | not really be high enough to warrant the use of a keyword, and the size | |
51 | so small such that being individual extensions would be wasteful. | |
52 | ||
53 | By default C<Scalar::Util> does not export any subroutines. The | |
54 | subroutines defined are | |
55 | ||
56 | =over 4 | |
57 | ||
58 | =item blessed EXPR | |
59 | ||
60 | If EXPR evaluates to a blessed reference the name of the package | |
61 | that it is blessed into is returned. Otherwise C<undef> is returned. | |
62 | ||
63 | $scalar = "foo"; | |
64 | $class = blessed $scalar; # undef | |
65 | ||
66 | $ref = []; | |
67 | $class = blessed $ref; # undef | |
68 | ||
69 | $obj = bless [], "Foo"; | |
70 | $class = blessed $obj; # "Foo" | |
71 | ||
72 | =item dualvar NUM, STRING | |
73 | ||
74 | Returns a scalar that has the value NUM in a numeric context and the | |
75 | value STRING in a string context. | |
76 | ||
77 | $foo = dualvar 10, "Hello"; | |
78 | $num = $foo + 2; # 12 | |
79 | $str = $foo . " world"; # Hello world | |
80 | ||
81 | =item isweak EXPR | |
82 | ||
83 | If EXPR is a scalar which is a weak reference the result is true. | |
84 | ||
85 | $ref = \$foo; | |
86 | $weak = isweak($ref); # false | |
87 | weaken($ref); | |
88 | $weak = isweak($ref); # true | |
89 | ||
90 | =item openhandle FH | |
91 | ||
92 | Returns FH if FH may be used as a filehandle and is open, or FH is a tied | |
93 | handle. Otherwise C<undef> is returned. | |
94 | ||
95 | $fh = openhandle(*STDIN); # \*STDIN | |
96 | $fh = openhandle(\*STDIN); # \*STDIN | |
97 | $fh = openhandle(*NOTOPEN); # undef | |
98 | $fh = openhandle("scalar"); # undef | |
99 | ||
100 | =item readonly SCALAR | |
101 | ||
102 | Returns true if SCALAR is readonly. | |
103 | ||
104 | sub foo { readonly($_[0]) } | |
105 | ||
106 | $readonly = foo($bar); # false | |
107 | $readonly = foo(0); # true | |
108 | ||
109 | =item reftype EXPR | |
110 | ||
111 | If EXPR evaluates to a reference the type of the variable referenced | |
112 | is returned. Otherwise C<undef> is returned. | |
113 | ||
114 | $type = reftype "string"; # undef | |
115 | $type = reftype \$var; # SCALAR | |
116 | $type = reftype []; # ARRAY | |
117 | ||
118 | $obj = bless {}, "Foo"; | |
119 | $type = reftype $obj; # HASH | |
120 | ||
121 | =item tainted EXPR | |
122 | ||
123 | Return true if the result of EXPR is tainted | |
124 | ||
125 | $taint = tainted("constant"); # false | |
126 | $taint = tainted($ENV{PWD}); # true if running under -T | |
127 | ||
128 | =item weaken REF | |
129 | ||
130 | REF will be turned into a weak reference. This means that it will not | |
131 | hold a reference count on the object it references. Also when the reference | |
132 | count on that object reaches zero, REF will be set to undef. | |
133 | ||
134 | This is useful for keeping copies of references , but you don't want to | |
135 | prevent the object being DESTROY-ed at its usual time. | |
136 | ||
137 | { | |
138 | my $var; | |
139 | $ref = \$var; | |
140 | weaken($ref); # Make $ref a weak reference | |
141 | } | |
142 | # $ref is now undef | |
143 | ||
144 | =back | |
145 | ||
146 | =head1 KNOWN BUGS | |
147 | ||
148 | There is a bug in perl5.6.0 with UV's that are >= 1<<31. This will | |
149 | show up as tests 8 and 9 of dualvar.t failing | |
150 | ||
151 | =head1 COPYRIGHT | |
152 | ||
153 | Copyright (c) 1997-2001 Graham Barr <gbarr@pobox.com>. All rights reserved. | |
154 | This program is free software; you can redistribute it and/or modify it | |
155 | under the same terms as Perl itself. | |
156 | ||
157 | Except weaken and isweak which are | |
158 | ||
159 | Copyright (c) 1999 Tuomas J. Lukka <lukka@iki.fi>. All rights reserved. | |
160 | This program is free software; you can redistribute it and/or modify it | |
161 | under the same terms as perl itself. | |
162 | ||
163 | =head1 BLATANT PLUG | |
164 | ||
165 | The weaken and isweak subroutines in this module and the patch to the core Perl | |
166 | were written in connection with the APress book `Tuomas J. Lukka's Definitive | |
167 | Guide to Object-Oriented Programming in Perl', to avoid explaining why certain | |
168 | things would have to be done in cumbersome ways. | |
169 | ||
170 | =cut |