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