1 package autodie::hints;
6 use constant PERL58 => ( $] < 5.009 );
8 our $VERSION = '2.06_01';
12 autodie::hints - Provide hints about user subroutines to autodie
18 our %DOES = ( 'autodie::hints::provider' => 1 );
22 foo => { scalar => HINTS, list => SOME_HINTS },
23 bar => { scalar => HINTS, list => MORE_HINTS },
27 # Later, in your main program...
29 use Your::Module qw(foo bar);
30 use autodie qw(:default foo bar);
32 foo(); # succeeds or dies based on scalar hints
34 # Alternatively, hints can be set on subroutines we've
38 use Some::Module qw(think_positive);
41 autodie::hints->set_hints_for(
44 fail => sub { $_[0] <= 0 }
48 use autodie qw(think_positive);
50 think_positive(...); # Returns positive or dies.
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.
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:
69 A false value, in scalar context
73 An empty list, in list context
77 A list containing a single undef, in list context
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>.
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
95 =head2 What are hints?
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.
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.
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
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.
120 These examples apply for use in the C<AUTODIE_HINTS> subroutine and when
121 calling C<autodie::hints->set_hints_for()>.
123 The most common context-specific hints are:
125 # Scalar failures always return undef:
128 # Scalar failures return any false value [default expectation]:
129 { scalar => sub { ! $_[0] } }
131 # Scalar failures always return zero explicitly:
134 # List failures always return an empty list:
137 # List failures return () or (undef) [default expectation]:
138 { list => sub { ! @_ || @_ == 1 && !defined $_[0] } }
140 # List failures return () or a single false value:
141 { list => sub { ! @_ || @_ == 1 && !$_[0] } }
143 # List failures return (undef, "some string")
144 { list => sub { @_ == 2 && !defined $_[0] } }
146 # Unsuccessful foo() returns 'FAIL' or '_FAIL' in scalar context,
147 # returns (-1) in list context...
148 autodie::hints->set_hints_for(
151 scalar => qr/^ _? FAIL $/xms,
156 # Unsuccessful foo() returns 0 in all contexts...
157 autodie::hints->set_hints_for(
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:
169 # Unsuccessful foo() returns 0 in all contexts...
170 autodie::hints->set_hints_for(
173 fail => sub { @_ == 1 and defined $_[0] and $_[0] == 0 }
177 # Unsuccessful think_positive() returns negative number on failure...
178 autodie::hints->set_hints_for(
181 fail => sub { $_[0] < 0 }
185 # Unsuccessful my_system() returns non-zero on failure...
186 autodie::hints->set_hints_for(
189 fail => sub { $_[0] != 0 }
193 =head1 Manually setting hints from within your program
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
201 use Some::Module qw(foo bar);
204 autodie::hints->set_hints_for(
207 scalar => SCALAR_HINT,
211 autodie::hints->set_hints_for(
213 { fail => SOME_HINT, }
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:
221 autodie::hints->set_hints_for(
222 'Some::Module:bar', { fail => SCALAR_HINT, }
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
232 use parent qw(autodie);
235 autodie::hints->set_hints_for(...);
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.
242 =head1 Adding hints to your module
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.
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
258 In addition, you must define a C<AUTODIE_HINTS> subroutine that returns
259 a hash-reference containing the hints for your subroutines:
261 package Your::Module;
263 # We can use the Class::DOES from the CPAN to declare adherence
266 use Class::DOES 'autodie::hints::provider' => 1;
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.
272 our %DOES = ( 'autodie::hints::provider' => 1 );
274 # Finally, we must define the hints themselves.
278 foo => { scalar => HINTS, list => SOME_HINTS },
279 bar => { scalar => HINTS, list => MORE_HINTS },
280 baz => { fail => HINTS },
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.
289 =head1 Insisting on hints
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.
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
302 # foo() and bar() must have their hints defined
303 use autodie qw( !foo !bar baz );
305 # Everything must have hints (recommended).
306 use autodie qw( ! foo bar baz );
308 # bar() and baz() must have their hints defined
309 use autodie qw( foo ! bar baz );
311 # Enable autodie for all of Perl's supported built-ins,
312 # as well as for foo(), bar() and baz(). Everything must
314 use autodie qw( ! :all foo bar baz );
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.
320 Insisting on hints is I<strongly> recommended.
324 # TODO: implement regular expression hints
326 use constant UNDEF_ONLY => sub { not defined $_[0] };
327 use constant EMPTY_OR_UNDEF => sub {
329 @_==1 && !defined $_[0]
332 use constant EMPTY_ONLY => sub { @_ == 0 };
333 use constant EMPTY_OR_FALSE => sub {
338 use constant SINGLE_TRUE => sub { @_ == 1 and not $_[0] };
340 use constant DEFAULT_HINTS => {
341 scalar => UNDEF_ONLY,
342 list => EMPTY_OR_UNDEF,
346 use constant HINTS_PROVIDER => 'autodie::hints::provider';
348 use base qw(Exporter);
352 # Only ( undef ) is a strange but possible situation for very
353 # badly written code. It's not supported yet.
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 },
362 # Start by using Sub::Identify if it exists on this system.
364 eval { require Sub::Identify; Sub::Identify->import('get_code_info'); };
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.
375 *get_code_info = sub ($) {
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;
384 return ($cv->GV->STASH->NAME, $cv->GV->NAME);
390 return join( '::', get_code_info( $_[1] ) );
393 my %Hints_loaded = ();
396 my ($class, $sub) = @_;
398 my ($package) = ( $sub =~ /(.*)::/ );
400 if (not defined $package) {
403 "Internal error in autodie::hints::load_hints - no package found.
407 # Do nothing if we've already tried to load hints for
409 return if $Hints_loaded{$package}++;
411 my $hints_available = 0;
414 no strict 'refs'; ## no critic
416 if ($package->can('DOES') and $package->DOES(HINTS_PROVIDER) ) {
417 $hints_available = 1;
419 elsif ( PERL58 and $package->isa(HINTS_PROVIDER) ) {
420 $hints_available = 1;
422 elsif ( ${"${package}::DOES"}{HINTS_PROVIDER.""} ) {
423 $hints_available = 1;
427 return if not $hints_available;
429 my %package_hints = %{ $package->AUTODIE_HINTS };
431 foreach my $sub (keys %package_hints) {
433 my $hint = $package_hints{$sub};
435 # Ensure we have a package name.
436 $sub = "${package}::$sub" if $sub !~ /::/;
438 # TODO - Currently we don't check for conflicts, should we?
439 $Hints{$sub} = $hint;
441 $class->normalise_hints(\%Hints, $sub);
448 sub normalise_hints {
449 my ($class, $hints, $sub) = @_;
451 if ( exists $hints->{$sub}->{fail} ) {
453 if ( exists $hints->{$sub}->{scalar} or
454 exists $hints->{$sub}->{list}
456 # TODO: Turn into a proper diagnostic.
458 local $Carp::CarpLevel = 1;
459 Carp::croak("fail hints cannot be provided with either scalar or list hints for $sub");
462 # Set our scalar and list hints.
464 $hints->{$sub}->{scalar} =
465 $hints->{$sub}->{list} = delete $hints->{$sub}->{fail};
471 # Check to make sure all our hints exist.
473 foreach my $hint (qw(scalar list)) {
474 if ( not exists $hints->{$sub}->{$hint} ) {
475 # TODO: Turn into a proper diagnostic.
477 local $Carp::CarpLevel = 1;
478 Carp::croak("$hint hint missing for $sub");
486 my ($class, $sub) = @_;
488 my $subname = $class->sub_fullname( $sub );
490 # If we have hints loaded for a sub, then return them.
492 if ( exists $Hints{ $subname } ) {
493 return $Hints{ $subname };
496 # If not, we try to load them...
498 $class->load_hints( $subname );
502 if ( exists $Hints{ $subname } ) {
503 return $Hints{ $subname };
506 # It's the caller's responsibility to use defaults if desired.
507 # This allows on autodie to insist on hints if needed.
514 my ($class, $sub, $hints) = @_;
517 $sub = $class->sub_fullname( $sub );
521 $sub or Carp::croak("Attempts to set_hints_for unidentifiable subroutine");
525 warn "autodie::hints: Setting $sub to hints: $hints\n";
528 $Hints{ $sub } = $hints;
530 $class->normalise_hints(\%Hints, $sub);
544 =item Attempts to set_hints_for unidentifiable subroutine
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.
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.
555 =item fail hints cannot be provided with either scalar or list hints for %s
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.
561 =item %s hint missing for %s
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.
569 =head1 ACKNOWLEDGEMENTS
575 Dr Damian Conway for suggesting the hinting interface and providing the
580 Jacinta Richardson for translating much of my ideas into this
587 Copyright 2009, Paul Fenwick E<lt>pjf@perltraining.com.auE<gt>
591 This module is free software. You may distribute it under the
592 same terms as Perl itself.
596 L<autodie>, L<Class::DOES>