Profile of /usr/local/lib/perl5/site_perl/5.10.1/darwin-2level/Params/Util.pm

← Index
NYTProf Performance Profile «block view•line view•sub view»
For 01.HTTP.t
Run on Tue May 4 15:25:55 2010
Reported on Tue May 4 15:26:05 2010

File | /usr/local/lib/perl5/site_perl/5.10.1/darwin-2level/Params/Util.pm
Statements Executed | 47
Statement Execution Time | 2.27ms

Subroutines — ordered by exclusive time
Calls | P | F | Exclusive Time | Inclusive Time | Subroutine
--- | --- | --- | --- | --- | ---
1 | 1 | 1 | 78µs | 78µs | Params::Util::::BEGIN@58Params::Util::BEGIN@58
1 | 1 | 2 | 51µs | 51µs | Params::Util::::bootstrapParams::Util::bootstrap (xsub)
69 | 4 | 3 | 46µs | 46µs | Params::Util::::_CODELIKEParams::Util::_CODELIKE (xsub)
1 | 1 | 1 | 23µs | 31µs | Params::Util::::BEGIN@59Params::Util::BEGIN@59
1 | 1 | 1 | 14µs | 134µs | Params::Util::::BEGIN@65Params::Util::BEGIN@65
5 | 1 | 2 | 8µs | 8µs | Params::Util::::_HASHLIKEParams::Util::_HASHLIKE (xsub)
8 | 2 | 2 | 8µs | 8µs | Params::Util::::_SCALAR0Params::Util::_SCALAR0 (xsub)
5 | 1 | 2 | 6µs | 6µs | Params::Util::::_ARRAYLIKEParams::Util::_ARRAYLIKE (xsub)

Call graph for these subroutines as a Graphviz dot language file.

