795272ea0d1bcf0916a96716deecf4e237dc4c4b
[p5sagit/Try-Tiny.git] / lib / Try / Tiny.pm
1 package Try::Tiny;
2
3 use strict;
4 #use warnings;
5
6 use vars qw(@EXPORT @EXPORT_OK $VERSION @ISA);
7
8 BEGIN {
9         require Exporter;
10         @ISA = qw(Exporter);
11 }
12
13 $VERSION = "0.09";
14
15 $VERSION = eval $VERSION;
16
17 @EXPORT = @EXPORT_OK = qw(try catch finally);
18
19 $Carp::Internal{+__PACKAGE__}++;
20
21 # Need to prototype as @ not $$ because of the way Perl evaluates the prototype.
22 # Keeping it at $$ means you only ever get 1 sub because we need to eval in a list
23 # context & not a scalar one
24
25 sub try (&;@) {
26         my ( $try, @code_refs ) = @_;
27
28         # we need to save this here, the eval block will be in scalar context due
29         # to $failed
30         my $wantarray = wantarray;
31
32         my ( $catch, @finally );
33
34         # find labeled blocks in the argument list.
35         # catch and finally tag the blocks by blessing a scalar reference to them.
36         foreach my $code_ref (@code_refs) {
37                 next unless $code_ref;
38
39                 my $ref = ref($code_ref);
40
41                 if ( $ref eq 'Try::Tiny::Catch' ) {
42                         $catch = ${$code_ref};
43                 } elsif ( $ref eq 'Try::Tiny::Finally' ) {
44                         push @finally, ${$code_ref};
45                 } else {
46                         use Carp;
47                         confess("Unknown code ref type given '${ref}'. Check your usage & try again");
48                 }
49         }
50
51         # save the value of $@ so we can set $@ back to it in the beginning of the eval
52         my $prev_error = $@;
53
54         my ( @ret, $error, $failed );
55
56         # FIXME consider using local $SIG{__DIE__} to accumulate all errors. It's
57         # not perfect, but we could provide a list of additional errors for
58         # $catch->();
59
60         {
61                 # localize $@ to prevent clobbering of previous value by a successful
62                 # eval.
63                 local $@;
64
65                 # failed will be true if the eval dies, because 1 will not be returned
66                 # from the eval body
67                 $failed = not eval {
68                         $@ = $prev_error;
69
70                         # evaluate the try block in the correct context
71                         if ( $wantarray ) {
72                                 @ret = $try->();
73                         } elsif ( defined $wantarray ) {
74                                 $ret[0] = $try->();
75                         } else {
76                                 $try->();
77                         };
78
79                         return 1; # properly set $fail to false
80                 };
81
82                 # copy $@ to $error; when we leave this scope, local $@ will revert $@
83                 # back to its previous value
84                 $error = $@;
85         }
86
87         # set up a scope guard to invoke the finally block at the end
88         my @guards =
89     map { Try::Tiny::ScopeGuard->_new($_, $failed ? $error : ()) }
90     @finally;
91
92         # at this point $failed contains a true value if the eval died, even if some
93         # destructor overwrote $@ as the eval was unwinding.
94         if ( $failed ) {
95                 # if we got an error, invoke the catch block.
96                 if ( $catch ) {
97                         # This works like given($error), but is backwards compatible and
98                         # sets $_ in the dynamic scope for the body of C<$catch>
99                         for ($error) {
100                                 return $catch->($error);
101                         }
102
103                         # in case when() was used without an explicit return, the C<for>
104                         # loop will be aborted and there's no useful return value
105                 }
106
107                 return;
108         } else {
109                 # no failure, $@ is back to what it was, everything is fine
110                 return $wantarray ? @ret : $ret[0];
111         }
112 }
113
114 sub catch (&;@) {
115         my ( $block, @rest ) = @_;
116
117         return (
118                 bless(\$block, 'Try::Tiny::Catch'),
119                 @rest,
120         );
121 }
122
123 sub finally (&;@) {
124         my ( $block, @rest ) = @_;
125
126         return (
127                 bless(\$block, 'Try::Tiny::Finally'),
128                 @rest,
129         );
130 }
131
132 {
133   package # hide from PAUSE
134     Try::Tiny::ScopeGuard;
135
136   sub _new {
137     shift;
138     bless [ @_ ];
139   }
140
141   sub DESTROY {
142     my @guts = @{ shift() };
143     my $code = shift @guts;
144     $code->(@guts);
145   }
146 }
147
148 __PACKAGE__
149
150 __END__
151
152 =pod
153
154 =head1 NAME
155
156 Try::Tiny - minimal try/catch with proper localization of $@
157
158 =head1 SYNOPSIS
159
160 You can use Try::Tiny's C<try> and C<catch> to expect and handle exceptional
161 conditions, avoiding quirks in Perl and common mistakes:
162
163         # handle errors with a catch handler
164         try {
165                 die "foo";
166         } catch {
167                 warn "caught error: $_"; # not $@
168         };
169
170 You can also use it like a stanalone C<eval> to catch and ignore any error
171 conditions.  Obviously, this is an extreme measure not to be undertaken
172 lightly:
173
174         # just silence errors
175         try {
176                 die "foo";
177         };
178
179 =head1 DESCRIPTION
180
181 This module provides bare bones C<try>/C<catch>/C<finally> statements that are designed to
182 minimize common mistakes with eval blocks, and NOTHING else.
183
184 This is unlike L<TryCatch> which provides a nice syntax and avoids adding
185 another call stack layer, and supports calling C<return> from the try block to
186 return from the parent subroutine. These extra features come at a cost of a few
187 dependencies, namely L<Devel::Declare> and L<Scope::Upper> which are
188 occasionally problematic, and the additional catch filtering uses L<Moose>
189 type constraints which may not be desirable either.
190
191 The main focus of this module is to provide simple and reliable error handling
192 for those having a hard time installing L<TryCatch>, but who still want to
193 write correct C<eval> blocks without 5 lines of boilerplate each time.
194
195 It's designed to work as correctly as possible in light of the various
196 pathological edge cases (see L<BACKGROUND>) and to be compatible with any style
197 of error values (simple strings, references, objects, overloaded objects, etc).
198
199 If the try block dies, it returns the value of the last statement executed in
200 the catch block, if there is one. Otherwise, it returns C<undef> in scalar
201 context or the empty list in list context. The following two examples both
202 assign C<"bar"> to C<$x>.
203
204         my $x = try { die "foo" } catch { "bar" };
205
206         my $x = eval { die "foo" } || "bar";
207
208 You can add finally blocks making the following true.
209
210         my $x;
211         try { die 'foo' } finally { $x = 'bar' };
212         try { die 'foo' } catch { warn "Got a die: $_" } finally { $x = 'bar' };
213
214 Finally blocks are always executed making them suitable for cleanup code
215 which cannot be handled using local.  You can add as many finally blocks to a
216 given try block as you like.
217
218 =head1 EXPORTS
219
220 All functions are exported by default using L<Exporter>.
221
222 If you need to rename the C<try>, C<catch> or C<finally> keyword consider using
223 L<Sub::Import> to get L<Sub::Exporter>'s flexibility.
224
225 =over 4
226
227 =item try (&;@)
228
229 Takes one mandatory try subroutine, an optional catch subroutine & finally
230 subroutine.
231
232 The mandatory subroutine is evaluated in the context of an C<eval> block.
233
234 If no error occurred the value from the first block is returned, preserving
235 list/scalar context.
236
237 If there was an error and the second subroutine was given it will be invoked
238 with the error in C<$_> (localized) and as that block's first and only
239 argument.
240
241 C<$@> does B<not> contain the error. Inside the C<catch> block it has the same
242 value it had before the C<try> block was executed.
243
244 Note that the error may be false, but if that happens the C<catch> block will
245 still be invoked.
246
247 Once all execution is finished then the finally block if given will execute.
248
249 =item catch (&;$)
250
251 Intended to be used in the second argument position of C<try>.
252
253 Returns a reference to the subroutine it was given but blessed as
254 C<Try::Tiny::Catch> which allows try to decode correctly what to do
255 with this code reference.
256
257         catch { ... }
258
259 Inside the catch block the caught error is stored in C<$_>, while previous
260 value of C<$@> is still available for use.  This value may or may not be
261 meaningful depending on what happened before the C<try>, but it might be a good
262 idea to preserve it in an error stack.
263
264 For code that captures C<$@> when throwing new errors (i.e.
265 L<Class::Throwable>), you'll need to do:
266
267         local $@ = $_;
268
269 =item finally (&;$)
270
271   try     { ... }
272   catch   { ... }
273   finally { ... };
274
275 Or
276
277   try     { ... }
278   finally { ... };
279
280 Or even
281
282   try     { ... }
283   finally { ... }
284   catch   { ... };
285
286 Intended to be the second or third element of C<try>. Finally blocks are always
287 executed in the event of a successful C<try> or if C<catch> is run. This allows
288 you to locate cleanup code which cannot be done via C<local()> e.g. closing a file
289 handle.
290
291 When invoked, the finally block is passed the error that was caught.  If no
292 error was caught, it is passed nothing.  In other words, the following code
293 does just what you would expect:
294
295   try {
296     die_sometimes();
297   } catch {
298     # ...code run in case of error
299   } finally {
300     if (@_) {
301       print "The try block died with: @_\n";
302     } else {
303       print "The try block ran without error.\n";
304     }
305   };
306
307 B<You must always do your own error handling in the finally block>. C<Try::Tiny> will
308 not do anything about handling possible errors coming from code located in these
309 blocks.
310
311 In the same way C<catch()> blesses the code reference this subroutine does the same
312 except it bless them as C<Try::Tiny::Finally>.
313
314 =back
315
316 =head1 BACKGROUND
317
318 There are a number of issues with C<eval>.
319
320 =head2 Clobbering $@
321
322 When you run an eval block and it succeeds, C<$@> will be cleared, potentially
323 clobbering an error that is currently being caught.
324
325 This causes action at a distance, clearing previous errors your caller may have
326 not yet handled.
327
328 C<$@> must be properly localized before invoking C<eval> in order to avoid this
329 issue.
330
331 More specifically, C<$@> is clobbered at the beginning of the C<eval>, which
332 also makes it impossible to capture the previous error before you die (for
333 instance when making exception objects with error stacks).
334
335 For this reason C<try> will actually set C<$@> to its previous value (before
336 the localization) in the beginning of the C<eval> block.
337
338 =head2 Localizing $@ silently masks errors
339
340 Inside an eval block C<die> behaves sort of like:
341
342         sub die {
343                 $@ = $_[0];
344                 return_undef_from_eval();
345         }
346
347 This means that if you were polite and localized C<$@> you can't die in that
348 scope, or your error will be discarded (printing "Something's wrong" instead).
349
350 The workaround is very ugly:
351
352         my $error = do {
353                 local $@;
354                 eval { ... };
355                 $@;
356         };
357
358         ...
359         die $error;
360
361 =head2 $@ might not be a true value
362
363 This code is wrong:
364
365         if ( $@ ) {
366                 ...
367         }
368
369 because due to the previous caveats it may have been unset.
370
371 C<$@> could also be an overloaded error object that evaluates to false, but
372 that's asking for trouble anyway.
373
374 The classic failure mode is:
375
376         sub Object::DESTROY {
377                 eval { ... }
378         }
379
380         eval {
381                 my $obj = Object->new;
382
383                 die "foo";
384         };
385
386         if ( $@ ) {
387
388         }
389
390 In this case since C<Object::DESTROY> is not localizing C<$@> but still uses
391 C<eval>, it will set C<$@> to C<"">.
392
393 The destructor is called when the stack is unwound, after C<die> sets C<$@> to
394 C<"foo at Foo.pm line 42\n">, so by the time C<if ( $@ )> is evaluated it has
395 been cleared by C<eval> in the destructor.
396
397 The workaround for this is even uglier than the previous ones. Even though we
398 can't save the value of C<$@> from code that doesn't localize, we can at least
399 be sure the eval was aborted due to an error:
400
401         my $failed = not eval {
402                 ...
403
404                 return 1;
405         };
406
407 This is because an C<eval> that caught a C<die> will always return a false
408 value.
409
410 =head1 SHINY SYNTAX
411
412 Using Perl 5.10 you can use L<perlsyn/"Switch statements">.
413
414 The C<catch> block is invoked in a topicalizer context (like a C<given> block),
415 but note that you can't return a useful value from C<catch> using the C<when>
416 blocks without an explicit C<return>.
417
418 This is somewhat similar to Perl 6's C<CATCH> blocks. You can use it to
419 concisely match errors:
420
421         try {
422                 require Foo;
423         } catch {
424                 when (/^Can't locate .*?\.pm in \@INC/) { } # ignore
425                 default { die $_ }
426         };
427
428 =head1 CAVEATS
429
430 =over 4
431
432 =item *
433
434 C<@_> is not available within the C<try> block, so you need to copy your
435 arglist. In case you want to work with argument values directly via C<@_>
436 aliasing (i.e. allow C<$_[1] = "foo">), you need to pass C<@_> by reference:
437
438         sub foo {
439                 my ( $self, @args ) = @_;
440                 try { $self->bar(@args) }
441         }
442
443 or
444
445         sub bar_in_place {
446                 my $self = shift;
447                 my $args = \@_;
448                 try { $_ = $self->bar($_) for @$args }
449         }
450
451 =item *
452
453 C<return> returns from the C<try> block, not from the parent sub (note that
454 this is also how C<eval> works, but not how L<TryCatch> works):
455
456         sub bar {
457                 try { return "foo" };
458                 return "baz";
459         }
460
461         say bar(); # "baz"
462
463 =item *
464
465 C<try> introduces another caller stack frame. L<Sub::Uplevel> is not used. L<Carp>
466 will not report this when using full stack traces, though, because
467 C<%Carp::Internal> is used. This lack of magic is considered a feature.
468
469 =item *
470
471 The value of C<$_> in the C<catch> block is not guaranteed to be the value of
472 the exception thrown (C<$@>) in the C<try> block.  There is no safe way to
473 ensure this, since C<eval> may be used unhygenically in destructors.  The only
474 guarantee is that the C<catch> will be called if an exception is thrown.
475
476 =item *
477
478 The return value of the C<catch> block is not ignored, so if testing the result
479 of the expression for truth on success, be sure to return a false value from
480 the C<catch> block:
481
482         my $obj = try {
483                 MightFail->new;
484         } catch {
485                 ...
486
487                 return; # avoid returning a true value;
488         };
489
490         return unless $obj;
491
492 =item *
493
494 C<$SIG{__DIE__}> is still in effect.
495
496 Though it can be argued that C<$SIG{__DIE__}> should be disabled inside of
497 C<eval> blocks, since it isn't people have grown to rely on it. Therefore in
498 the interests of compatibility, C<try> does not disable C<$SIG{__DIE__}> for
499 the scope of the error throwing code.
500
501 =item *
502
503 Lexical C<$_> may override the one set by C<catch>.
504
505 For example Perl 5.10's C<given> form uses a lexical C<$_>, creating some
506 confusing behavior:
507
508         given ($foo) {
509                 when (...) {
510                         try {
511                                 ...
512                         } catch {
513                                 warn $_; # will print $foo, not the error
514                                 warn $_[0]; # instead, get the error like this
515                         }
516                 }
517         }
518
519 =back
520
521 =head1 SEE ALSO
522
523 =over 4
524
525 =item L<TryCatch>
526
527 Much more feature complete, more convenient semantics, but at the cost of
528 implementation complexity.
529
530 =item L<autodie>
531
532 Automatic error throwing for builtin functions and more. Also designed to
533 work well with C<given>/C<when>.
534
535 =item L<Throwable>
536
537 A lightweight role for rolling your own exception classes.
538
539 =item L<Error>
540
541 Exception object implementation with a C<try> statement. Does not localize
542 C<$@>.
543
544 =item L<Exception::Class::TryCatch>
545
546 Provides a C<catch> statement, but properly calling C<eval> is your
547 responsibility.
548
549 The C<try> keyword pushes C<$@> onto an error stack, avoiding some of the
550 issues with C<$@>, but you still need to localize to prevent clobbering.
551
552 =back
553
554 =head1 LIGHTNING TALK
555
556 I gave a lightning talk about this module, you can see the slides (Firefox
557 only):
558
559 L<http://nothingmuch.woobling.org/talks/takahashi.xul?data=yapc_asia_2009/try_tiny.txt>
560
561 Or read the source:
562
563 L<http://nothingmuch.woobling.org/talks/yapc_asia_2009/try_tiny.yml>
564
565 =head1 VERSION CONTROL
566
567 L<http://github.com/nothingmuch/try-tiny/>
568
569 =head1 AUTHOR
570
571 Yuval Kogman E<lt>nothingmuch@woobling.orgE<gt>
572
573 =head1 COPYRIGHT
574
575         Copyright (c) 2009 Yuval Kogman. All rights reserved.
576         This program is free software; you can redistribute
577         it and/or modify it under the terms of the MIT license.
578
579 =cut
580