local-lib5/lib/perl5/i486-linux-gnu-thread-multi/Params/Util.pm

   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 use 5.00503;
  59 use strict;
  60 require overload;
  61 require Exporter;
  62 require Scalar::Util;
  63 require DynaLoader;
  64
  65 use vars qw{$VERSION @ISA @EXPORT_OK %EXPORT_TAGS};
  66
  67 $VERSION   = '1.00';
  68 @ISA       = qw{
  69         Exporter
  70         DynaLoader
  71 };
  72 @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 %EXPORT_TAGS = ( ALL => \@EXPORT_OK );
  85
  86 eval {
  87         local $ENV{PERL_DL_NONLAZY} = 0 if $ENV{PERL_DL_NONLAZY};
  88         bootstrap Params::Util $VERSION;
  89         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 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 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 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 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 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 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 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 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 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 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 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 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 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 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 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 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 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 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 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 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 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 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 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 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 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;
 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