Line | State ments | Time on line | Calls | Time in subs | Code
--- | --- | --- | --- | --- | ---
1 |  |  |  |  | package Params::Util;
2 |  |  |  |  |
3 |  |  |  |  | =pod
4 |  |  |  |  |
5 |  |  |  |  | =head1 NAME
6 |  |  |  |  |
7 |  |  |  |  | Params::Util - Simple, compact and correct param-checking functions
8 |  |  |  |  |
9 |  |  |  |  | =head1 SYNOPSIS
10 |  |  |  |  |
11 |  |  |  |  | # Import some functions
12 |  |  |  |  | use Params::Util qw{_SCALAR _HASH _INSTANCE};
13 |  |  |  |  |
14 |  |  |  |  | # If you are lazy, or need a lot of them...
15 |  |  |  |  | use Params::Util ':ALL';
16 |  |  |  |  |
17 |  |  |  |  | sub foo {
18 |  |  |  |  | my $object = _INSTANCE(shift, 'Foo') or return undef;
19 |  |  |  |  | my $image = _SCALAR(shift) or return undef;
20 |  |  |  |  | my $options = _HASH(shift) or return undef;
21 |  |  |  |  | # etc...
22 |  |  |  |  | }
23 |  |  |  |  |
24 |  |  |  |  | =head1 DESCRIPTION
25 |  |  |  |  |
26 |  |  |  |  | C<Params::Util> provides a basic set of importable functions that makes
27 |  |  |  |  | checking parameters a hell of a lot easier
28 |  |  |  |  |
29 |  |  |  |  | While they can be (and are) used in other contexts, the main point
30 |  |  |  |  | behind this module is that the functions B<both> Do What You Mean,
31 |  |  |  |  | and Do The Right Thing, so they are most useful when you are getting
32 |  |  |  |  | params passed into your code from someone and/or somewhere else
33 |  |  |  |  | and you can't really trust the quality.
34 |  |  |  |  |
35 |  |  |  |  | Thus, C<Params::Util> is of most use at the edges of your API, where
36 |  |  |  |  | params and data are coming in from outside your code.
37 |  |  |  |  |
38 |  |  |  |  | The functions provided by C<Params::Util> check in the most strictly
39 |  |  |  |  | correct manner known, are documented as thoroughly as possible so their
40 |  |  |  |  | exact behaviour is clear, and heavily tested so make sure they are not
41 |  |  |  |  | fooled by weird data and Really Bad Things.
42 |  |  |  |  |
43 |  |  |  |  | To use, simply load the module providing the functions you want to use
44 |  |  |  |  | as arguments (as shown in the SYNOPSIS).
45 |  |  |  |  |
46 |  |  |  |  | To aid in maintainability, C<Params::Util> will B<never> export by
47 |  |  |  |  | default.
48 |  |  |  |  |
49 |  |  |  |  | You must explicitly name the functions you want to export, or use the
50 |  |  |  |  | C<:ALL> param to just have it export everything (although this is not
51 |  |  |  |  | recommended if you have any _FOO functions yourself with which future
52 |  |  |  |  | additions to C<Params::Util> may clash)
53 |  |  |  |  |
54 |  |  |  |  | =head1 FUNCTIONS
55 |  |  |  |  |
56 |  |  |  |  | =cut
57 |  |  |  |  |
58 | 3 | 119µs | 1 | 78µs | # spent 78µs within Params::Util::BEGIN@58 which was called # once (78µs+0s) by Data::OptList::BEGIN@7 at line 58 use 5.00503; # spent 78µs making 1 call to Params::Util::BEGIN@58
59 | 3 | 84µs | 2 | 40µs | # spent 31µs (23+9) within Params::Util::BEGIN@59 which was called # once (23µs+9µs) by Data::OptList::BEGIN@7 at line 59 use strict; # spent 31µs making 1 call to Params::Util::BEGIN@59 # spent 9µs making 1 call to strict::import
60 | 1 | 1µs |  |  | require overload;
61 | 1 | 500ns |  |  | require Exporter;
62 | 1 | 800ns |  |  | require Scalar::Util;
63 | 1 | 600ns |  |  | require DynaLoader;
64 |  |  |  |  |
65 | 3 | 894µs | 2 | 254µs | # spent 134µs (14+120) within Params::Util::BEGIN@65 which was called # once (14µs+120µs) by Data::OptList::BEGIN@7 at line 65 use vars qw{$VERSION @ISA @EXPORT_OK %EXPORT_TAGS}; # spent 134µs making 1 call to Params::Util::BEGIN@65 # spent 120µs making 1 call to vars::import
66 |  |  |  |  |
67 | 1 | 1µs |  |  | $VERSION = '1.00';
68 | 1 | 26µs |  |  | @ISA = qw{
69 |  |  |  |  | Exporter
70 |  |  |  |  | DynaLoader
71 |  |  |  |  | };
72 | 1 | 12µs |  |  | @EXPORT_OK = qw{
73 |  |  |  |  | _STRING _IDENTIFIER
74 |  |  |  |  | _CLASS _CLASSISA _SUBCLASS _DRIVER
75 |  |  |  |  | _NUMBER _POSINT _NONNEGINT
76 |  |  |  |  | _SCALAR _SCALAR0
77 |  |  |  |  | _ARRAY _ARRAY0 _ARRAYLIKE
78 |  |  |  |  | _HASH _HASH0 _HASHLIKE
79 |  |  |  |  | _CODE _CODELIKE
80 |  |  |  |  | _INVOCANT _REGEX _INSTANCE
81 |  |  |  |  | _SET _SET0
82 |  |  |  |  | _HANDLE
83 |  |  |  |  | };
84 | 1 | 3µs |  |  | %EXPORT_TAGS = ( ALL => \@EXPORT_OK );
85 |  |  |  |  |
86 | 1 | 2µs |  |  | eval {
87 | 1 | 700ns |  |  | local $ENV{PERL_DL_NONLAZY} = 0 if $ENV{PERL_DL_NONLAZY};
88 | 1 | 12µs | 1 | 497µs | bootstrap Params::Util $VERSION; # spent 497µs making 1 call to DynaLoader::bootstrap
89 | 1 | 800ns |  |  | 1;
90 |  |  |  |  | } unless $ENV{PERL_PARAMS_UTIL_PP};
91 |  |  |  |  |
92 |  |  |  |  |
93 |  |  |  |  |
94 |  |  |  |  |
95 |  |  |  |  |
96 |  |  |  |  | #####################################################################
97 |  |  |  |  | # Param Checking Functions
98 |  |  |  |  |
99 |  |  |  |  | =pod
100 |  |  |  |  |
101 |  |  |  |  | =head2 _STRING $string
102 |  |  |  |  |
103 |  |  |  |  | The C<_STRING> function is intended to be imported into your
104 |  |  |  |  | package, and provides a convenient way to test to see if a value is
105 |  |  |  |  | a normal non-false string of non-zero length.
106 |  |  |  |  |
107 |  |  |  |  | Note that this will NOT do anything magic to deal with the special
108 |  |  |  |  | C<'0'> false negative case, but will return it.
109 |  |  |  |  |
110 |  |  |  |  | # '0' not considered valid data
111 |  |  |  |  | my $name = _STRING(shift) or die "Bad name";
112 |  |  |  |  |
113 |  |  |  |  | # '0' is considered valid data
114 |  |  |  |  | my $string = _STRING($_[0]) ? shift : die "Bad string";
115 |  |  |  |  |
116 |  |  |  |  | Please also note that this function expects a normal string. It does
117 |  |  |  |  | not support overloading or other magic techniques to get a string.
118 |  |  |  |  |
119 |  |  |  |  | Returns the string as a conveince if it is a valid string, or
120 |  |  |  |  | C<undef> if not.
121 |  |  |  |  |
122 |  |  |  |  | =cut
123 |  |  |  |  |
124 | 1 | 600ns |  |  | eval <<'END_PERL' unless defined &_STRING;
125 |  |  |  |  | sub _STRING ($) {
126 |  |  |  |  | (defined $_[0] and ! ref $_[0] and length($_[0])) ? $_[0] : undef;
127 |  |  |  |  | }
128 |  |  |  |  | END_PERL
129 |  |  |  |  |
130 |  |  |  |  | =pod
131 |  |  |  |  |
132 |  |  |  |  | =head2 _IDENTIFIER $string
133 |  |  |  |  |
134 |  |  |  |  | The C<_IDENTIFIER> function is intended to be imported into your
135 |  |  |  |  | package, and provides a convenient way to test to see if a value is
136 |  |  |  |  | a string that is a valid Perl identifier.
137 |  |  |  |  |
138 |  |  |  |  | Returns the string as a convenience if it is a valid identifier, or
139 |  |  |  |  | C<undef> if not.
140 |  |  |  |  |
141 |  |  |  |  | =cut
142 |  |  |  |  |
143 | 1 | 119µs |  |  | eval <<'END_PERL' unless defined &_IDENTIFIER;
144 |  |  |  |  | sub _IDENTIFIER ($) {
145 |  |  |  |  | (defined $_[0] and ! ref $_[0] and $_[0] =~ m/^[^\W\d]\w*\z/s) ? $_[0] : undef;
146 |  |  |  |  | }
147 |  |  |  |  | END_PERL
148 |  |  |  |  |
149 |  |  |  |  | =pod
150 |  |  |  |  |
151 |  |  |  |  | =head2 _CLASS $string
152 |  |  |  |  |
153 |  |  |  |  | The C<_CLASS> function is intended to be imported into your
154 |  |  |  |  | package, and provides a convenient way to test to see if a value is
155 |  |  |  |  | a string that is a valid Perl class.
156 |  |  |  |  |
157 |  |  |  |  | This function only checks that the format is valid, not that the
158 |  |  |  |  | class is actually loaded. It also assumes "normalised" form, and does
159 |  |  |  |  | not accept class names such as C<::Foo> or C<D'Oh>.
160 |  |  |  |  |
161 |  |  |  |  | Returns the string as a convenience if it is a valid class name, or
162 |  |  |  |  | C<undef> if not.
163 |  |  |  |  |
164 |  |  |  |  | =cut
165 |  |  |  |  |
166 | 1 | 75µs |  |  | eval <<'END_PERL' unless defined &_CLASS;
167 |  |  |  |  | sub _CLASS ($) {
168 |  |  |  |  | (defined $_[0] and ! ref $_[0] and $_[0] =~ m/^[^\W\d]\w*(?:::\w+)*\z/s) ? $_[0] : undef;
169 |  |  |  |  | }
170 |  |  |  |  | END_PERL
171 |  |  |  |  |
172 |  |  |  |  | =pod
173 |  |  |  |  |
174 |  |  |  |  | =head2 _CLASSISA $string, $class
175 |  |  |  |  |
176 |  |  |  |  | The C<_CLASSISA> function is intended to be imported into your
177 |  |  |  |  | package, and provides a convenient way to test to see if a value is
178 |  |  |  |  | a string that is a particularly class, or a subclass of it.
179 |  |  |  |  |
180 |  |  |  |  | This function checks that the format is valid and calls the -E<gt>isa
181 |  |  |  |  | method on the class name. It does not check that the class is actually
182 |  |  |  |  | loaded.
183 |  |  |  |  |
184 |  |  |  |  | It also assumes "normalised" form, and does
185 |  |  |  |  | not accept class names such as C<::Foo> or C<D'Oh>.
186 |  |  |  |  |
187 |  |  |  |  | Returns the string as a convenience if it is a valid class name, or
188 |  |  |  |  | C<undef> if not.
189 |  |  |  |  |
190 |  |  |  |  | =cut
191 |  |  |  |  |
192 | 1 | 108µs |  |  | eval <<'END_PERL' unless defined &_CLASSISA;
193 |  |  |  |  | sub _CLASSISA ($$) {
194 |  |  |  |  | (defined $_[0] and ! ref $_[0] and $_[0] =~ m/^[^\W\d]\w*(?:::\w+)*\z/s and $_[0]->isa($_[1])) ? $_[0] : undef;
195 |  |  |  |  | }
196 |  |  |  |  | END_PERL
197 |  |  |  |  |
198 |  |  |  |  | =pod
199 |  |  |  |  |
200 |  |  |  |  | =head2 _SUBCLASS $string, $class
201 |  |  |  |  |
202 |  |  |  |  | The C<_SUBCLASS> function is intended to be imported into your
203 |  |  |  |  | package, and provides a convenient way to test to see if a value is
204 |  |  |  |  | a string that is a subclass of a specified class.
205 |  |  |  |  |
206 |  |  |  |  | This function checks that the format is valid and calls the -E<gt>isa
207 |  |  |  |  | method on the class name. It does not check that the class is actually
208 |  |  |  |  | loaded.
209 |  |  |  |  |
210 |  |  |  |  | It also assumes "normalised" form, and does
211 |  |  |  |  | not accept class names such as C<::Foo> or C<D'Oh>.
212 |  |  |  |  |
213 |  |  |  |  | Returns the string as a convenience if it is a valid class name, or
214 |  |  |  |  | C<undef> if not.
215 |  |  |  |  |
216 |  |  |  |  | =cut
217 |  |  |  |  |
218 | 1 | 98µs |  |  | eval <<'END_PERL' unless defined &_SUBCLASS;
219 |  |  |  |  | sub _SUBCLASS ($$) {
220 |  |  |  |  | (defined $_[0] and ! ref $_[0] and $_[0] =~ m/^[^\W\d]\w*(?:::\w+)*\z/s and $_[0] ne $_[1] and $_[0]->isa($_[1])) ? $_[0] : undef;
221 |  |  |  |  | }
222 |  |  |  |  | END_PERL
223 |  |  |  |  |
224 |  |  |  |  | =pod
225 |  |  |  |  |
226 |  |  |  |  | =head2 _NUMBER $scalar
227 |  |  |  |  |
228 |  |  |  |  | The C<_NUMBER> function is intended to be imported into your
229 |  |  |  |  | package, and provides a convenient way to test to see if a value is
230 |  |  |  |  | a number. That is, it is defined and perl thinks it's a number.
231 |  |  |  |  |
232 |  |  |  |  | This function is basically a Params::Util-style wrapper around the
233 |  |  |  |  | L<Scalar::Util> C<looks_like_number> function.
234 |  |  |  |  |
235 |  |  |  |  | Returns the value as a convience, or C<undef> if the value is not a
236 |  |  |  |  | number.
237 |  |  |  |  |
238 |  |  |  |  | =cut
239 |  |  |  |  |
240 | 1 | 500ns |  |  | eval <<'END_PERL' unless defined &_NUMBER;
241 |  |  |  |  | sub _NUMBER ($) {
242 |  |  |  |  | ( defined $_[0] and ! ref $_[0] and Scalar::Util::looks_like_number($_[0]) )
243 |  |  |  |  | ? $_[0]
244 |  |  |  |  | : undef;
245 |  |  |  |  | }
246 |  |  |  |  | END_PERL
247 |  |  |  |  |
248 |  |  |  |  | =pod
249 |  |  |  |  |
250 |  |  |  |  | =head2 _POSINT $integer
251 |  |  |  |  |
252 |  |  |  |  | The C<_POSINT> function is intended to be imported into your
253 |  |  |  |  | package, and provides a convenient way to test to see if a value is
254 |  |  |  |  | a positive integer (of any length).
255 |  |  |  |  |
256 |  |  |  |  | Returns the value as a convience, or C<undef> if the value is not a
257 |  |  |  |  | positive integer.
258 |  |  |  |  |
259 |  |  |  |  | The name itself is derived from the XML schema constraint of the same
260 |  |  |  |  | name.
261 |  |  |  |  |
262 |  |  |  |  | =cut
263 |  |  |  |  |
264 | 1 | 82µs |  |  | eval <<'END_PERL' unless defined &_POSINT;
265 |  |  |  |  | sub _POSINT ($) {
266 |  |  |  |  | (defined $_[0] and ! ref $_[0] and $_[0] =~ m/^[1-9]\d*$/) ? $_[0] : undef;
267 |  |  |  |  | }
268 |  |  |  |  | END_PERL
269 |  |  |  |  |
270 |  |  |  |  | =pod
271 |  |  |  |  |
272 |  |  |  |  | =head2 _NONNEGINT $integer
273 |  |  |  |  |
274 |  |  |  |  | The C<_NONNEGINT> function is intended to be imported into your
275 |  |  |  |  | package, and provides a convenient way to test to see if a value is
276 |  |  |  |  | a non-negative integer (of any length). That is, a positive integer,
277 |  |  |  |  | or zero.
278 |  |  |  |  |
279 |  |  |  |  | Returns the value as a convience, or C<undef> if the value is not a
280 |  |  |  |  | non-negative integer.
281 |  |  |  |  |
282 |  |  |  |  | As with other tests that may return false values, care should be taken
283 |  |  |  |  | to test via "defined" in boolean validy contexts.
284 |  |  |  |  |
285 |  |  |  |  | unless ( defined _NONNEGINT($value) ) {
286 |  |  |  |  | die "Invalid value";
287 |  |  |  |  | }
288 |  |  |  |  |
289 |  |  |  |  | The name itself is derived from the XML schema constraint of the same
290 |  |  |  |  | name.
291 |  |  |  |  |
292 |  |  |  |  | =cut
293 |  |  |  |  |
294 | 1 | 83µs |  |  | eval <<'END_PERL' unless defined &_NONNEGINT;
295 |  |  |  |  | sub _NONNEGINT ($) {
296 |  |  |  |  | (defined $_[0] and ! ref $_[0] and $_[0] =~ m/^(?:0|[1-9]\d*)$/) ? $_[0] : undef;
297 |  |  |  |  | }
298 |  |  |  |  | END_PERL
299 |  |  |  |  |
300 |  |  |  |  | =pod
301 |  |  |  |  |
302 |  |  |  |  | =head2 _SCALAR \$scalar
303 |  |  |  |  |
304 |  |  |  |  | The C<_SCALAR> function is intended to be imported into your package,
305 |  |  |  |  | and provides a convenient way to test for a raw and unblessed
306 |  |  |  |  | C<SCALAR> reference, with content of non-zero length.
307 |  |  |  |  |
308 |  |  |  |  | For a version that allows zero length C<SCALAR> references, see
309 |  |  |  |  | the C<_SCALAR0> function.
310 |  |  |  |  |
311 |  |  |  |  | Returns the C<SCALAR> reference itself as a convenience, or C<undef>
312 |  |  |  |  | if the value provided is not a C<SCALAR> reference.
313 |  |  |  |  |
314 |  |  |  |  | =cut
315 |  |  |  |  |
316 | 1 | 600ns |  |  | eval <<'END_PERL' unless defined &_SCALAR;
317 |  |  |  |  | sub _SCALAR ($) {
318 |  |  |  |  | (ref $_[0] eq 'SCALAR' and defined ${$_[0]} and ${$_[0]} ne '') ? $_[0] : undef;
319 |  |  |  |  | }
320 |  |  |  |  | END_PERL
321 |  |  |  |  |
322 |  |  |  |  | =pod
323 |  |  |  |  |
324 |  |  |  |  | =head2 _SCALAR0 \$scalar
325 |  |  |  |  |
326 |  |  |  |  | The C<_SCALAR0> function is intended to be imported into your package,
327 |  |  |  |  | and provides a convenient way to test for a raw and unblessed
328 |  |  |  |  | C<SCALAR0> reference, allowing content of zero-length.
329 |  |  |  |  |
330 |  |  |  |  | For a simpler "give me some content" version that requires non-zero
331 |  |  |  |  | length, C<_SCALAR> function.
332 |  |  |  |  |
333 |  |  |  |  | Returns the C<SCALAR> reference itself as a convenience, or C<undef>
334 |  |  |  |  | if the value provided is not a C<SCALAR> reference.
335 |  |  |  |  |
336 |  |  |  |  | =cut
337 |  |  |  |  |
338 | 1 | 400ns |  |  | eval <<'END_PERL' unless defined &_SCALAR0;
339 |  |  |  |  | sub _SCALAR0 ($) {
340 |  |  |  |  | ref $_[0] eq 'SCALAR' ? $_[0] : undef;
341 |  |  |  |  | }
342 |  |  |  |  | END_PERL
343 |  |  |  |  |
344 |  |  |  |  | =pod
345 |  |  |  |  |
346 |  |  |  |  | =head2 _ARRAY $value
347 |  |  |  |  |
348 |  |  |  |  | The C<_ARRAY> function is intended to be imported into your package,
349 |  |  |  |  | and provides a convenient way to test for a raw and unblessed
350 |  |  |  |  | C<ARRAY> reference containing B<at least> one element of any kind.
351 |  |  |  |  |
352 |  |  |  |  | For a more basic form that allows zero length ARRAY references, see
353 |  |  |  |  | the C<_ARRAY0> function.
354 |  |  |  |  |
355 |  |  |  |  | Returns the C<ARRAY> reference itself as a convenience, or C<undef>
356 |  |  |  |  | if the value provided is not an C<ARRAY> reference.
357 |  |  |  |  |
358 |  |  |  |  | =cut
359 |  |  |  |  |
360 | 1 | 100ns |  |  | eval <<'END_PERL' unless defined &_ARRAY;
361 |  |  |  |  | sub _ARRAY ($) {
362 |  |  |  |  | (ref $_[0] eq 'ARRAY' and @{$_[0]}) ? $_[0] : undef;
363 |  |  |  |  | }
364 |  |  |  |  | END_PERL
365 |  |  |  |  |
366 |  |  |  |  | =pod
367 |  |  |  |  |
368 |  |  |  |  | =head2 _ARRAY0 $value
369 |  |  |  |  |
370 |  |  |  |  | The C<_ARRAY0> function is intended to be imported into your package,
371 |  |  |  |  | and provides a convenient way to test for a raw and unblessed
372 |  |  |  |  | C<ARRAY> reference, allowing C<ARRAY> references that contain no
373 |  |  |  |  | elements.
374 |  |  |  |  |
375 |  |  |  |  | For a more basic "An array of something" form that also requires at
376 |  |  |  |  | least one element, see the C<_ARRAY> function.
377 |  |  |  |  |
378 |  |  |  |  | Returns the C<ARRAY> reference itself as a convenience, or C<undef>
379 |  |  |  |  | if the value provided is not an C<ARRAY> reference.
380 |  |  |  |  |
381 |  |  |  |  | =cut
382 |  |  |  |  |
383 | 1 | 200ns |  |  | eval <<'END_PERL' unless defined &_ARRAY0;
384 |  |  |  |  | sub _ARRAY0 ($) {
385 |  |  |  |  | ref $_[0] eq 'ARRAY' ? $_[0] : undef;
386 |  |  |  |  | }
387 |  |  |  |  | END_PERL
388 |  |  |  |  |
389 |  |  |  |  | =pod
390 |  |  |  |  |
391 |  |  |  |  | =head2 _ARRAYLIKE $value
392 |  |  |  |  |
393 |  |  |  |  | The C<_ARRAYLIKE> function tests whether a given scalar value can respond to
394 |  |  |  |  | array dereferencing. If it can, the value is returned. If it cannot,
395 |  |  |  |  | C<_ARRAYLIKE> returns C<undef>.
396 |  |  |  |  |
397 |  |  |  |  | =cut
398 |  |  |  |  |
399 | 1 | 100ns |  |  | eval <<'END_PERL' unless defined &_ARRAYLIKE;
400 |  |  |  |  | sub _ARRAYLIKE {
401 |  |  |  |  | (defined $_[0] and ref $_[0] and (
402 |  |  |  |  | (Scalar::Util::reftype($_[0]) eq 'ARRAY')
403 |  |  |  |  | or
404 |  |  |  |  | overload::Method($_[0], '@{}')
405 |  |  |  |  | )) ? $_[0] : undef;
406 |  |  |  |  | }
407 |  |  |  |  | END_PERL
408 |  |  |  |  |
409 |  |  |  |  | =pod
410 |  |  |  |  |
411 |  |  |  |  | =head2 _HASH $value
412 |  |  |  |  |
413 |  |  |  |  | The C<_HASH> function is intended to be imported into your package,
414 |  |  |  |  | and provides a convenient way to test for a raw and unblessed
415 |  |  |  |  | C<HASH> reference with at least one entry.
416 |  |  |  |  |
417 |  |  |  |  | For a version of this function that allows the C<HASH> to be empty,
418 |  |  |  |  | see the C<_HASH0> function.
419 |  |  |  |  |
420 |  |  |  |  | Returns the C<HASH> reference itself as a convenience, or C<undef>
421 |  |  |  |  | if the value provided is not an C<HASH> reference.
422 |  |  |  |  |
423 |  |  |  |  | =cut
424 |  |  |  |  |
425 | 1 | 200ns |  |  | eval <<'END_PERL' unless defined &_HASH;
426 |  |  |  |  | sub _HASH ($) {
427 |  |  |  |  | (ref $_[0] eq 'HASH' and scalar %{$_[0]}) ? $_[0] : undef;
428 |  |  |  |  | }
429 |  |  |  |  | END_PERL
430 |  |  |  |  |
431 |  |  |  |  | =pod
432 |  |  |  |  |
433 |  |  |  |  | =head2 _HASH0 $value
434 |  |  |  |  |
435 |  |  |  |  | The C<_HASH0> function is intended to be imported into your package,
436 |  |  |  |  | and provides a convenient way to test for a raw and unblessed
437 |  |  |  |  | C<HASH> reference, regardless of the C<HASH> content.
438 |  |  |  |  |
439 |  |  |  |  | For a simpler "A hash of something" version that requires at least one
440 |  |  |  |  | element, see the C<_HASH> function.
441 |  |  |  |  |
442 |  |  |  |  | Returns the C<HASH> reference itself as a convenience, or C<undef>
443 |  |  |  |  | if the value provided is not an C<HASH> reference.
444 |  |  |  |  |
445 |  |  |  |  | =cut
446 |  |  |  |  |
447 | 1 | 200ns |  |  | eval <<'END_PERL' unless defined &_HASH0;
448 |  |  |  |  | sub _HASH0 ($) {
449 |  |  |  |  | ref $_[0] eq 'HASH' ? $_[0] : undef;
450 |  |  |  |  | }
451 |  |  |  |  | END_PERL
452 |  |  |  |  |
453 |  |  |  |  | =pod
454 |  |  |  |  |
455 |  |  |  |  | =head2 _HASHLIKE $value
456 |  |  |  |  |
457 |  |  |  |  | The C<_HASHLIKE> function tests whether a given scalar value can respond to
458 |  |  |  |  | hash dereferencing. If it can, the value is returned. If it cannot,
459 |  |  |  |  | C<_HASHLIKE> returns C<undef>.
460 |  |  |  |  |
461 |  |  |  |  | =cut
462 |  |  |  |  |
463 | 1 | 100ns |  |  | eval <<'END_PERL' unless defined &_HASHLIKE;
464 |  |  |  |  | sub _HASHLIKE {
465 |  |  |  |  | (defined $_[0] and ref $_[0] and (
466 |  |  |  |  | (Scalar::Util::reftype($_[0]) eq 'HASH')
467 |  |  |  |  | or
468 |  |  |  |  | overload::Method($_[0], '%{}')
469 |  |  |  |  | )) ? $_[0] : undef;
470 |  |  |  |  | }
471 |  |  |  |  | END_PERL
472 |  |  |  |  |
473 |  |  |  |  | =pod
474 |  |  |  |  |
475 |  |  |  |  | =head2 _CODE $value
476 |  |  |  |  |
477 |  |  |  |  | The C<_CODE> function is intended to be imported into your package,
478 |  |  |  |  | and provides a convenient way to test for a raw and unblessed
479 |  |  |  |  | C<CODE> reference.
480 |  |  |  |  |
481 |  |  |  |  | Returns the C<CODE> reference itself as a convenience, or C<undef>
482 |  |  |  |  | if the value provided is not an C<CODE> reference.
483 |  |  |  |  |
484 |  |  |  |  | =cut
485 |  |  |  |  |
486 | 1 | 100ns |  |  | eval <<'END_PERL' unless defined &_CODE;
487 |  |  |  |  | sub _CODE ($) {
488 |  |  |  |  | ref $_[0] eq 'CODE' ? $_[0] : undef;
489 |  |  |  |  | }
490 |  |  |  |  | END_PERL
491 |  |  |  |  |
492 |  |  |  |  | =pod
493 |  |  |  |  |
494 |  |  |  |  | =head2 _CODELIKE $value
495 |  |  |  |  |
496 |  |  |  |  | The C<_CODELIKE> is the more generic version of C<_CODE>. Unlike C<_CODE>,
497 |  |  |  |  | which checks for an explicit C<CODE> reference, the C<_CODELIKE> function
498 |  |  |  |  | also includes things that act like them, such as blessed objects that
499 |  |  |  |  | overload C<'&{}'>.
500 |  |  |  |  |
501 |  |  |  |  | Please note that in the case of objects overloaded with '&{}', you will
502 |  |  |  |  | almost always end up also testing it in 'bool' context at some stage.
503 |  |  |  |  |
504 |  |  |  |  | For example:
505 |  |  |  |  |
506 |  |  |  |  | sub foo {
507 |  |  |  |  | my $code1 = _CODELIKE(shift) or die "No code param provided";
508 |  |  |  |  | my $code2 = _CODELIKE(shift);
509 |  |  |  |  | if ( $code2 ) {
510 |  |  |  |  | print "Got optional second code param";
511 |  |  |  |  | }
512 |  |  |  |  | }
513 |  |  |  |  |
514 |  |  |  |  | As such, you will most likely always want to make sure your class has
515 |  |  |  |  | at least the following to allow it to evaluate to true in boolean
516 |  |  |  |  | context.
517 |  |  |  |  |
518 |  |  |  |  | # Always evaluate to true in boolean context
519 |  |  |  |  | use overload 'bool' => sub () { 1 };
520 |  |  |  |  |
521 |  |  |  |  | Returns the callable value as a convenience, or C<undef> if the
522 |  |  |  |  | value provided is not callable.
523 |  |  |  |  |
524 |  |  |  |  | Note - This function was formerly known as _CALLABLE but has been renamed
525 |  |  |  |  | for greater symmetry with the other _XXXXLIKE functions.
526 |  |  |  |  |
527 |  |  |  |  | The use of _CALLABLE has been deprecated. It will continue to work, but
528 |  |  |  |  | with a warning, until end-2006, then will be removed.
529 |  |  |  |  |
530 |  |  |  |  | I apologise for any inconvenience caused.
531 |  |  |  |  |
532 |  |  |  |  | =cut
533 |  |  |  |  |
534 | 1 | 100ns |  |  | eval <<'END_PERL' unless defined &_CODELIKE;
535 |  |  |  |  | sub _CODELIKE($) {
536 |  |  |  |  | (
537 |  |  |  |  | (Scalar::Util::reftype($_[0])||'') eq 'CODE'
538 |  |  |  |  | or
539 |  |  |  |  | Scalar::Util::blessed($_[0]) and overload::Method($_[0],'&{}')
540 |  |  |  |  | )
541 |  |  |  |  | ? $_[0] : undef;
542 |  |  |  |  | }
543 |  |  |  |  | END_PERL
544 |  |  |  |  |
545 |  |  |  |  | =pod
546 |  |  |  |  |
547 |  |  |  |  | =head2 _INVOCANT $value
548 |  |  |  |  |
549 |  |  |  |  | This routine tests whether the given value is a valid method invocant.
550 |  |  |  |  | This can be either an instance of an object, or a class name.
551 |  |  |  |  |
552 |  |  |  |  | If so, the value itself is returned. Otherwise, C<_INVOCANT>
553 |  |  |  |  | returns C<undef>.
554 |  |  |  |  |
555 |  |  |  |  | =cut
556 |  |  |  |  |
557 | 1 | 67µs |  |  | eval <<'END_PERL' unless defined &_INVOCANT;
558 |  |  |  |  | sub _INVOCANT($) {
559 |  |  |  |  | (defined $_[0] and
560 |  |  |  |  | (defined Scalar::Util::blessed($_[0])
561 |  |  |  |  | or
562 |  |  |  |  | # We used to check for stash definedness, but any class-like name is a
563 |  |  |  |  | # valid invocant for UNIVERSAL methods, so we stopped. -- rjbs, 2006-07-02
564 |  |  |  |  | Params::Util::_CLASS($_[0]))
565 |  |  |  |  | ) ? $_[0] : undef;
566 |  |  |  |  | }
567 |  |  |  |  | END_PERL
568 |  |  |  |  |
569 |  |  |  |  | =pod
570 |  |  |  |  |
571 |  |  |  |  | =head2 _INSTANCE $object, $class
572 |  |  |  |  |
573 |  |  |  |  | The C<_INSTANCE> function is intended to be imported into your package,
574 |  |  |  |  | and provides a convenient way to test for an object of a particular class
575 |  |  |  |  | in a strictly correct manner.
576 |  |  |  |  |
577 |  |  |  |  | Returns the object itself as a convenience, or C<undef> if the value
578 |  |  |  |  | provided is not an object of that type.
579 |  |  |  |  |
580 |  |  |  |  | =cut
581 |  |  |  |  |
582 | 1 | 300ns |  |  | eval <<'END_PERL' unless defined &_INSTANCE;
583 |  |  |  |  | sub _INSTANCE ($$) {
584 |  |  |  |  | (Scalar::Util::blessed($_[0]) and $_[0]->isa($_[1])) ? $_[0] : undef;
585 |  |  |  |  | }
586 |  |  |  |  | END_PERL
587 |  |  |  |  |
588 |  |  |  |  | =pod
589 |  |  |  |  |
590 |  |  |  |  | =head2 _REGEX $value
591 |  |  |  |  |
592 |  |  |  |  | The C<_REGEX> function is intended to be imported into your package,
593 |  |  |  |  | and provides a convenient way to test for a regular expression.
594 |  |  |  |  |
595 |  |  |  |  | Returns the value itself as a convenience, or C<undef> if the value
596 |  |  |  |  | provided is not a regular expression.
597 |  |  |  |  |
598 |  |  |  |  | =cut
599 |  |  |  |  |
600 | 1 | 200ns |  |  | eval <<'END_PERL' unless defined &_REGEX;
601 |  |  |  |  | sub _REGEX ($) {
602 |  |  |  |  | (defined $_[0] and 'Regexp' eq ref($_[0])) ? $_[0] : undef;
603 |  |  |  |  | }
604 |  |  |  |  | END_PERL
605 |  |  |  |  |
606 |  |  |  |  | =pod
607 |  |  |  |  |
608 |  |  |  |  | =head2 _SET \@array, $class
609 |  |  |  |  |
610 |  |  |  |  | The C<_SET> function is intended to be imported into your package,
611 |  |  |  |  | and provides a convenient way to test for set of at least one object of
612 |  |  |  |  | a particular class in a strictly correct manner.
613 |  |  |  |  |
614 |  |  |  |  | The set is provided as a reference to an C<ARRAY> of objects of the
615 |  |  |  |  | class provided.
616 |  |  |  |  |
617 |  |  |  |  | For an alternative function that allows zero-length sets, see the
618 |  |  |  |  | C<_SET0> function.
619 |  |  |  |  |
620 |  |  |  |  | Returns the C<ARRAY> reference itself as a convenience, or C<undef> if
621 |  |  |  |  | the value provided is not a set of that class.
622 |  |  |  |  |
623 |  |  |  |  | =cut
624 |  |  |  |  |
625 | 1 | 76µs |  |  | eval <<'END_PERL' unless defined &_SET;
626 |  |  |  |  | sub _SET ($$) {
627 |  |  |  |  | my $set = shift;
628 |  |  |  |  | _ARRAY($set) or return undef;
629 |  |  |  |  | foreach my $item ( @$set ) {
630 |  |  |  |  | _INSTANCE($item,$_[0]) or return undef;
631 |  |  |  |  | }
632 |  |  |  |  | $set;
633 |  |  |  |  | }
634 |  |  |  |  | END_PERL
635 |  |  |  |  |
636 |  |  |  |  | =pod
637 |  |  |  |  |
638 |  |  |  |  | =head2 _SET0 \@array, $class
639 |  |  |  |  |
640 |  |  |  |  | The C<_SET0> function is intended to be imported into your package,
641 |  |  |  |  | and provides a convenient way to test for a set of objects of a
642 |  |  |  |  | particular class in a strictly correct manner, allowing for zero objects.
643 |  |  |  |  |
644 |  |  |  |  | The set is provided as a reference to an C<ARRAY> of objects of the
645 |  |  |  |  | class provided.
646 |  |  |  |  |
647 |  |  |  |  | For an alternative function that requires at least one object, see the
648 |  |  |  |  | C<_SET> function.
649 |  |  |  |  |
650 |  |  |  |  | Returns the C<ARRAY> reference itself as a convenience, or C<undef> if
651 |  |  |  |  | the value provided is not a set of that class.
652 |  |  |  |  |
653 |  |  |  |  | =cut
654 |  |  |  |  |
655 | 1 | 75µs |  |  | eval <<'END_PERL' unless defined &_SET0;
656 |  |  |  |  | sub _SET0 ($$) {
657 |  |  |  |  | my $set = shift;
658 |  |  |  |  | _ARRAY0($set) or return undef;
659 |  |  |  |  | foreach my $item ( @$set ) {
660 |  |  |  |  | _INSTANCE($item,$_[0]) or return undef;
661 |  |  |  |  | }
662 |  |  |  |  | $set;
663 |  |  |  |  | }
664 |  |  |  |  | END_PERL
665 |  |  |  |  |
666 |  |  |  |  | =pod
667 |  |  |  |  |
668 |  |  |  |  | =head2 _HANDLE
669 |  |  |  |  |
670 |  |  |  |  | The C<_HANDLE> function is intended to be imported into your package,
671 |  |  |  |  | and provides a convenient way to test whether or not a single scalar
672 |  |  |  |  | value is a file handle.
673 |  |  |  |  |
674 |  |  |  |  | Unfortunately, in Perl the definition of a file handle can be a little
675 |  |  |  |  | bit fuzzy, so this function is likely to be somewhat imperfect (at first
676 |  |  |  |  | anyway).
677 |  |  |  |  |
678 |  |  |  |  | That said, it is implement as well or better than the other file handle
679 |  |  |  |  | detectors in existance (and we stole from the best of them).
680 |  |  |  |  |
681 |  |  |  |  | =cut
682 |  |  |  |  |
683 |  |  |  |  | # We're doing this longhand for now. Once everything is perfect,
684 |  |  |  |  | # we'll compress this into something that compiles more efficiently.
685 |  |  |  |  | # Further, testing file handles is not something that is generally
686 |  |  |  |  | # done millions of times, so doing it slowly is not a big speed hit.
687 | 1 | 144µs |  |  | eval <<'END_PERL' unless defined &_HANDLE;
688 |  |  |  |  | sub _HANDLE {
689 |  |  |  |  | my $it = shift;
690 |  |  |  |  |
691 |  |  |  |  | # It has to be defined, of course
692 |  |  |  |  | unless ( defined $it ) {
693 |  |  |  |  | return undef;
694 |  |  |  |  | }
695 |  |  |  |  |
696 |  |  |  |  | # Normal globs are considered to be file handles
697 |  |  |  |  | if ( ref $it eq 'GLOB' ) {
698 |  |  |  |  | return $it;
699 |  |  |  |  | }
700 |  |  |  |  |
701 |  |  |  |  | # Check for a normal tied filehandle
702 |  |  |  |  | # Side Note: 5.5.4's tied() and can() doesn't like getting undef
703 |  |  |  |  | if ( tied($it) and tied($it)->can('TIEHANDLE') ) {
704 |  |  |  |  | return $it;
705 |  |  |  |  | }
706 |  |  |  |  |
707 |  |  |  |  | # There are no other non-object handles that we support
708 |  |  |  |  | unless ( Scalar::Util::blessed($it) ) {
709 |  |  |  |  | return undef;
710 |  |  |  |  | }
711 |  |  |  |  |
712 |  |  |  |  | # Check for a common base classes for conventional IO::Handle object
713 |  |  |  |  | if ( $it->isa('IO::Handle') ) {
714 |  |  |  |  | return $it;
715 |  |  |  |  | }
716 |  |  |  |  |
717 |  |  |  |  |
718 |  |  |  |  | # Check for tied file handles using Tie::Handle
719 |  |  |  |  | if ( $it->isa('Tie::Handle') ) {
720 |  |  |  |  | return $it;
721 |  |  |  |  | }
722 |  |  |  |  |
723 |  |  |  |  | # IO::Scalar is not a proper seekable, but it is valid is a
724 |  |  |  |  | # regular file handle
725 |  |  |  |  | if ( $it->isa('IO::Scalar') ) {
726 |  |  |  |  | return $it;
727 |  |  |  |  | }
728 |  |  |  |  |
729 |  |  |  |  | # Yet another special case for IO::String, which refuses (for now
730 |  |  |  |  | # anyway) to become a subclass of IO::Handle.
731 |  |  |  |  | if ( $it->isa('IO::String') ) {
732 |  |  |  |  | return $it;
733 |  |  |  |  | }
734 |  |  |  |  |
735 |  |  |  |  | # This is not any sort of object we know about
736 |  |  |  |  | return undef;
737 |  |  |  |  | }
738 |  |  |  |  | END_PERL
739 |  |  |  |  |
740 |  |  |  |  | =pod
741 |  |  |  |  |
742 |  |  |  |  | =head2 _DRIVER $string
743 |  |  |  |  |
744 |  |  |  |  | sub foo {
745 |  |  |  |  | my $class = _DRIVER(shift, 'My::Driver::Base') or die "Bad driver";
746 |  |  |  |  | ...
747 |  |  |  |  | }
748 |  |  |  |  |
749 |  |  |  |  | The C<_DRIVER> function is intended to be imported into your
750 |  |  |  |  | package, and provides a convenient way to load and validate
751 |  |  |  |  | a driver class.
752 |  |  |  |  |
753 |  |  |  |  | The most common pattern when taking a driver class as a parameter
754 |  |  |  |  | is to check that the name is a class (i.e. check against _CLASS)
755 |  |  |  |  | and then to load the class (if it exists) and then ensure that
756 |  |  |  |  | the class returns true for the isa method on some base driver name.
757 |  |  |  |  |
758 |  |  |  |  | Return the value as a convenience, or C<undef> if the value is not
759 |  |  |  |  | a class name, the module does not exist, the module does not load,
760 |  |  |  |  | or the class fails the isa test.
761 |  |  |  |  |
762 |  |  |  |  | =cut
763 |  |  |  |  |
764 | 1 | 91µs |  |  | eval <<'END_PERL' unless defined &_DRIVER;
765 |  |  |  |  | sub _DRIVER ($$) {
766 |  |  |  |  | (defined _CLASS($_[0]) and eval "require $_[0];" and ! $@ and $_[0]->isa($_[1]) and $_[0] ne $_[1]) ? $_[0] : undef;
767 |  |  |  |  | }
768 |  |  |  |  | END_PERL
769 |  |  |  |  |
770 | 1 | 90µs |  |  | 1;
771 |  |  |  |  |
772 |  |  |  |  | =pod
773 |  |  |  |  |
774 |  |  |  |  | =head1 TO DO
775 |  |  |  |  |
776 |  |  |  |  | - Add _CAN to help resolve the UNIVERSAL::can debacle
777 |  |  |  |  |
778 |  |  |  |  | - Would be even nicer if someone would demonstrate how the hell to
779 |  |  |  |  | build a Module::Install dist of the ::Util dual Perl/XS type. :/
780 |  |  |  |  |
781 |  |  |  |  | - Implement an assertion-like version of this module, that dies on
782 |  |  |  |  | error.
783 |  |  |  |  |
784 |  |  |  |  | - Implement a Test:: version of this module, for use in testing
785 |  |  |  |  |
786 |  |  |  |  | =head1 SUPPORT
787 |  |  |  |  |
788 |  |  |  |  | Bugs should be reported via the CPAN bug tracker at
789 |  |  |  |  |
790 |  |  |  |  | L<http://rt.cpan.org/NoAuth/ReportBug.html?Queue=Params-Util>
791 |  |  |  |  |
792 |  |  |  |  | For other issues, contact the author.
793 |  |  |  |  |
794 |  |  |  |  | =head1 AUTHOR
795 |  |  |  |  |
796 |  |  |  |  | Adam Kennedy E<lt>adamk@cpan.orgE<gt>
797 |  |  |  |  |
798 |  |  |  |  | =head1 SEE ALSO
799 |  |  |  |  |
800 |  |  |  |  | L<Params::Validate>
801 |  |  |  |  |
802 |  |  |  |  | =head1 COPYRIGHT
803 |  |  |  |  |
804 |  |  |  |  | Copyright 2005 - 2009 Adam Kennedy.
805 |  |  |  |  |
806 |  |  |  |  | This program is free software; you can redistribute
807 |  |  |  |  | it and/or modify it under the same terms as Perl itself.
808 |  |  |  |  |
809 |  |  |  |  | The full text of the license can be found in the
810 |  |  |  |  | LICENSE file included with this module.
811 |  |  |  |  |
812 |  |  |  |  | =cut
|  |  |  |  | # spent 6µs within Params::Util::_ARRAYLIKE which was called 5 times, avg 1µs/call: # 5 times (6µs+0s) by Data::OptList::__is_a at line 146 of Data/OptList.pm, avg 1µs/call sub Params::Util::_ARRAYLIKE; # xsub
|  |  |  |  | # spent 46µs within Params::Util::_CODELIKE which was called 69 times, avg 667ns/call: # 31 times (15µs+0s) by Data::OptList::__is_a at line 146 of Data/OptList.pm, avg 497ns/call # 30 times (17µs+0s) by Sub::Exporter::default_generator at line 856 of Sub/Exporter.pm, avg 577ns/call # 7 times (12µs+0s) by Sub::Exporter::_expand_group at line 481 of Sub/Exporter.pm, avg 2µs/call # once (900ns+0s) by Sub::Exporter::_do_import at line 771 of Sub/Exporter.pm sub Params::Util::_CODELIKE; # xsub
|  |  |  |  | # spent 8µs within Params::Util::_HASHLIKE which was called 5 times, avg 2µs/call: # 5 times (8µs+0s) by Data::OptList::__is_a at line 146 of Data/OptList.pm, avg 2µs/call sub Params::Util::_HASHLIKE; # xsub
|  |  |  |  | # spent 8µs within Params::Util::_SCALAR0 which was called 8 times, avg 1µs/call: # 7 times (7µs+0s) by Sub::Exporter::_expand_group at line 481 of Sub/Exporter.pm, avg 1µs/call # once (900ns+0s) by Sub::Exporter::__ANON__[/usr/local/lib/perl5/site_perl/5.10.1/Sub/Exporter.pm:544] at line 536 of Sub/Exporter.pm sub Params::Util::_SCALAR0; # xsub
|  |  |  |  | # spent 51µs within Params::Util::bootstrap which was called # once (51µs+0s) by DynaLoader::bootstrap at line 227 of DynaLoader.pm sub Params::Util::bootstrap; # xsub