| File | /usr/local/lib/perl5/site_perl/5.10.1/darwin-2level/Params/Util.pm |
| Statements Executed | 47 |
| Statement Execution Time | 2.27ms |
| Calls | P | F | Exclusive Time |
Inclusive Time |
Subroutine |
|---|---|---|---|---|---|
| 1 | 1 | 1 | 78µs | 78µs | Params::Util::BEGIN@58 |
| 1 | 1 | 2 | 51µs | 51µs | Params::Util::bootstrap (xsub) |
| 69 | 4 | 3 | 46µs | 46µs | Params::Util::_CODELIKE (xsub) |
| 1 | 1 | 1 | 23µs | 31µs | Params::Util::BEGIN@59 |
| 1 | 1 | 1 | 14µs | 134µs | Params::Util::BEGIN@65 |
| 5 | 1 | 2 | 8µs | 8µs | Params::Util::_HASHLIKE (xsub) |
| 8 | 2 | 2 | 8µs | 8µs | Params::Util::_SCALAR0 (xsub) |
| 5 | 1 | 2 | 6µs | 6µs | Params::Util::_ARRAYLIKE (xsub) |
| 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 # 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 # 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 # 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 | |||||
# 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 | |||||
# 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 | |||||
# 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 | |||||
# spent 51µs within Params::Util::bootstrap which was called
# once (51µs+0s) by DynaLoader::bootstrap at line 227 of DynaLoader.pm |