This is a live mirror of the Perl 5 development currently hosted at https://github.com/perl/perl5
Add Scalar-List-Utils 1.02, from Graham Barr.
[perl5.git] / ext / List / Util / lib / Scalar / Util.pm
CommitLineData
f4a2945e
JH
1# Scalar::Util.pm
2#
3# Copyright (c) 1997-2000 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
7package Scalar::Util;
8
9require Exporter;
10require List::Util; # List::Util loads the XS
11
12$VERSION = $VERSION = $List::Util::VERSION;
13@ISA = qw(Exporter);
14@EXPORT_OK = qw(blessed dualvar reftype weaken isweak tainted readonly);
15
16sub export_fail {
17 if (grep { /^(weaken|isweak)$/ } @_ ) {
18 require Carp;
19 Carp::croak("Weak references are not implemented in the version of perl");
20 }
21 if (grep { /^dualvar$/ } @_ ) {
22 require Carp;
23 Carp::croak("dualvar is only avaliable with the XS version");
24 }
25
26 @_;
27}
28
29eval <<'ESQ' unless defined &dualvar;
30
31push @EXPORT_FAIL, qw(weaken isweak dualvar);
32
33# The code beyond here is only used if the XS is not installed
34
35# Hope nobody defines a sub by this name
36sub UNIVERSAL::a_sub_not_likely_to_be_here { ref($_[0]) }
37
38sub blessed ($) {
39 local($@, $SIG{__DIE__}, $SIG{__WARN__});
40 length(ref($_[0]))
41 ? eval { $_[0]->a_sub_not_likely_to_be_here }
42 : undef
43}
44
45sub reftype ($) {
46 local($@, $SIG{__DIE__}, $SIG{__WARN__});
47 my $r = shift;
48 my $t;
49
50 length($t = ref($r)) or return undef;
51
52 # This eval will fail if the reference is not blessed
53 eval { $r->a_sub_not_likely_to_be_here; 1 }
54 ? do {
55 $t = eval {
56 # we have a GLOB or an IO. Stringify a GLOB gives it's name
57 my $q = *$r;
58 $q =~ /^\*/ ? "GLOB" : "IO";
59 }
60 or do {
61 # OK, if we don't have a GLOB what parts of
62 # a glob will it populate.
63 # NOTE: A glob always has a SCALAR
64 local *glob = $r;
65 defined *glob{ARRAY} && "ARRAY"
66 or defined *glob{HASH} && "HASH"
67 or defined *glob{CODE} && "CODE"
68 or length(ref(${$r})) ? "REF" : "SCALAR";
69 }
70 }
71 : $t
72}
73
74sub tainted {
75 local($@, $SIG{__DIE__}, $SIG{__WARN__});
76 local $^W = 0;
77 eval { kill 0 * $_[0] };
78 $@ =~ /^Insecure/;
79}
80
81sub readonly {
82 return 0 if tied($_[0]) || (ref(\($_[0])) ne "SCALAR");
83
84 local($@, $SIG{__DIE__}, $SIG{__WARN__});
85 my $tmp = $_[0];
86
87 !eval { $_[0] = $tmp; 1 };
88}
89
90ESQ
91
921;
93
94__END__
95
96=head1 NAME
97
98Scalar::Util - A selection of general-utility scalar subroutines
99
100=head1 SYNOPSIS
101
102 use Scalar::Util qw(blessed dualvar reftype weaken isweak);
103
104=head1 DESCRIPTION
105
106C<Scalar::Util> contains a selection of subroutines that people have
107expressed would be nice to have in the perl core, but the usage would
108not really be high enough to warrant the use of a keyword, and the size
109so small such that being individual extensions would be wasteful.
110
111By default C<Scalar::Util> does not export any subroutines. The
112subroutines defined are
113
114=over 4
115
116=item blessed EXPR
117
118If EXPR evaluates to a blessed reference the name of the package
119that it is blessed into is returned. Otherwise C<undef> is returned.
120
121=item dualvar NUM, STRING
122
123Returns a scalar that has the value NUM in a numeric context and the
124value STRING in a string context.
125
126 $foo = dualvar 10, "Hello";
127 $num = $foo + 2; # 12
128 $str = $foo . " world"; # Hello world
129
130=item isweak EXPR
131
132If EXPR is a scalar which is a weak reference the result is true.
133
134=item reftype EXPR
135
136If EXPR evaluates to a reference the type of the variable referenced
137is returned. Otherwise C<undef> is returned.
138
139=item weaken REF
140
141REF will be turned into a weak reference. This means that it will not
142hold a reference count on the object it references. Also when the reference
143count on that object reaches zero, REF will be set to undef.
144
145This is useful for keeping copies of references , but you don't want to
146prevent the object being DESTROY-ed at it's usual time.
147
148=back
149
150=head1 COPYRIGHT
151
152Copyright (c) 1997-2000 Graham Barr <gbarr@pobox.com>. All rights reserved.
153This program is free software; you can redistribute it and/or modify it
154under the same terms as Perl itself.
155
156except weaken and isweak which are
157
158Copyright (c) 1999 Tuomas J. Lukka <lukka@iki.fi>. All rights reserved.
159This program is free software; you can redistribute it and/or modify it
160under the same terms as perl itself.
161
162=head1 BLATANT PLUG
163
164The weaken and isweak subroutines in this module and the patch to the core Perl
165were written in connection with the APress book `Tuomas J. Lukka's Definitive
166Guide to Object-Oriented Programming in Perl', to avoid explaining why certain
167things would have to be done in cumbersome ways.
168
169=cut