Filename | /home/hinrik/perl5/perlbrew/perls/perl-5.13.5/lib/site_perl/5.13.5/x86_64-linux/Params/Util.pm |
Statements | Executed 44 statements in 1.46ms |
Calls | P | F | Exclusive Time |
Inclusive Time |
Subroutine |
---|---|---|---|---|---|
1 | 1 | 1 | 63µs | 63µs | BEGIN@58 | Params::Util::
1 | 1 | 1 | 36µs | 36µs | bootstrap (xsub) | Params::Util::
12 | 4 | 2 | 20µs | 20µs | _CODELIKE (xsub) | Params::Util::
1 | 1 | 1 | 11µs | 111µs | BEGIN@65 | Params::Util::
1 | 1 | 1 | 10µs | 15µs | BEGIN@59 | Params::Util::
6 | 3 | 2 | 10µs | 10µs | _SCALAR0 (xsub) | Params::Util::
4 | 1 | 1 | 8µs | 8µs | _HASHLIKE (xsub) | Params::Util::
4 | 1 | 1 | 6µs | 6µs | _ARRAYLIKE (xsub) | Params::Util::
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 | 2 | 68µs | 1 | 63µs | # spent 63µs within Params::Util::BEGIN@58 which was called:
# once (63µs+0s) by Data::OptList::BEGIN@7 at line 58 # spent 63µs making 1 call to Params::Util::BEGIN@58 |
59 | 2 | 40µs | 2 | 19µs | # spent 15µs (10+5) within Params::Util::BEGIN@59 which was called:
# once (10µs+5µs) by Data::OptList::BEGIN@7 at line 59 # spent 15µs making 1 call to Params::Util::BEGIN@59
# spent 4µs making 1 call to strict::import |
60 | 1 | 2µs | require overload; | ||
61 | 1 | 1µs | require Exporter; | ||
62 | 1 | 1µs | require Scalar::Util; | ||
63 | 1 | 128µs | require DynaLoader; | ||
64 | |||||
65 | 2 | 547µs | 2 | 212µs | # spent 111µs (11+101) within Params::Util::BEGIN@65 which was called:
# once (11µs+101µs) by Data::OptList::BEGIN@7 at line 65 # spent 111µs making 1 call to Params::Util::BEGIN@65
# spent 100µs making 1 call to vars::import |
66 | |||||
67 | 1 | 1µs | $VERSION = '1.01'; | ||
68 | 1 | 11µs | @ISA = qw{ | ||
69 | Exporter | ||||
70 | DynaLoader | ||||
71 | }; | ||||
72 | 1 | 5µ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 | 2µs | %EXPORT_TAGS = ( ALL => \@EXPORT_OK ); | ||
85 | |||||
86 | 4 | 14µs | eval { | ||
87 | local $ENV{PERL_DL_NONLAZY} = 0 if $ENV{PERL_DL_NONLAZY}; | ||||
88 | 1 | 336µs | bootstrap Params::Util $VERSION; # spent 336µs making 1 call to DynaLoader::bootstrap | ||
89 | 1; | ||||
90 | } unless $ENV{PERL_PARAMS_UTIL_PP}; | ||||
91 | |||||
- - | |||||
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 | 2µs | 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 | 57µs | eval <<'END_PERL' unless defined &_IDENTIFIER; # spent 0s executing statements in string eval | ||
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 | 50µ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 | 53µ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 | 57µ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 | 1µs | 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 | 42µ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 | 45µ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 | 1µs | 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 | 1µs | 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 | 1µs | 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 | 1µs | 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 | 1µs | 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 | 800ns | 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 | 1µs | 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 | 1µs | 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 | 1µs | 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 | 900ns | 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 | 46µ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 | 900ns | 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 | 1µs | 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 | 50µ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 | 48µ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 | 94µ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 | 56µ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 | 25µ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 - 2010 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 4 times, avg 2µs/call:
# 4 times (6µs+0s) by Data::OptList::__is_a at line 146 of Data/OptList.pm, avg 2µs/call | |||||
# spent 20µs within Params::Util::_CODELIKE which was called 12 times, avg 2µs/call:
# 4 times (6µs+0s) by Sub::Exporter::default_generator at line 856 of Sub/Exporter.pm, avg 1µs/call
# 3 times (5µs+0s) by Sub::Exporter::_do_import at line 771 of Sub/Exporter.pm, avg 2µs/call
# 3 times (5µs+0s) by Data::OptList::__is_a at line 146 of Data/OptList.pm, avg 2µs/call
# 2 times (4µs+0s) by Sub::Exporter::_expand_group at line 481 of Sub/Exporter.pm, avg 2µs/call | |||||
# spent 8µs within Params::Util::_HASHLIKE which was called 4 times, avg 2µs/call:
# 4 times (8µs+0s) by Data::OptList::__is_a at line 146 of Data/OptList.pm, avg 2µs/call | |||||
# spent 10µs within Params::Util::_SCALAR0 which was called 6 times, avg 2µs/call:
# 3 times (6µs+0s) by Sub::Exporter::__ANON__[/home/hinrik/perl5/perlbrew/perls/perl-5.13.5/lib/site_perl/5.13.5/Sub/Exporter.pm:544] at line 536 of Sub/Exporter.pm, avg 2µs/call
# 2 times (3µs+0s) by Sub::Exporter::_expand_group at line 481 of Sub/Exporter.pm, avg 1µs/call
# once (1µs+0s) by Data::OptList::__is_a at line 146 of Data/OptList.pm | |||||
# spent 36µs within Params::Util::bootstrap which was called:
# once (36µs+0s) by DynaLoader::bootstrap at line 219 of DynaLoader.pm |