| 1 | package autodie::hints; |
| 2 | |
| 3 | use strict; |
| 4 | use warnings; |
| 5 | |
| 6 | use constant PERL58 => ( $] < 5.009 ); |
| 7 | |
| 8 | our $VERSION = '2.03'; |
| 9 | |
| 10 | =head1 NAME |
| 11 | |
| 12 | autodie::hints - Provide hints about user subroutines to autodie |
| 13 | |
| 14 | =head1 SYNOPSIS |
| 15 | |
| 16 | package Your::Module; |
| 17 | |
| 18 | our %DOES = ( 'autodie::hints::provider' => 1 ); |
| 19 | |
| 20 | sub AUTODIE_HINTS { |
| 21 | return { |
| 22 | foo => { scalar => HINTS, list => SOME_HINTS }, |
| 23 | bar => { scalar => HINTS, list => MORE_HINTS }, |
| 24 | } |
| 25 | } |
| 26 | |
| 27 | # Later, in your main program... |
| 28 | |
| 29 | use Your::Module qw(foo bar); |
| 30 | use autodie qw(:default foo bar); |
| 31 | |
| 32 | foo(); # succeeds or dies based on scalar hints |
| 33 | |
| 34 | # Alternatively, hints can be set on subroutines we've |
| 35 | # imported. |
| 36 | |
| 37 | use autodie::hints; |
| 38 | use Some::Module qw(think_positive); |
| 39 | |
| 40 | BEGIN { |
| 41 | autodie::hints->set_hints_for( |
| 42 | \&think_positive, |
| 43 | { |
| 44 | fail => sub { $_[0] <= 0 } |
| 45 | } |
| 46 | ) |
| 47 | } |
| 48 | use autodie qw(think_positive); |
| 49 | |
| 50 | think_positive(...); # Returns positive or dies. |
| 51 | |
| 52 | |
| 53 | =head1 DESCRIPTION |
| 54 | |
| 55 | =head2 Introduction |
| 56 | |
| 57 | The L<autodie> pragma is very smart when it comes to working with |
| 58 | Perl's built-in functions. The behaviour for these functions are |
| 59 | fixed, and C<autodie> knows exactly how they try to signal failure. |
| 60 | |
| 61 | But what about user-defined subroutines from modules? If you use |
| 62 | C<autodie> on a user-defined subroutine then it assumes the following |
| 63 | behaviour to demonstrate failure: |
| 64 | |
| 65 | =over |
| 66 | |
| 67 | =item * |
| 68 | |
| 69 | A false value, in scalar context |
| 70 | |
| 71 | =item * |
| 72 | |
| 73 | An empty list, in list context |
| 74 | |
| 75 | =item * |
| 76 | |
| 77 | A list containing a single undef, in list context |
| 78 | |
| 79 | =back |
| 80 | |
| 81 | All other return values (including the list of the single zero, and the |
| 82 | list containing a single empty string) are considered successful. However, |
| 83 | real-world code isn't always that easy. Perhaps the code you're working |
| 84 | with returns a string containing the word "FAIL" upon failure, or a |
| 85 | two element list containing C<(undef, "human error message")>. To make |
| 86 | autodie work with these sorts of subroutines, we have |
| 87 | the I<hinting interface>. |
| 88 | |
| 89 | The hinting interface allows I<hints> to be provided to C<autodie> |
| 90 | on how it should detect failure from user-defined subroutines. While |
| 91 | these I<can> be provided by the end-user of C<autodie>, they are ideally |
| 92 | written into the module itself, or into a helper module or sub-class |
| 93 | of C<autodie> itself. |
| 94 | |
| 95 | =head2 What are hints? |
| 96 | |
| 97 | A I<hint> is a subroutine or value that is checked against the |
| 98 | return value of an autodying subroutine. If the match returns true, |
| 99 | C<autodie> considers the subroutine to have failed. |
| 100 | |
| 101 | If the hint provided is a subroutine, then C<autodie> will pass |
| 102 | the complete return value to that subroutine. If the hint is |
| 103 | any other value, then C<autodie> will smart-match against the |
| 104 | value provided. In Perl 5.8.x there is no smart-match operator, and as such |
| 105 | only subroutine hints are supported in these versions. |
| 106 | |
| 107 | Hints can be provided for both scalar and list contexts. Note |
| 108 | that an autodying subroutine will never see a void context, as |
| 109 | C<autodie> always needs to capture the return value for examination. |
| 110 | Autodying subroutines called in void context act as if they're called |
| 111 | in a scalar context, but their return value is discarded after it |
| 112 | has been checked. |
| 113 | |
| 114 | =head2 Example hints |
| 115 | |
| 116 | Hints may consist of scalars, array references, regular expressions and |
| 117 | subroutine references. You can specify different hints for how |
| 118 | failure should be identified in scalar and list contexts. |
| 119 | |
| 120 | These examples apply for use in the C<AUTODIE_HINTS> subroutine and when |
| 121 | calling C<autodie::hints->set_hints_for()>. |
| 122 | |
| 123 | The most common context-specific hints are: |
| 124 | |
| 125 | # Scalar failures always return undef: |
| 126 | { scalar => undef } |
| 127 | |
| 128 | # Scalar failures return any false value [default expectation]: |
| 129 | { scalar => sub { ! $_[0] } } |
| 130 | |
| 131 | # Scalar failures always return zero explicitly: |
| 132 | { scalar => '0' } |
| 133 | |
| 134 | # List failures always return an empty list: |
| 135 | { list => [] } |
| 136 | |
| 137 | # List failures return () or (undef) [default expectation]: |
| 138 | { list => sub { ! @_ || @_ == 1 && !defined $_[0] } } |
| 139 | |
| 140 | # List failures return () or a single false value: |
| 141 | { list => sub { ! @_ || @_ == 1 && !$_[0] } } |
| 142 | |
| 143 | # List failures return (undef, "some string") |
| 144 | { list => sub { @_ == 2 && !defined $_[0] } } |
| 145 | |
| 146 | # Unsuccessful foo() returns 'FAIL' or '_FAIL' in scalar context, |
| 147 | # returns (-1) in list context... |
| 148 | autodie::hints->set_hints_for( |
| 149 | \&foo, |
| 150 | { |
| 151 | scalar => qr/^ _? FAIL $/xms, |
| 152 | list => [-1], |
| 153 | } |
| 154 | ); |
| 155 | |
| 156 | # Unsuccessful foo() returns 0 in all contexts... |
| 157 | autodie::hints->set_hints_for( |
| 158 | \&foo, |
| 159 | { |
| 160 | scalar => 0, |
| 161 | list => [0], |
| 162 | } |
| 163 | ); |
| 164 | |
| 165 | This "in all contexts" construction is very common, and can be |
| 166 | abbreviated, using the 'fail' key. This sets both the C<scalar> |
| 167 | and C<list> hints to the same value: |
| 168 | |
| 169 | # Unsuccessful foo() returns 0 in all contexts... |
| 170 | autodie::hints->set_hints_for( |
| 171 | \&foo, |
| 172 | { |
| 173 | fail => sub { @_ == 1 and defined $_[0] and $_[0] == 0 } |
| 174 | } |
| 175 | ); |
| 176 | |
| 177 | # Unsuccessful think_positive() returns negative number on failure... |
| 178 | autodie::hints->set_hints_for( |
| 179 | \&think_positive, |
| 180 | { |
| 181 | fail => sub { $_[0] < 0 } |
| 182 | } |
| 183 | ); |
| 184 | |
| 185 | # Unsuccessful my_system() returns non-zero on failure... |
| 186 | autodie::hints->set_hints_for( |
| 187 | \&my_system, |
| 188 | { |
| 189 | fail => sub { $_[0] != 0 } |
| 190 | } |
| 191 | ); |
| 192 | |
| 193 | =head1 Manually setting hints from within your program |
| 194 | |
| 195 | If you are using a module which returns something special on failure, then |
| 196 | you can manually create hints for each of the desired subroutines. Once |
| 197 | the hints are specified, they are available for all files and modules loaded |
| 198 | thereafter, thus you can move this work into a module and it will still |
| 199 | work. |
| 200 | |
| 201 | use Some::Module qw(foo bar); |
| 202 | use autodie::hints; |
| 203 | |
| 204 | autodie::hints->set_hints_for( |
| 205 | \&foo, |
| 206 | { |
| 207 | scalar => SCALAR_HINT, |
| 208 | list => LIST_HINT, |
| 209 | } |
| 210 | ); |
| 211 | autodie::hints->set_hints_for( |
| 212 | \&bar, |
| 213 | { fail => SOME_HINT, } |
| 214 | ); |
| 215 | |
| 216 | It is possible to pass either a subroutine reference (recommended) or a fully |
| 217 | qualified subroutine name as the first argument. This means you can set hints |
| 218 | on modules that I<might> get loaded: |
| 219 | |
| 220 | use autodie::hints; |
| 221 | autodie::hints->set_hints_for( |
| 222 | 'Some::Module:bar', { fail => SCALAR_HINT, } |
| 223 | ); |
| 224 | |
| 225 | This technique is most useful when you have a project that uses a |
| 226 | lot of third-party modules. You can define all your possible hints |
| 227 | in one-place. This can even be in a sub-class of autodie. For |
| 228 | example: |
| 229 | |
| 230 | package my::autodie; |
| 231 | |
| 232 | use parent qw(autodie); |
| 233 | use autodie::hints; |
| 234 | |
| 235 | autodie::hints->set_hints_for(...); |
| 236 | |
| 237 | 1; |
| 238 | |
| 239 | You can now C<use my::autodie>, which will work just like the standard |
| 240 | C<autodie>, but is now aware of any hints that you've set. |
| 241 | |
| 242 | =head1 Adding hints to your module |
| 243 | |
| 244 | C<autodie> provides a passive interface to allow you to declare hints for |
| 245 | your module. These hints will be found and used by C<autodie> if it |
| 246 | is loaded, but otherwise have no effect (or dependencies) without autodie. |
| 247 | To set these, your module needs to declare that it I<does> the |
| 248 | C<autodie::hints::provider> role. This can be done by writing your |
| 249 | own C<DOES> method, using a system such as C<Class::DOES> to handle |
| 250 | the heavy-lifting for you, or declaring a C<%DOES> package variable |
| 251 | with a C<autodie::hints::provider> key and a corresponding true value. |
| 252 | |
| 253 | Note that checking for a C<%DOES> hash is an C<autodie>-only |
| 254 | short-cut. Other modules do not use this mechanism for checking |
| 255 | roles, although you can use the C<Class::DOES> module from the |
| 256 | CPAN to allow it. |
| 257 | |
| 258 | In addition, you must define a C<AUTODIE_HINTS> subroutine that returns |
| 259 | a hash-reference containing the hints for your subroutines: |
| 260 | |
| 261 | package Your::Module; |
| 262 | |
| 263 | # We can use the Class::DOES from the CPAN to declare adherence |
| 264 | # to a role. |
| 265 | |
| 266 | use Class::DOES 'autodie::hints::provider' => 1; |
| 267 | |
| 268 | # Alternatively, we can declare the role in %DOES. Note that |
| 269 | # this is an autodie specific optimisation, although Class::DOES |
| 270 | # can be used to promote this to a true role declaration. |
| 271 | |
| 272 | our %DOES = ( 'autodie::hints::provider' => 1 ); |
| 273 | |
| 274 | # Finally, we must define the hints themselves. |
| 275 | |
| 276 | sub AUTODIE_HINTS { |
| 277 | return { |
| 278 | foo => { scalar => HINTS, list => SOME_HINTS }, |
| 279 | bar => { scalar => HINTS, list => MORE_HINTS }, |
| 280 | baz => { fail => HINTS }, |
| 281 | } |
| 282 | } |
| 283 | |
| 284 | This allows your code to set hints without relying on C<autodie> and |
| 285 | C<autodie::hints> being loaded, or even installed. In this way your |
| 286 | code can do the right thing when C<autodie> is installed, but does not |
| 287 | need to depend upon it to function. |
| 288 | |
| 289 | =head1 Insisting on hints |
| 290 | |
| 291 | When a user-defined subroutine is wrapped by C<autodie>, it will |
| 292 | use hints if they are available, and otherwise reverts to the |
| 293 | I<default behaviour> described in the introduction of this document. |
| 294 | This can be problematic if we expect a hint to exist, but (for |
| 295 | whatever reason) it has not been loaded. |
| 296 | |
| 297 | We can ask autodie to I<insist> that a hint be used by prefixing |
| 298 | an exclamation mark to the start of the subroutine name. A lone |
| 299 | exclamation mark indicates that I<all> subroutines after it must |
| 300 | have hints declared. |
| 301 | |
| 302 | # foo() and bar() must have their hints defined |
| 303 | use autodie qw( !foo !bar baz ); |
| 304 | |
| 305 | # Everything must have hints (recommended). |
| 306 | use autodie qw( ! foo bar baz ); |
| 307 | |
| 308 | # bar() and baz() must have their hints defined |
| 309 | use autodie qw( foo ! bar baz ); |
| 310 | |
| 311 | # Enable autodie for all of Perl's supported built-ins, |
| 312 | # as well as for foo(), bar() and baz(). Everything must |
| 313 | # have hints. |
| 314 | use autodie qw( ! :all foo bar baz ); |
| 315 | |
| 316 | If hints are not available for the specified subroutines, this will cause a |
| 317 | compile-time error. Insisting on hints for Perl's built-in functions |
| 318 | (eg, C<open> and C<close>) is always successful. |
| 319 | |
| 320 | Insisting on hints is I<strongly> recommended. |
| 321 | |
| 322 | =cut |
| 323 | |
| 324 | # TODO: implement regular expression hints |
| 325 | |
| 326 | use constant UNDEF_ONLY => sub { not defined $_[0] }; |
| 327 | use constant EMPTY_OR_UNDEF => sub { |
| 328 | ! @_ or |
| 329 | @_==1 && !defined $_[0] |
| 330 | }; |
| 331 | |
| 332 | use constant EMPTY_ONLY => sub { @_ == 0 }; |
| 333 | use constant EMPTY_OR_FALSE => sub { |
| 334 | ! @_ or |
| 335 | @_==1 && !$_[0] |
| 336 | }; |
| 337 | |
| 338 | use constant SINGLE_TRUE => sub { @_ == 1 and not $_[0] }; |
| 339 | |
| 340 | use constant DEFAULT_HINTS => { |
| 341 | scalar => UNDEF_ONLY, |
| 342 | list => EMPTY_OR_UNDEF, |
| 343 | }; |
| 344 | |
| 345 | |
| 346 | use constant HINTS_PROVIDER => 'autodie::hints::provider'; |
| 347 | |
| 348 | use base qw(Exporter); |
| 349 | |
| 350 | our $DEBUG = 0; |
| 351 | |
| 352 | # Only ( undef ) is a strange but possible situation for very |
| 353 | # badly written code. It's not supported yet. |
| 354 | |
| 355 | my %Hints = ( |
| 356 | 'File::Copy::copy' => { scalar => SINGLE_TRUE, list => SINGLE_TRUE }, |
| 357 | 'File::Copy::move' => { scalar => SINGLE_TRUE, list => SINGLE_TRUE }, |
| 358 | 'File::Copy::cp' => { scalar => SINGLE_TRUE, list => SINGLE_TRUE }, |
| 359 | 'File::Copy::mv' => { scalar => SINGLE_TRUE, list => SINGLE_TRUE }, |
| 360 | ); |
| 361 | |
| 362 | # Start by using Sub::Identify if it exists on this system. |
| 363 | |
| 364 | eval { require Sub::Identify; Sub::Identify->import('get_code_info'); }; |
| 365 | |
| 366 | # If it doesn't exist, we'll define our own. This code is directly |
| 367 | # taken from Rafael Garcia's Sub::Identify 0.04, used under the same |
| 368 | # license as Perl itself. |
| 369 | |
| 370 | if ($@) { |
| 371 | require B; |
| 372 | |
| 373 | no warnings 'once'; |
| 374 | |
| 375 | *get_code_info = sub ($) { |
| 376 | |
| 377 | my ($coderef) = @_; |
| 378 | ref $coderef or return; |
| 379 | my $cv = B::svref_2object($coderef); |
| 380 | $cv->isa('B::CV') or return; |
| 381 | # bail out if GV is undefined |
| 382 | $cv->GV->isa('B::SPECIAL') and return; |
| 383 | |
| 384 | return ($cv->GV->STASH->NAME, $cv->GV->NAME); |
| 385 | }; |
| 386 | |
| 387 | } |
| 388 | |
| 389 | sub sub_fullname { |
| 390 | return join( '::', get_code_info( $_[1] ) ); |
| 391 | } |
| 392 | |
| 393 | my %Hints_loaded = (); |
| 394 | |
| 395 | sub load_hints { |
| 396 | my ($class, $sub) = @_; |
| 397 | |
| 398 | my ($package) = ( $sub =~ /(.*)::/ ); |
| 399 | |
| 400 | if (not defined $package) { |
| 401 | require Carp; |
| 402 | Carp::croak( |
| 403 | "Internal error in autodie::hints::load_hints - no package found. |
| 404 | "); |
| 405 | } |
| 406 | |
| 407 | # Do nothing if we've already tried to load hints for |
| 408 | # this package. |
| 409 | return if $Hints_loaded{$package}++; |
| 410 | |
| 411 | my $hints_available = 0; |
| 412 | |
| 413 | { |
| 414 | no strict 'refs'; ## no critic |
| 415 | |
| 416 | if ($package->can('DOES') and $package->DOES(HINTS_PROVIDER) ) { |
| 417 | $hints_available = 1; |
| 418 | } |
| 419 | elsif ( PERL58 and $package->isa(HINTS_PROVIDER) ) { |
| 420 | $hints_available = 1; |
| 421 | } |
| 422 | elsif ( ${"${package}::DOES"}{HINTS_PROVIDER.""} ) { |
| 423 | $hints_available = 1; |
| 424 | } |
| 425 | } |
| 426 | |
| 427 | return if not $hints_available; |
| 428 | |
| 429 | my %package_hints = %{ $package->AUTODIE_HINTS }; |
| 430 | |
| 431 | foreach my $sub (keys %package_hints) { |
| 432 | |
| 433 | my $hint = $package_hints{$sub}; |
| 434 | |
| 435 | # Ensure we have a package name. |
| 436 | $sub = "${package}::$sub" if $sub !~ /::/; |
| 437 | |
| 438 | # TODO - Currently we don't check for conflicts, should we? |
| 439 | $Hints{$sub} = $hint; |
| 440 | |
| 441 | $class->normalise_hints(\%Hints, $sub); |
| 442 | } |
| 443 | |
| 444 | return; |
| 445 | |
| 446 | } |
| 447 | |
| 448 | sub normalise_hints { |
| 449 | my ($class, $hints, $sub) = @_; |
| 450 | |
| 451 | if ( exists $hints->{$sub}->{fail} ) { |
| 452 | |
| 453 | if ( exists $hints->{$sub}->{scalar} or |
| 454 | exists $hints->{$sub}->{list} |
| 455 | ) { |
| 456 | # TODO: Turn into a proper diagnostic. |
| 457 | require Carp; |
| 458 | local $Carp::CarpLevel = 1; |
| 459 | Carp::croak("fail hints cannot be provided with either scalar or list hints for $sub"); |
| 460 | } |
| 461 | |
| 462 | # Set our scalar and list hints. |
| 463 | |
| 464 | $hints->{$sub}->{scalar} = |
| 465 | $hints->{$sub}->{list} = delete $hints->{$sub}->{fail}; |
| 466 | |
| 467 | return; |
| 468 | |
| 469 | } |
| 470 | |
| 471 | # Check to make sure all our hints exist. |
| 472 | |
| 473 | foreach my $hint (qw(scalar list)) { |
| 474 | if ( not exists $hints->{$sub}->{$hint} ) { |
| 475 | # TODO: Turn into a proper diagnostic. |
| 476 | require Carp; |
| 477 | local $Carp::CarpLevel = 1; |
| 478 | Carp::croak("$hint hint missing for $sub"); |
| 479 | } |
| 480 | } |
| 481 | |
| 482 | return; |
| 483 | } |
| 484 | |
| 485 | sub get_hints_for { |
| 486 | my ($class, $sub) = @_; |
| 487 | |
| 488 | my $subname = $class->sub_fullname( $sub ); |
| 489 | |
| 490 | # If we have hints loaded for a sub, then return them. |
| 491 | |
| 492 | if ( exists $Hints{ $subname } ) { |
| 493 | return $Hints{ $subname }; |
| 494 | } |
| 495 | |
| 496 | # If not, we try to load them... |
| 497 | |
| 498 | $class->load_hints( $subname ); |
| 499 | |
| 500 | # ...and try again! |
| 501 | |
| 502 | if ( exists $Hints{ $subname } ) { |
| 503 | return $Hints{ $subname }; |
| 504 | } |
| 505 | |
| 506 | # It's the caller's responsibility to use defaults if desired. |
| 507 | # This allows on autodie to insist on hints if needed. |
| 508 | |
| 509 | return; |
| 510 | |
| 511 | } |
| 512 | |
| 513 | sub set_hints_for { |
| 514 | my ($class, $sub, $hints) = @_; |
| 515 | |
| 516 | if (ref $sub) { |
| 517 | $sub = $class->sub_fullname( $sub ); |
| 518 | |
| 519 | require Carp; |
| 520 | |
| 521 | $sub or Carp::croak("Attempts to set_hints_for unidentifiable subroutine"); |
| 522 | } |
| 523 | |
| 524 | if ($DEBUG) { |
| 525 | warn "autodie::hints: Setting $sub to hints: $hints\n"; |
| 526 | } |
| 527 | |
| 528 | $Hints{ $sub } = $hints; |
| 529 | |
| 530 | $class->normalise_hints(\%Hints, $sub); |
| 531 | |
| 532 | return; |
| 533 | } |
| 534 | |
| 535 | 1; |
| 536 | |
| 537 | __END__ |
| 538 | |
| 539 | |
| 540 | =head1 Diagnostics |
| 541 | |
| 542 | =over 4 |
| 543 | |
| 544 | =item Attempts to set_hints_for unidentifiable subroutine |
| 545 | |
| 546 | You've called C<< autodie::hints->set_hints_for() >> using a subroutine |
| 547 | reference, but that reference could not be resolved back to a |
| 548 | subroutine name. It may be an anonymous subroutine (which can't |
| 549 | be made autodying), or may lack a name for other reasons. |
| 550 | |
| 551 | If you receive this error with a subroutine that has a real name, |
| 552 | then you may have found a bug in autodie. See L<autodie/BUGS> |
| 553 | for how to report this. |
| 554 | |
| 555 | =item fail hints cannot be provided with either scalar or list hints for %s |
| 556 | |
| 557 | When defining hints, you can either supply both C<list> and |
| 558 | C<scalar> keywords, I<or> you can provide a single C<fail> keyword. |
| 559 | You can't mix and match them. |
| 560 | |
| 561 | =item %s hint missing for %s |
| 562 | |
| 563 | You've provided either a C<scalar> hint without supplying |
| 564 | a C<list> hint, or vice-versa. You I<must> supply both C<scalar> |
| 565 | and C<list> hints, I<or> a single C<fail> hint. |
| 566 | |
| 567 | =back |
| 568 | |
| 569 | =head1 ACKNOWLEDGEMENTS |
| 570 | |
| 571 | =over |
| 572 | |
| 573 | =item * |
| 574 | |
| 575 | Dr Damian Conway for suggesting the hinting interface and providing the |
| 576 | example usage. |
| 577 | |
| 578 | =item * |
| 579 | |
| 580 | Jacinta Richardson for translating much of my ideas into this |
| 581 | documentation. |
| 582 | |
| 583 | =back |
| 584 | |
| 585 | =head1 AUTHOR |
| 586 | |
| 587 | Copyright 2009, Paul Fenwick E<lt>pjf@perltraining.com.auE<gt> |
| 588 | |
| 589 | =head1 LICENSE |
| 590 | |
| 591 | This module is free software. You may distribute it under the |
| 592 | same terms as Perl itself. |
| 593 | |
| 594 | =head1 SEE ALSO |
| 595 | |
| 596 | L<autodie>, L<Class::DOES> |
| 597 | |
| 598 | =cut |