line |
stmt |
bran |
cond |
sub |
pod |
time |
code |
1
|
|
|
|
|
|
|
=head1 NAME |
2
|
|
|
|
|
|
|
|
3
|
|
|
|
|
|
|
Params::Classify - argument type classification |
4
|
|
|
|
|
|
|
|
5
|
|
|
|
|
|
|
=head1 SYNOPSIS |
6
|
|
|
|
|
|
|
|
7
|
|
|
|
|
|
|
use Params::Classify qw( |
8
|
|
|
|
|
|
|
scalar_class |
9
|
|
|
|
|
|
|
is_undef check_undef |
10
|
|
|
|
|
|
|
is_string check_string |
11
|
|
|
|
|
|
|
is_number check_number |
12
|
|
|
|
|
|
|
is_glob check_glob |
13
|
|
|
|
|
|
|
is_regexp check_regexp |
14
|
|
|
|
|
|
|
is_ref check_ref ref_type |
15
|
|
|
|
|
|
|
is_blessed check_blessed blessed_class |
16
|
|
|
|
|
|
|
is_strictly_blessed check_strictly_blessed |
17
|
|
|
|
|
|
|
is_able check_able); |
18
|
|
|
|
|
|
|
|
19
|
|
|
|
|
|
|
$c = scalar_class($arg); |
20
|
|
|
|
|
|
|
|
21
|
|
|
|
|
|
|
if(is_undef($arg)) { |
22
|
|
|
|
|
|
|
check_undef($arg); |
23
|
|
|
|
|
|
|
|
24
|
|
|
|
|
|
|
if(is_string($arg)) { |
25
|
|
|
|
|
|
|
check_string($arg); |
26
|
|
|
|
|
|
|
if(is_number($arg)) { |
27
|
|
|
|
|
|
|
check_number($arg); |
28
|
|
|
|
|
|
|
|
29
|
|
|
|
|
|
|
if(is_glob($arg)) { |
30
|
|
|
|
|
|
|
check_glob($arg); |
31
|
|
|
|
|
|
|
if(is_regexp($arg)) { |
32
|
|
|
|
|
|
|
check_regexp($arg); |
33
|
|
|
|
|
|
|
|
34
|
|
|
|
|
|
|
if(is_ref($arg)) { |
35
|
|
|
|
|
|
|
check_ref($arg); |
36
|
|
|
|
|
|
|
$t = ref_type($arg); |
37
|
|
|
|
|
|
|
if(is_ref($arg, "HASH")) { |
38
|
|
|
|
|
|
|
check_ref($arg, "HASH"); |
39
|
|
|
|
|
|
|
|
40
|
|
|
|
|
|
|
if(is_blessed($arg)) { |
41
|
|
|
|
|
|
|
check_blessed($arg); |
42
|
|
|
|
|
|
|
if(is_blessed($arg, "IO::Handle")) { |
43
|
|
|
|
|
|
|
check_blessed($arg, "IO::Handle"); |
44
|
|
|
|
|
|
|
$c = blessed_class($arg); |
45
|
|
|
|
|
|
|
if(is_strictly_blessed($arg, "IO::Pipe::End")) { |
46
|
|
|
|
|
|
|
check_strictly_blessed($arg, "IO::Pipe::End"); |
47
|
|
|
|
|
|
|
if(is_able($arg, ["print", "flush"])) { |
48
|
|
|
|
|
|
|
check_able($arg, ["print", "flush"]); |
49
|
|
|
|
|
|
|
|
50
|
|
|
|
|
|
|
=head1 DESCRIPTION |
51
|
|
|
|
|
|
|
|
52
|
|
|
|
|
|
|
This module provides various type-testing functions. These are intended |
53
|
|
|
|
|
|
|
for functions that, unlike most Perl code, care what type of data they |
54
|
|
|
|
|
|
|
are operating on. For example, some functions wish to behave differently |
55
|
|
|
|
|
|
|
depending on the type of their arguments (like overloaded functions |
56
|
|
|
|
|
|
|
in C++). |
57
|
|
|
|
|
|
|
|
58
|
|
|
|
|
|
|
There are two flavours of function in this module. Functions of the first |
59
|
|
|
|
|
|
|
flavour only provide type classification, to allow code to discriminate |
60
|
|
|
|
|
|
|
between argument types. Functions of the second flavour package up the |
61
|
|
|
|
|
|
|
most common type of type discrimination: checking that an argument is |
62
|
|
|
|
|
|
|
of an expected type. The functions come in matched pairs, of the two |
63
|
|
|
|
|
|
|
flavours, and so the type enforcement functions handle only the simplest |
64
|
|
|
|
|
|
|
requirements for arguments of the types handled by the classification |
65
|
|
|
|
|
|
|
functions. Enforcement of more complex types may, of course, be built |
66
|
|
|
|
|
|
|
using the classification functions, or it may be more convenient to use |
67
|
|
|
|
|
|
|
a module designed for the more complex job, such as L<Params::Validate>. |
68
|
|
|
|
|
|
|
|
69
|
|
|
|
|
|
|
This module is implemented in XS, with a pure Perl backup version for |
70
|
|
|
|
|
|
|
systems that can't handle XS. |
71
|
|
|
|
|
|
|
|
72
|
|
|
|
|
|
|
=cut |
73
|
|
|
|
|
|
|
|
74
|
|
|
|
|
|
|
package Params::Classify; |
75
|
|
|
|
|
|
|
|
76
|
12
|
|
|
12
|
|
656381
|
{ use 5.006001; } |
|
12
|
|
|
|
|
46
|
|
77
|
12
|
|
|
12
|
|
71
|
use warnings; |
|
12
|
|
|
|
|
28
|
|
|
12
|
|
|
|
|
369
|
|
78
|
12
|
|
|
12
|
|
62
|
use strict; |
|
12
|
|
|
|
|
29
|
|
|
12
|
|
|
|
|
544
|
|
79
|
|
|
|
|
|
|
|
80
|
|
|
|
|
|
|
our $VERSION = "0.015"; |
81
|
|
|
|
|
|
|
|
82
|
12
|
|
|
12
|
|
3797
|
use parent "Exporter"; |
|
12
|
|
|
|
|
3395
|
|
|
12
|
|
|
|
|
92
|
|
83
|
|
|
|
|
|
|
our @EXPORT_OK = qw( |
84
|
|
|
|
|
|
|
scalar_class |
85
|
|
|
|
|
|
|
is_undef check_undef |
86
|
|
|
|
|
|
|
is_string check_string |
87
|
|
|
|
|
|
|
is_number check_number |
88
|
|
|
|
|
|
|
is_glob check_glob |
89
|
|
|
|
|
|
|
is_regexp check_regexp |
90
|
|
|
|
|
|
|
is_ref check_ref ref_type |
91
|
|
|
|
|
|
|
is_blessed check_blessed blessed_class |
92
|
|
|
|
|
|
|
is_strictly_blessed check_strictly_blessed |
93
|
|
|
|
|
|
|
is_able check_able |
94
|
|
|
|
|
|
|
); |
95
|
|
|
|
|
|
|
|
96
|
|
|
|
|
|
|
eval { local $SIG{__DIE__}; |
97
|
|
|
|
|
|
|
require Devel::CallChecker; |
98
|
|
|
|
|
|
|
Devel::CallChecker->VERSION(0.003); |
99
|
|
|
|
|
|
|
}; |
100
|
|
|
|
|
|
|
eval { local $SIG{__DIE__}; |
101
|
|
|
|
|
|
|
require XSLoader; |
102
|
|
|
|
|
|
|
XSLoader::load(__PACKAGE__, $VERSION); |
103
|
|
|
|
|
|
|
}; |
104
|
|
|
|
|
|
|
|
105
|
|
|
|
|
|
|
if($@ eq "") { |
106
|
|
|
|
|
|
|
close(DATA); |
107
|
|
|
|
|
|
|
} else { |
108
|
|
|
|
|
|
|
(my $filename = __FILE__) =~ tr# -~##cd; |
109
|
|
|
|
|
|
|
local $/ = undef; |
110
|
|
|
|
|
|
|
my $pp_code = "#line 137 \"$filename\"\n".<DATA>; |
111
|
|
|
|
|
|
|
close(DATA); |
112
|
|
|
|
|
|
|
{ |
113
|
|
|
|
|
|
|
local $SIG{__DIE__}; |
114
|
|
|
|
|
|
|
eval $pp_code; |
115
|
|
|
|
|
|
|
} |
116
|
|
|
|
|
|
|
die $@ if $@ ne ""; |
117
|
|
|
|
|
|
|
} |
118
|
|
|
|
|
|
|
|
119
|
|
|
|
|
|
|
sub is_string($); |
120
|
|
|
|
|
|
|
sub is_number($) { |
121
|
212
|
100
|
|
212
|
1
|
32757
|
return 0 unless &is_string; |
122
|
72
|
|
|
|
|
131
|
my $warned; |
123
|
72
|
|
|
36
|
|
434
|
local $SIG{__WARN__} = sub { $warned = 1; }; |
|
36
|
|
|
|
|
133
|
|
124
|
72
|
|
|
|
|
141
|
my $arg = $_[0]; |
125
|
12
|
|
|
12
|
|
3317
|
{ no warnings "void"; 0 + $arg; } |
|
12
|
|
|
|
|
33
|
|
|
12
|
|
|
|
|
1275
|
|
|
72
|
|
|
|
|
93
|
|
|
72
|
|
|
|
|
470
|
|
126
|
72
|
|
|
|
|
411
|
return !$warned; |
127
|
|
|
|
|
|
|
} |
128
|
|
|
|
|
|
|
|
129
|
|
|
|
|
|
|
sub check_number($) { |
130
|
84
|
100
|
|
84
|
1
|
555712
|
die "argument is not a number\n" unless &is_number; |
131
|
|
|
|
|
|
|
} |
132
|
|
|
|
|
|
|
|
133
|
|
|
|
|
|
|
1; |
134
|
|
|
|
|
|
|
|
135
|
|
|
|
|
|
|
__DATA__ |
136
|
|
|
|
|
|
|
|
137
|
|
|
|
|
|
|
use Scalar::Util 1.01 qw(blessed reftype); |
138
|
28
|
|
|
28
|
|
5917
|
|
|
28
|
|
|
|
|
209
|
|
|
20
|
|
|
|
|
8301
|
|
139
|
|
|
|
|
|
|
=head1 TYPE CLASSIFICATION |
140
|
|
|
|
|
|
|
|
141
|
|
|
|
|
|
|
This module divides up scalar values into the following classes: |
142
|
|
|
|
|
|
|
|
143
|
|
|
|
|
|
|
=over |
144
|
|
|
|
|
|
|
|
145
|
|
|
|
|
|
|
=item * |
146
|
|
|
|
|
|
|
|
147
|
|
|
|
|
|
|
undef |
148
|
|
|
|
|
|
|
|
149
|
|
|
|
|
|
|
=item * |
150
|
|
|
|
|
|
|
|
151
|
|
|
|
|
|
|
string (defined ordinary scalar) |
152
|
|
|
|
|
|
|
|
153
|
|
|
|
|
|
|
=item * |
154
|
|
|
|
|
|
|
|
155
|
|
|
|
|
|
|
typeglob (yes, typeglobs fit into scalar variables) |
156
|
|
|
|
|
|
|
|
157
|
|
|
|
|
|
|
=item * |
158
|
|
|
|
|
|
|
|
159
|
|
|
|
|
|
|
regexp (first-class regular expression objects in Perl 5.11 onwards) |
160
|
|
|
|
|
|
|
|
161
|
|
|
|
|
|
|
=item * |
162
|
|
|
|
|
|
|
|
163
|
|
|
|
|
|
|
reference to unblessed object (further classified by physical data type |
164
|
|
|
|
|
|
|
of the referenced object) |
165
|
|
|
|
|
|
|
|
166
|
|
|
|
|
|
|
=item * |
167
|
|
|
|
|
|
|
|
168
|
|
|
|
|
|
|
reference to blessed object (further classified by class blessed into) |
169
|
|
|
|
|
|
|
|
170
|
|
|
|
|
|
|
=back |
171
|
|
|
|
|
|
|
|
172
|
|
|
|
|
|
|
These classes are mutually exclusive and should be exhaustive. This |
173
|
|
|
|
|
|
|
classification has been chosen as the most useful when one wishes to |
174
|
|
|
|
|
|
|
discriminate between types of scalar. Other classifications are possible. |
175
|
|
|
|
|
|
|
(For example, the two reference classes are distinguished by a feature of |
176
|
|
|
|
|
|
|
the referenced object; Perl does not internally treat this as a feature |
177
|
|
|
|
|
|
|
of the reference.) |
178
|
|
|
|
|
|
|
|
179
|
|
|
|
|
|
|
=head1 FUNCTIONS |
180
|
|
|
|
|
|
|
|
181
|
|
|
|
|
|
|
Each of these functions takes one scalar argument (I<ARG>) to be tested, |
182
|
|
|
|
|
|
|
possibly with other arguments specifying details of the test. Any scalar |
183
|
|
|
|
|
|
|
value is acceptable for the argument to be tested. Each C<is_> function |
184
|
|
|
|
|
|
|
returns a simple truth value result, which is true iff I<ARG> is of the |
185
|
|
|
|
|
|
|
type being checked for. Each C<check_> function will return normally |
186
|
|
|
|
|
|
|
if the argument is of the type being checked for, or will C<die> if it |
187
|
|
|
|
|
|
|
is not. |
188
|
|
|
|
|
|
|
|
189
|
|
|
|
|
|
|
=head2 Classification |
190
|
|
|
|
|
|
|
|
191
|
|
|
|
|
|
|
=over |
192
|
|
|
|
|
|
|
|
193
|
|
|
|
|
|
|
=item scalar_class(ARG) |
194
|
|
|
|
|
|
|
|
195
|
|
|
|
|
|
|
Determines which of the five classes described above I<ARG> falls into. |
196
|
|
|
|
|
|
|
Returns "B<UNDEF>", "B<STRING>", "B<GLOB>", "B<REGEXP>", "B<REF>", or |
197
|
|
|
|
|
|
|
"B<BLESSED>" accordingly. |
198
|
|
|
|
|
|
|
|
199
|
|
|
|
|
|
|
=cut |
200
|
|
|
|
|
|
|
|
201
|
|
|
|
|
|
|
sub scalar_class($) { |
202
|
|
|
|
|
|
|
my $type = reftype(\$_[0]); |
203
|
4
|
|
|
106
|
1
|
23
|
if($type eq "SCALAR") { |
204
|
22
|
100
|
|
|
|
79
|
$type = defined($_[0]) ? "STRING" : "UNDEF"; |
|
|
100
|
|
|
|
|
|
205
|
106
|
100
|
|
|
|
561
|
} elsif($type eq "REF") { |
206
|
|
|
|
|
|
|
$type = "BLESSED" if defined(blessed($_[0])); |
207
|
42
|
100
|
|
|
|
22334
|
} |
208
|
|
|
|
|
|
|
$type; |
209
|
3264
|
|
|
|
|
18340
|
} |
210
|
|
|
|
|
|
|
|
211
|
|
|
|
|
|
|
=back |
212
|
|
|
|
|
|
|
|
213
|
|
|
|
|
|
|
=head2 The Undefined Value |
214
|
|
|
|
|
|
|
|
215
|
|
|
|
|
|
|
=over |
216
|
|
|
|
|
|
|
|
217
|
|
|
|
|
|
|
=item is_undef(ARG) |
218
|
|
|
|
|
|
|
|
219
|
|
|
|
|
|
|
=item check_undef(ARG) |
220
|
|
|
|
|
|
|
|
221
|
|
|
|
|
|
|
Check whether I<ARG> is C<undef>. C<is_undef(ARG)> is precisely |
222
|
|
|
|
|
|
|
equivalent to C<!defined(ARG)>, and is included for completeness. |
223
|
|
|
|
|
|
|
|
224
|
|
|
|
|
|
|
=cut |
225
|
|
|
|
|
|
|
|
226
|
|
|
|
|
|
|
sub is_undef($) { !defined($_[0]) } |
227
|
42
|
|
|
42
|
1
|
20281
|
|
228
|
|
|
|
|
|
|
sub check_undef($) { |
229
|
|
|
|
|
|
|
die "argument is not undefined\n" unless &is_undef; |
230
|
106
|
100
|
|
3264
|
1
|
697
|
} |
231
|
|
|
|
|
|
|
|
232
|
|
|
|
|
|
|
=back |
233
|
|
|
|
|
|
|
|
234
|
|
|
|
|
|
|
=head2 Strings |
235
|
|
|
|
|
|
|
|
236
|
|
|
|
|
|
|
=over |
237
|
|
|
|
|
|
|
|
238
|
|
|
|
|
|
|
=item is_string(ARG) |
239
|
|
|
|
|
|
|
|
240
|
|
|
|
|
|
|
=item check_string(ARG) |
241
|
|
|
|
|
|
|
|
242
|
|
|
|
|
|
|
Check whether I<ARG> is defined and is an ordinary scalar value (not a |
243
|
|
|
|
|
|
|
reference, typeglob, or regexp). This is what one usually thinks of as a |
244
|
|
|
|
|
|
|
string in Perl. In fact, any scalar (including C<undef> and references) |
245
|
|
|
|
|
|
|
can be coerced to a string, but if you're trying to classify a scalar |
246
|
|
|
|
|
|
|
then you don't want to do that. |
247
|
|
|
|
|
|
|
|
248
|
|
|
|
|
|
|
=cut |
249
|
|
|
|
|
|
|
|
250
|
|
|
|
|
|
|
sub is_string($) { defined($_[0]) && reftype(\$_[0]) eq "SCALAR" } |
251
|
42
|
100
|
|
42
|
1
|
20306
|
|
252
|
|
|
|
|
|
|
sub check_string($) { |
253
|
|
|
|
|
|
|
die "argument is not a string\n" unless &is_string; |
254
|
106
|
100
|
|
106
|
1
|
673
|
} |
255
|
|
|
|
|
|
|
|
256
|
|
|
|
|
|
|
=item is_number(ARG) |
257
|
|
|
|
|
|
|
|
258
|
|
|
|
|
|
|
=item check_number(ARG) |
259
|
|
|
|
|
|
|
|
260
|
|
|
|
|
|
|
Check whether I<ARG> is defined and an ordinary scalar (i.e., |
261
|
|
|
|
|
|
|
satisfies L</is_string> above) and is an acceptable number to Perl. |
262
|
|
|
|
|
|
|
This is what one usually thinks of as a number. |
263
|
|
|
|
|
|
|
|
264
|
|
|
|
|
|
|
Note that simple (L</is_string>-satisfying) scalars may have independent |
265
|
|
|
|
|
|
|
numeric and string values, despite the usual pretence that they have |
266
|
|
|
|
|
|
|
only one value. Such a scalar is deemed to be a number if I<either> it |
267
|
|
|
|
|
|
|
already has a numeric value (e.g., was generated by a numeric literal |
268
|
|
|
|
|
|
|
or an arithmetic computation) I<or> its string value has acceptable |
269
|
|
|
|
|
|
|
syntax for a number (so it can be converted). Where a scalar has |
270
|
|
|
|
|
|
|
separate numeric and string values (see L<Scalar::Util/dualvar>), it is |
271
|
|
|
|
|
|
|
possible for it to have an acceptable numeric value while its string |
272
|
|
|
|
|
|
|
value does I<not> have acceptable numeric syntax. Be careful to use |
273
|
|
|
|
|
|
|
such a value only in a numeric context, if you are using it as a number. |
274
|
|
|
|
|
|
|
L<Scalar::Number/scalar_num_part> extracts the numeric part of a |
275
|
|
|
|
|
|
|
scalar as an ordinary number. (C<0+ARG> suffices for that unless you |
276
|
|
|
|
|
|
|
need to preserve floating point signed zeroes.) |
277
|
|
|
|
|
|
|
|
278
|
|
|
|
|
|
|
A number may be either a native integer or a native floating point |
279
|
|
|
|
|
|
|
value, and there are several subtypes of floating point value. |
280
|
|
|
|
|
|
|
For classification, and other handling of numbers in scalars, see |
281
|
|
|
|
|
|
|
L<Scalar::Number>. For details of the two numeric data types, see |
282
|
|
|
|
|
|
|
L<Data::Integer> and L<Data::Float>. |
283
|
|
|
|
|
|
|
|
284
|
|
|
|
|
|
|
This function differs from C<looks_like_number> (see |
285
|
|
|
|
|
|
|
L<Scalar::Util/looks_like_number>; also L<perlapi/looks_like_number> |
286
|
|
|
|
|
|
|
for a lower-level description) in excluding C<undef>, typeglobs, |
287
|
|
|
|
|
|
|
and references. Why C<looks_like_number> returns true for C<undef> |
288
|
|
|
|
|
|
|
or typeglobs is anybody's guess. References, if treated as numbers, |
289
|
|
|
|
|
|
|
evaluate to the address in memory that they reference; this is useful |
290
|
|
|
|
|
|
|
for comparing references for equality, but it is not otherwise useful |
291
|
|
|
|
|
|
|
to treat references as numbers. Blessed references may have overloaded |
292
|
|
|
|
|
|
|
numeric operators, but if so then they don't necessarily behave like |
293
|
|
|
|
|
|
|
ordinary numbers. C<looks_like_number> is also confused by dualvars: |
294
|
|
|
|
|
|
|
it looks at the string portion of the scalar. |
295
|
|
|
|
|
|
|
|
296
|
|
|
|
|
|
|
=back |
297
|
|
|
|
|
|
|
|
298
|
|
|
|
|
|
|
=head2 Typeglobs |
299
|
|
|
|
|
|
|
|
300
|
|
|
|
|
|
|
=over |
301
|
|
|
|
|
|
|
|
302
|
|
|
|
|
|
|
=item is_glob(ARG) |
303
|
|
|
|
|
|
|
|
304
|
|
|
|
|
|
|
=item check_glob(ARG) |
305
|
|
|
|
|
|
|
|
306
|
|
|
|
|
|
|
Check whether I<ARG> is a typeglob. |
307
|
|
|
|
|
|
|
|
308
|
|
|
|
|
|
|
=cut |
309
|
|
|
|
|
|
|
|
310
|
|
|
|
|
|
|
sub is_glob($) { reftype(\$_[0]) eq "GLOB" } |
311
|
42
|
|
|
42
|
1
|
18758
|
|
312
|
|
|
|
|
|
|
sub check_glob($) { |
313
|
|
|
|
|
|
|
die "argument is not a typeglob\n" unless &is_glob; |
314
|
24
|
100
|
|
106
|
1
|
6938
|
} |
315
|
|
|
|
|
|
|
|
316
|
|
|
|
|
|
|
=back |
317
|
|
|
|
|
|
|
|
318
|
|
|
|
|
|
|
=head2 Regexps |
319
|
|
|
|
|
|
|
|
320
|
|
|
|
|
|
|
=over |
321
|
|
|
|
|
|
|
|
322
|
|
|
|
|
|
|
=item is_regexp(ARG) |
323
|
|
|
|
|
|
|
|
324
|
|
|
|
|
|
|
=item check_regexp(ARG) |
325
|
|
|
|
|
|
|
|
326
|
|
|
|
|
|
|
Check whether I<ARG> is a regexp object. |
327
|
|
|
|
|
|
|
|
328
|
|
|
|
|
|
|
=cut |
329
|
|
|
|
|
|
|
|
330
|
|
|
|
|
|
|
sub is_regexp($) { reftype(\$_[0]) eq "REGEXP" } |
331
|
24
|
|
|
42
|
1
|
136
|
|
332
|
|
|
|
|
|
|
sub check_regexp($) { |
333
|
|
|
|
|
|
|
die "argument is not a regexp\n" unless &is_regexp; |
334
|
14
|
100
|
|
24
|
1
|
32
|
} |
335
|
|
|
|
|
|
|
|
336
|
|
|
|
|
|
|
=back |
337
|
|
|
|
|
|
|
|
338
|
|
|
|
|
|
|
=head2 References to Unblessed Objects |
339
|
|
|
|
|
|
|
|
340
|
|
|
|
|
|
|
=over |
341
|
|
|
|
|
|
|
|
342
|
|
|
|
|
|
|
=item is_ref(ARG) |
343
|
|
|
|
|
|
|
|
344
|
|
|
|
|
|
|
=item check_ref(ARG) |
345
|
|
|
|
|
|
|
|
346
|
|
|
|
|
|
|
Check whether I<ARG> is a reference to an unblessed object. If it |
347
|
|
|
|
|
|
|
is, then the referenced data type can be determined using C<ref_type> |
348
|
|
|
|
|
|
|
(see below), which will return a string such as "HASH" or "SCALAR". |
349
|
|
|
|
|
|
|
|
350
|
|
|
|
|
|
|
=item ref_type(ARG) |
351
|
|
|
|
|
|
|
|
352
|
|
|
|
|
|
|
Returns C<undef> if I<ARG> is not a reference to an unblessed object. |
353
|
|
|
|
|
|
|
Otherwise, determines what type of object is referenced. Returns |
354
|
|
|
|
|
|
|
"B<SCALAR>", "B<ARRAY>", "B<HASH>", "B<CODE>", "B<FORMAT>", or "B<IO>" |
355
|
|
|
|
|
|
|
accordingly. |
356
|
|
|
|
|
|
|
|
357
|
|
|
|
|
|
|
Note that, unlike C<ref>, this does not distinguish between different |
358
|
|
|
|
|
|
|
types of referenced scalar. A reference to a string and a reference to |
359
|
|
|
|
|
|
|
a reference will both return "B<SCALAR>". Consequently, what C<ref_type> |
360
|
|
|
|
|
|
|
returns for a particular reference will not change due to changes in |
361
|
|
|
|
|
|
|
the value of the referent, except for the referent being blessed. |
362
|
|
|
|
|
|
|
|
363
|
|
|
|
|
|
|
=item is_ref(ARG, TYPE) |
364
|
|
|
|
|
|
|
|
365
|
|
|
|
|
|
|
=item check_ref(ARG, TYPE) |
366
|
|
|
|
|
|
|
|
367
|
|
|
|
|
|
|
Check whether I<ARG> is a reference to an unblessed object of type |
368
|
|
|
|
|
|
|
I<TYPE>, as determined by L</ref_type>. I<TYPE> must be a string. |
369
|
|
|
|
|
|
|
Possible I<TYPE>s are "B<SCALAR>", "B<ARRAY>", "B<HASH>", "B<CODE>", |
370
|
|
|
|
|
|
|
"B<FORMAT>", and "B<IO>". |
371
|
|
|
|
|
|
|
|
372
|
|
|
|
|
|
|
=cut |
373
|
|
|
|
|
|
|
|
374
|
|
|
|
|
|
|
{ |
375
|
|
|
|
|
|
|
my %xlate_reftype = ( |
376
|
|
|
|
|
|
|
REF => "SCALAR", |
377
|
|
|
|
|
|
|
SCALAR => "SCALAR", |
378
|
|
|
|
|
|
|
LVALUE => "SCALAR", |
379
|
|
|
|
|
|
|
GLOB => "SCALAR", |
380
|
|
|
|
|
|
|
REGEXP => "SCALAR", |
381
|
|
|
|
|
|
|
ARRAY => "ARRAY", |
382
|
|
|
|
|
|
|
HASH => "HASH", |
383
|
|
|
|
|
|
|
CODE => "CODE", |
384
|
|
|
|
|
|
|
FORMAT => "FORMAT", |
385
|
|
|
|
|
|
|
IO => "IO", |
386
|
|
|
|
|
|
|
); |
387
|
|
|
|
|
|
|
|
388
|
|
|
|
|
|
|
my %reftype_ok = map { ($_ => undef) } qw( |
389
|
|
|
|
|
|
|
SCALAR ARRAY HASH CODE FORMAT IO |
390
|
|
|
|
|
|
|
); |
391
|
|
|
|
|
|
|
|
392
|
|
|
|
|
|
|
sub ref_type($) { |
393
|
|
|
|
|
|
|
my $reftype = &reftype; |
394
|
14
|
|
|
1858
|
1
|
34
|
return undef unless |
395
|
|
|
|
|
|
|
defined($reftype) && !defined(blessed($_[0])); |
396
|
14
|
100
|
100
|
|
|
51
|
my $xlated_reftype = $xlate_reftype{$reftype}; |
397
|
1858
|
|
|
|
|
65500
|
die "unknown reftype `$reftype', please update Params::Classify" |
398
|
1728
|
50
|
|
|
|
3303
|
unless defined $xlated_reftype; |
399
|
|
|
|
|
|
|
$xlated_reftype; |
400
|
1656
|
|
|
|
|
4423
|
} |
401
|
|
|
|
|
|
|
|
402
|
|
|
|
|
|
|
sub is_ref($;$) { |
403
|
|
|
|
|
|
|
if(@_ == 2) { |
404
|
1738
|
100
|
|
606
|
1
|
3590
|
die "reference type argument is not a string\n" |
405
|
1738
|
100
|
|
|
|
6525
|
unless is_string($_[1]); |
406
|
|
|
|
|
|
|
die "invalid reference type\n" |
407
|
|
|
|
|
|
|
unless exists $reftype_ok{$_[1]}; |
408
|
812
|
100
|
|
|
|
1798
|
} |
409
|
|
|
|
|
|
|
my $reftype = reftype($_[0]); |
410
|
768
|
|
|
|
|
1313
|
return undef unless |
411
|
|
|
|
|
|
|
defined($reftype) && !defined(blessed($_[0])); |
412
|
768
|
100
|
100
|
|
|
1362
|
return 1 if @_ != 2; |
413
|
768
|
100
|
|
|
|
2163
|
my $xlated_reftype = $xlate_reftype{$reftype}; |
414
|
606
|
|
|
|
|
297693
|
die "unknown reftype `$reftype', please update Params::Classify" |
415
|
504
|
50
|
|
|
|
3100
|
unless defined $xlated_reftype; |
416
|
|
|
|
|
|
|
return $xlated_reftype eq $_[1]; |
417
|
626
|
|
|
|
|
48229
|
} |
418
|
|
|
|
|
|
|
} |
419
|
|
|
|
|
|
|
|
420
|
|
|
|
|
|
|
sub check_ref($;$) { |
421
|
|
|
|
|
|
|
unless(&is_ref) { |
422
|
554
|
100
|
|
626
|
1
|
2755
|
die "argument is not a reference to plain ". |
423
|
246
|
100
|
|
|
|
80624
|
(@_ == 2 ? lc($_[1]) : "object")."\n"; |
424
|
|
|
|
|
|
|
} |
425
|
|
|
|
|
|
|
} |
426
|
|
|
|
|
|
|
|
427
|
|
|
|
|
|
|
=back |
428
|
|
|
|
|
|
|
|
429
|
|
|
|
|
|
|
=head2 References to Blessed Objects |
430
|
|
|
|
|
|
|
|
431
|
|
|
|
|
|
|
=over |
432
|
|
|
|
|
|
|
|
433
|
|
|
|
|
|
|
=item is_blessed(ARG) |
434
|
|
|
|
|
|
|
|
435
|
|
|
|
|
|
|
=item check_blessed(ARG) |
436
|
|
|
|
|
|
|
|
437
|
|
|
|
|
|
|
Check whether I<ARG> is a reference to a blessed object. If it is, |
438
|
|
|
|
|
|
|
then the class into which the object was blessed can be determined using |
439
|
|
|
|
|
|
|
L</blessed_class>. |
440
|
|
|
|
|
|
|
|
441
|
|
|
|
|
|
|
=item is_blessed(ARG, CLASS) |
442
|
|
|
|
|
|
|
|
443
|
|
|
|
|
|
|
=item check_blessed(ARG, CLASS) |
444
|
|
|
|
|
|
|
|
445
|
|
|
|
|
|
|
Check whether I<ARG> is a reference to a blessed object that claims to |
446
|
|
|
|
|
|
|
be an instance of I<CLASS> (via its C<isa> method; see L<perlobj/isa>). |
447
|
|
|
|
|
|
|
I<CLASS> must be a string, naming a Perl class. |
448
|
|
|
|
|
|
|
|
449
|
|
|
|
|
|
|
=cut |
450
|
|
|
|
|
|
|
|
451
|
|
|
|
|
|
|
sub is_blessed($;$) { |
452
|
|
|
|
|
|
|
die "class argument is not a string\n" |
453
|
174
|
100
|
100
|
246
|
1
|
1081
|
if @_ == 2 && !is_string($_[1]); |
454
|
|
|
|
|
|
|
return defined(blessed($_[0])) && (@_ != 2 || $_[0]->isa($_[1])); |
455
|
320
|
|
66
|
|
|
17574
|
} |
456
|
|
|
|
|
|
|
|
457
|
|
|
|
|
|
|
sub check_blessed($;$) { |
458
|
|
|
|
|
|
|
unless(&is_blessed) { |
459
|
304
|
100
|
|
320
|
1
|
597
|
die "argument is not a reference to blessed ". |
460
|
232
|
100
|
|
|
|
627
|
(@_ == 2 ? $_[1] : "object")."\n"; |
461
|
|
|
|
|
|
|
} |
462
|
|
|
|
|
|
|
} |
463
|
|
|
|
|
|
|
|
464
|
|
|
|
|
|
|
=item blessed_class(ARG) |
465
|
|
|
|
|
|
|
|
466
|
|
|
|
|
|
|
Returns C<undef> if I<ARG> is not a reference to a blessed object. |
467
|
|
|
|
|
|
|
Otherwise, returns the class into which the object is blessed. |
468
|
|
|
|
|
|
|
|
469
|
|
|
|
|
|
|
C<ref> (see L<perlfunc/ref>) gives the same result on references |
470
|
|
|
|
|
|
|
to blessed objects, but different results on other types of value. |
471
|
|
|
|
|
|
|
C<blessed_class> is actually identical to L<Scalar::Util/blessed>. |
472
|
|
|
|
|
|
|
|
473
|
|
|
|
|
|
|
=cut |
474
|
|
|
|
|
|
|
|
475
|
|
|
|
|
|
|
*blessed_class = \&blessed; |
476
|
|
|
|
|
|
|
|
477
|
|
|
|
|
|
|
=item is_strictly_blessed(ARG) |
478
|
|
|
|
|
|
|
|
479
|
|
|
|
|
|
|
=item check_strictly_blessed(ARG) |
480
|
|
|
|
|
|
|
|
481
|
|
|
|
|
|
|
Check whether I<ARG> is a reference to a blessed object, identically |
482
|
|
|
|
|
|
|
to L</is_blessed>. This exists only for symmetry; the useful form of |
483
|
|
|
|
|
|
|
C<is_strictly_blessed> appears below. |
484
|
|
|
|
|
|
|
|
485
|
|
|
|
|
|
|
=item is_strictly_blessed(ARG, CLASS) |
486
|
|
|
|
|
|
|
|
487
|
|
|
|
|
|
|
=item check_strictly_blessed(ARG, CLASS) |
488
|
|
|
|
|
|
|
|
489
|
|
|
|
|
|
|
Check whether I<ARG> is a reference to an object blessed into I<CLASS> |
490
|
|
|
|
|
|
|
exactly. I<CLASS> must be a string, naming a Perl class. Because this |
491
|
|
|
|
|
|
|
excludes subclasses, this is rarely what one wants, but there are some |
492
|
|
|
|
|
|
|
specialised occasions where it is useful. |
493
|
|
|
|
|
|
|
|
494
|
|
|
|
|
|
|
=cut |
495
|
|
|
|
|
|
|
|
496
|
|
|
|
|
|
|
sub is_strictly_blessed($;$) { |
497
|
|
|
|
|
|
|
return &is_blessed unless @_ == 2; |
498
|
232
|
100
|
|
162
|
1
|
853
|
die "class argument is not a string\n" unless is_string($_[1]); |
499
|
162
|
100
|
|
|
|
78311
|
my $blessed = blessed($_[0]); |
500
|
120
|
|
|
|
|
279
|
return defined($blessed) && $blessed eq $_[1]; |
501
|
80
|
|
100
|
|
|
437
|
} |
502
|
|
|
|
|
|
|
|
503
|
|
|
|
|
|
|
sub check_strictly_blessed($;$) { |
504
|
|
|
|
|
|
|
return &check_blessed unless @_ == 2; |
505
|
476
|
100
|
|
476
|
1
|
786
|
unless(&is_strictly_blessed) { |
506
|
312
|
100
|
|
|
|
812
|
die "argument is not a reference to strictly blessed $_[1]\n"; |
507
|
240
|
|
|
|
|
403
|
} |
508
|
|
|
|
|
|
|
} |
509
|
|
|
|
|
|
|
|
510
|
|
|
|
|
|
|
=item is_able(ARG) |
511
|
|
|
|
|
|
|
|
512
|
|
|
|
|
|
|
=item check_able(ARG) |
513
|
|
|
|
|
|
|
|
514
|
|
|
|
|
|
|
Check whether I<ARG> is a reference to a blessed object, identically |
515
|
|
|
|
|
|
|
to L</is_blessed>. This exists only for symmetry; the useful form of |
516
|
|
|
|
|
|
|
C<is_able> appears below. |
517
|
|
|
|
|
|
|
|
518
|
|
|
|
|
|
|
=item is_able(ARG, METHODS) |
519
|
|
|
|
|
|
|
|
520
|
|
|
|
|
|
|
=item check_able(ARG, METHODS) |
521
|
|
|
|
|
|
|
|
522
|
|
|
|
|
|
|
Check whether I<ARG> is a reference to a blessed object that claims to |
523
|
|
|
|
|
|
|
implement the methods specified by I<METHODS> (via its C<can> method; |
524
|
|
|
|
|
|
|
see L<perlobj/can>). I<METHODS> must be either a single method name or |
525
|
|
|
|
|
|
|
a reference to an array of method names. Each method name is a string. |
526
|
|
|
|
|
|
|
This interface check is often more appropriate than a direct ancestry |
527
|
|
|
|
|
|
|
check (such as L</is_blessed> performs). |
528
|
|
|
|
|
|
|
|
529
|
|
|
|
|
|
|
=cut |
530
|
|
|
|
|
|
|
|
531
|
|
|
|
|
|
|
sub _check_methods_arg($) { |
532
|
|
|
|
|
|
|
return if &is_string; |
533
|
240
|
100
|
|
336
|
|
540
|
die "methods argument is not a string or array\n" |
534
|
240
|
100
|
|
|
|
407
|
unless is_ref($_[0], "ARRAY"); |
535
|
|
|
|
|
|
|
foreach(@{$_[0]}) { |
536
|
336
|
|
|
|
|
59364
|
die "method name is not a string\n" unless is_string($_); |
|
278
|
|
|
|
|
703
|
|
537
|
206
|
100
|
|
|
|
770
|
} |
538
|
|
|
|
|
|
|
} |
539
|
|
|
|
|
|
|
|
540
|
|
|
|
|
|
|
sub is_able($;$) { |
541
|
|
|
|
|
|
|
return &is_blessed unless @_ == 2; |
542
|
60
|
100
|
|
240
|
1
|
177
|
_check_methods_arg($_[1]); |
543
|
20
|
|
|
|
|
45
|
return 0 unless defined blessed $_[0]; |
544
|
54
|
100
|
|
|
|
287
|
foreach my $method (ref($_[1]) eq "" ? $_[1] : @{$_[1]}) { |
545
|
34
|
100
|
|
|
|
92
|
return 0 unless $_[0]->can($method); |
|
240
|
|
|
|
|
112119
|
|
546
|
198
|
100
|
|
|
|
584
|
} |
547
|
|
|
|
|
|
|
return 1; |
548
|
126
|
|
|
|
|
425
|
} |
549
|
|
|
|
|
|
|
|
550
|
|
|
|
|
|
|
sub check_able($;$) { |
551
|
|
|
|
|
|
|
return &check_blessed unless @_ == 2; |
552
|
96
|
100
|
|
|
1
|
276
|
_check_methods_arg($_[1]); |
553
|
64
|
|
|
|
|
202
|
unless(defined blessed $_[0]) { |
554
|
96
|
100
|
|
|
|
525
|
my $desc = ref($_[1]) eq "" ? |
555
|
|
|
|
|
|
|
"method \"$_[1]\"" |
556
|
|
|
|
|
|
|
: @{$_[1]} == 0 ? |
557
|
30
|
100
|
|
|
|
91
|
"at all" |
|
20
|
100
|
|
|
|
58
|
|
558
|
|
|
|
|
|
|
: |
559
|
|
|
|
|
|
|
"method \"".$_[1]->[0]."\""; |
560
|
|
|
|
|
|
|
die "argument is not able to perform $desc\n"; |
561
|
24
|
|
|
|
|
189
|
} |
562
|
|
|
|
|
|
|
foreach my $method (ref($_[1]) eq "" ? $_[1] : @{$_[1]}) { |
563
|
|
100
|
|
|
|
|
die "argument is not able to perform method \"$method\"\n" |
564
|
|
100
|
|
|
|
|
unless $_[0]->can($method); |
565
|
|
|
|
|
|
|
} |
566
|
|
|
|
|
|
|
} |
567
|
|
|
|
|
|
|
|
568
|
|
|
|
|
|
|
=back |
569
|
|
|
|
|
|
|
|
570
|
|
|
|
|
|
|
=head1 BUGS |
571
|
|
|
|
|
|
|
|
572
|
|
|
|
|
|
|
Probably ought to handle something like L<Params::Validate>'s scalar |
573
|
|
|
|
|
|
|
type specification system, which makes much the same distinctions. |
574
|
|
|
|
|
|
|
|
575
|
|
|
|
|
|
|
=head1 SEE ALSO |
576
|
|
|
|
|
|
|
|
577
|
|
|
|
|
|
|
L<Data::Float>, |
578
|
|
|
|
|
|
|
L<Data::Integer>, |
579
|
|
|
|
|
|
|
L<Params::Validate>, |
580
|
|
|
|
|
|
|
L<Scalar::Number>, |
581
|
|
|
|
|
|
|
L<Scalar::Util> |
582
|
|
|
|
|
|
|
|
583
|
|
|
|
|
|
|
=head1 AUTHOR |
584
|
|
|
|
|
|
|
|
585
|
|
|
|
|
|
|
Andrew Main (Zefram) <zefram@fysh.org> |
586
|
|
|
|
|
|
|
|
587
|
|
|
|
|
|
|
=head1 COPYRIGHT |
588
|
|
|
|
|
|
|
|
589
|
|
|
|
|
|
|
Copyright (C) 2004, 2006, 2007, 2009, 2010, 2017 |
590
|
|
|
|
|
|
|
Andrew Main (Zefram) <zefram@fysh.org> |
591
|
|
|
|
|
|
|
|
592
|
|
|
|
|
|
|
Copyright (C) 2009, 2010 PhotoBox Ltd |
593
|
|
|
|
|
|
|
|
594
|
|
|
|
|
|
|
=head1 LICENSE |
595
|
|
|
|
|
|
|
|
596
|
|
|
|
|
|
|
This module is free software; you can redistribute it and/or modify it |
597
|
|
|
|
|
|
|
under the same terms as Perl itself. |
598
|
|
|
|
|
|
|
|
599
|
|
|
|
|
|
|
=cut |
600
|
|
|
|
|
|
|
|
601
|
|
|
|
|
|
|
1; |