lib/autodie/hints.pm

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