This is a live mirror of the Perl 5 development currently hosted at https://github.com/perl/perl5
bump autodie version for blead test fix
[perl5.git] / cpan / autodie / lib / autodie / hints.pm
CommitLineData
9b657a62
PF
1package autodie::hints;
2
3use strict;
4use warnings;
5
eb8d423f
PF
6use constant PERL58 => ( $] < 5.009 );
7
c2512f8a 8our $VERSION = '2.1001';
9b657a62
PF
9
10=head1 NAME
11
12autodie::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
57The L<autodie> pragma is very smart when it comes to working with
58Perl's built-in functions. The behaviour for these functions are
59fixed, and C<autodie> knows exactly how they try to signal failure.
60
61But what about user-defined subroutines from modules? If you use
62C<autodie> on a user-defined subroutine then it assumes the following
63behaviour to demonstrate failure:
64
65=over
66
67=item *
68
69A false value, in scalar context
70
71=item *
72
73An empty list, in list context
74
75=item *
76
77A list containing a single undef, in list context
78
79=back
80
81All other return values (including the list of the single zero, and the
82list containing a single empty string) are considered successful. However,
83real-world code isn't always that easy. Perhaps the code you're working
eb8d423f 84with returns a string containing the word "FAIL" upon failure, or a
9b657a62
PF
85two element list containing C<(undef, "human error message")>. To make
86autodie work with these sorts of subroutines, we have
87the I<hinting interface>.
88
89The hinting interface allows I<hints> to be provided to C<autodie>
90on how it should detect failure from user-defined subroutines. While
91these I<can> be provided by the end-user of C<autodie>, they are ideally
92written into the module itself, or into a helper module or sub-class
93of C<autodie> itself.
94
95=head2 What are hints?
96
97A I<hint> is a subroutine or value that is checked against the
98return value of an autodying subroutine. If the match returns true,
eb8d423f 99C<autodie> considers the subroutine to have failed.
9b657a62
PF
100
101If the hint provided is a subroutine, then C<autodie> will pass
102the complete return value to that subroutine. If the hint is
103any other value, then C<autodie> will smart-match against the
eb8d423f 104value provided. In Perl 5.8.x there is no smart-match operator, and as such
9b657a62
PF
105only subroutine hints are supported in these versions.
106
eb8d423f 107Hints can be provided for both scalar and list contexts. Note
9b657a62
PF
108that an autodying subroutine will never see a void context, as
109C<autodie> always needs to capture the return value for examination.
110Autodying subroutines called in void context act as if they're called
111in a scalar context, but their return value is discarded after it
112has been checked.
113
114=head2 Example hints
115
116Hints may consist of scalars, array references, regular expressions and
117subroutine references. You can specify different hints for how
118failure should be identified in scalar and list contexts.
119
120These examples apply for use in the C<AUTODIE_HINTS> subroutine and when
121calling C<autodie::hints->set_hints_for()>.
122
123The 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
eb8d423f 134 # List failures always return an empty list:
9b657a62
PF
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 }
eb8d423f 163 );
9b657a62
PF
164
165This "in all contexts" construction is very common, and can be
166abbreviated, using the 'fail' key. This sets both the C<scalar>
167and 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
195If you are using a module which returns something special on failure, then
196you can manually create hints for each of the desired subroutines. Once
197the hints are specified, they are available for all files and modules loaded
198thereafter, thus you can move this work into a module and it will still
199work.
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
216It is possible to pass either a subroutine reference (recommended) or a fully
217qualified subroutine name as the first argument. This means you can set hints
218on 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
225This technique is most useful when you have a project that uses a
226lot of third-party modules. You can define all your possible hints
227in one-place. This can even be in a sub-class of autodie. For
228example:
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
239You can now C<use my::autodie>, which will work just like the standard
240C<autodie>, but is now aware of any hints that you've set.
241
242=head1 Adding hints to your module
243
244C<autodie> provides a passive interface to allow you to declare hints for
245your module. These hints will be found and used by C<autodie> if it
246is loaded, but otherwise have no effect (or dependencies) without autodie.
247To set these, your module needs to declare that it I<does> the
248C<autodie::hints::provider> role. This can be done by writing your
249own C<DOES> method, using a system such as C<Class::DOES> to handle
250the heavy-lifting for you, or declaring a C<%DOES> package variable
251with a C<autodie::hints::provider> key and a corresponding true value.
252
253Note that checking for a C<%DOES> hash is an C<autodie>-only
254short-cut. Other modules do not use this mechanism for checking
255roles, although you can use the C<Class::DOES> module from the
256CPAN to allow it.
257
258In addition, you must define a C<AUTODIE_HINTS> subroutine that returns
259a hash-reference containing the hints for your subroutines:
260
eb8d423f 261 package Your::Module;
9b657a62
PF
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
284This allows your code to set hints without relying on C<autodie> and
285C<autodie::hints> being loaded, or even installed. In this way your
286code can do the right thing when C<autodie> is installed, but does not
287need to depend upon it to function.
288
289=head1 Insisting on hints
290
291When a user-defined subroutine is wrapped by C<autodie>, it will
292use hints if they are available, and otherwise reverts to the
293I<default behaviour> described in the introduction of this document.
294This can be problematic if we expect a hint to exist, but (for
295whatever reason) it has not been loaded.
296
297We can ask autodie to I<insist> that a hint be used by prefixing
298an exclamation mark to the start of the subroutine name. A lone
299exclamation mark indicates that I<all> subroutines after it must
300have 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
316If hints are not available for the specified subroutines, this will cause a
317compile-time error. Insisting on hints for Perl's built-in functions
318(eg, C<open> and C<close>) is always successful.
319
320Insisting on hints is I<strongly> recommended.
321
322=cut
323
324# TODO: implement regular expression hints
325
326use constant UNDEF_ONLY => sub { not defined $_[0] };
327use constant EMPTY_OR_UNDEF => sub {
328 ! @_ or
329 @_==1 && !defined $_[0]
330};
331
332use constant EMPTY_ONLY => sub { @_ == 0 };
333use constant EMPTY_OR_FALSE => sub {
334 ! @_ or
335 @_==1 && !$_[0]
336};
337
eb8d423f
PF
338use constant SINGLE_TRUE => sub { @_ == 1 and not $_[0] };
339
9b657a62
PF
340use constant DEFAULT_HINTS => {
341 scalar => UNDEF_ONLY,
342 list => EMPTY_OR_UNDEF,
343};
344
eb8d423f 345
9b657a62
PF
346use constant HINTS_PROVIDER => 'autodie::hints::provider';
347
348use base qw(Exporter);
349
350our $DEBUG = 0;
351
352# Only ( undef ) is a strange but possible situation for very
353# badly written code. It's not supported yet.
354
9b657a62 355my %Hints = (
eb8d423f
PF
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 },
9b657a62
PF
360);
361
362# Start by using Sub::Identify if it exists on this system.
363
364eval { 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
370if ($@) {
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
389sub sub_fullname {
390 return join( '::', get_code_info( $_[1] ) );
391}
392
393my %Hints_loaded = ();
394
395sub 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 }
eb8d423f
PF
419 elsif ( PERL58 and $package->isa(HINTS_PROVIDER) ) {
420 $hints_available = 1;
421 }
9b657a62
PF
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
448sub 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
485sub 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
513sub 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
5351;
536
537__END__
538
539
540=head1 Diagnostics
541
542=over 4
543
544=item Attempts to set_hints_for unidentifiable subroutine
545
546You've called C<< autodie::hints->set_hints_for() >> using a subroutine
547reference, but that reference could not be resolved back to a
548subroutine name. It may be an anonymous subroutine (which can't
549be made autodying), or may lack a name for other reasons.
550
551If you receive this error with a subroutine that has a real name,
552then you may have found a bug in autodie. See L<autodie/BUGS>
553for how to report this.
554
555=item fail hints cannot be provided with either scalar or list hints for %s
556
557When defining hints, you can either supply both C<list> and
558C<scalar> keywords, I<or> you can provide a single C<fail> keyword.
559You can't mix and match them.
560
561=item %s hint missing for %s
562
563You've provided either a C<scalar> hint without supplying
564a C<list> hint, or vice-versa. You I<must> supply both C<scalar>
565and C<list> hints, I<or> a single C<fail> hint.
566
567=back
568
569=head1 ACKNOWLEDGEMENTS
570
571=over
572
573=item *
574
575Dr Damian Conway for suggesting the hinting interface and providing the
576example usage.
577
578=item *
579
580Jacinta Richardson for translating much of my ideas into this
581documentation.
582
583=back
584
585=head1 AUTHOR
586
587Copyright 2009, Paul Fenwick E<lt>pjf@perltraining.com.auE<gt>
588
589=head1 LICENSE
590
591This module is free software. You may distribute it under the
592same terms as Perl itself.
593
594=head1 SEE ALSO
595
596L<autodie>, L<Class::DOES>
597
598=cut