Add support for 'finally' blocks
Andrew Yates [Fri, 22 Jan 2010 17:41:45 +0000 (18:41 +0100)]
lib/Try/Tiny.pm
t/basic.t
t/finally.t [new file with mode: 0644]

index dd330c9..d5b572f 100644 (file)
@@ -14,17 +14,40 @@ $VERSION = "0.02";
 
 $VERSION = eval $VERSION;
 
-@EXPORT = @EXPORT_OK = qw(try catch);
+@EXPORT = @EXPORT_OK = qw(try catch finally);
 
 $Carp::Internal{+__PACKAGE__}++;
 
-sub try (&;$) {
-       my ( $try, $catch ) = @_;
+# Need to prototype as @ not $$ because of the way Perl evaluates the prototype.
+# Keeping it at $$ means you only ever get 1 sub because we need to eval in a list
+# context & not a scalar one
+
+sub try (&;@) {
+       my ( $try, @code_refs ) = @_;
 
        # we need to save this here, the eval block will be in scalar context due
        # to $failed
        my $wantarray = wantarray;
 
+       my ( $catch, $finally );
+
+       # find labeled blocks in the argument list.
+       # catch and finally tag the blocks by blessing a scalar reference to them.
+       foreach my $code_ref (@code_refs) {
+               next unless $code_ref;
+
+               my $ref = ref($code_ref);
+
+               if ( $ref eq 'Try::Tiny::Catch' ) {
+                       $catch = ${$code_ref};
+               } elsif ( $ref eq 'Try::Tiny::Finally' ) {
+                       $finally = ${$code_ref};
+               } else {
+                       use Carp;
+                       confess("Unknown code ref type given '${ref}'. Check your usage & try again");
+               }
+       }
+
        # save the value of $@ so we can set $@ back to it in the beginning of the eval
        my $prev_error = $@;
 
@@ -69,7 +92,13 @@ sub try (&;$) {
                        # This works like given($error), but is backwards compatible and
                        # sets $_ in the dynamic scope for the body of C<$catch>
                        for ($error) {
-                               return $catch->($error);
+                               my $catch_return = $catch->($error);
+
+                               # Finally blocks run after all other blocks so it is executed here
+                               $finally->() if ( $finally );
+
+                               #And return whatever catch returned
+                               return $catch_return;
                        }
 
                        # in case when() was used without an explicit return, the C<for>
@@ -78,15 +107,31 @@ sub try (&;$) {
 
                return;
        } else {
+               # Execute finally block once we decided we worked
+               $finally->() if ( $finally );
+
                # no failure, $@ is back to what it was, everything is fine
                return $wantarray ? @ret : $ret[0];
        }
 }
 
-sub catch (&) {
-       return $_[0];
+sub catch (&;@) {
+       my ( $block, @rest ) = @_;
+
+       return (
+               bless(\$block, 'Try::Tiny::Catch'),
+               @rest,
+       );
 }
 
+sub finally (&;@) {
+       my ( $block, @rest ) = @_;
+
+       return (
+               bless(\$block, 'Try::Tiny::Finally'),
+               @rest,
+       );
+}
 
 __PACKAGE__
 
@@ -114,7 +159,7 @@ Try::Tiny - minimal try/catch with proper localization of $@
 
 =head1 DESCRIPTION
 
-This module provides bare bones C<try>/C<catch> statements that are designed to
+This module provides bare bones C<try>/C<catch>/C<finally> statements that are designed to
 minimize common mistakes with eval blocks, and NOTHING else.
 
 This is unlike L<TryCatch> which provides a nice syntax and avoids adding
@@ -133,7 +178,7 @@ pathological edge cases (see L<BACKGROUND>) and to be compatible with any style
 of error values (simple strings, references, objects, overloaded objects, etc).
 
 If the try block dies, it returns the value of the last statement executed in
-the catch block, if there is one.  Otherwise, it returns C<undef> in scalar
+the catch block, if there is one. Otherwise, it returns C<undef> in scalar
 context or the empty list in list context. The following two examples both
 assign C<"bar"> to C<$x>.
 
@@ -141,18 +186,28 @@ assign C<"bar"> to C<$x>.
 
        my $x = eval { die "foo" } || "bar";
 
+You can add finally blocks making the following true.
+
+       my $x;
+       try { die 'foo' } finally { $x = 'bar' };
+       try { die 'foo' } catch { warn "Got a die: $_" } finally { $x = 'bar' };
+
+Finally blocks are always executed making them suitable for cleanup code
+which cannot be handled using local.
+
 =head1 EXPORTS
 
 All functions are exported by default using L<Exporter>.
 
-If you need to rename the C<try> or C<catch> keyword consider using
+If you need to rename the C<try>, C<catch> or C<finally> keyword consider using
 L<Sub::Import> to get L<Sub::Exporter>'s flexibility.
 
 =over 4
 
-=item try (&;$)
+=item try (&;@)
 
-Takes one mandatory try subroutine and one optional catch subroutine.
+Takes one mandatory try subroutine, an optional catch subroutine & finally
+subroutine.
 
 The mandatory subroutine is evaluated in the context of an C<eval> block.
 
@@ -166,22 +221,51 @@ argument.
 Note that the error may be false, but if that happens the C<catch> block will
 still be invoked.
 
-=item catch (&)
+Once all execution is finished then the finally block if given will execute.
+
+=item catch (&;$)
 
 Intended to be used in the second argument position of C<try>.
 
-Just returns the subroutine it was given.
+Returns a reference to the subroutine it was given but blessed as
+C<Try::Tiny::Catch> which allows try to decode correctly what to do
+with this code reference.
 
        catch { ... }
 
-is the same as
-
-       sub { ... }
-
 Inside the catch block the previous value of C<$@> is still available for use.
 This value may or may not be meaningful depending on what happened before the
 C<try>, but it might be a good idea to preserve it in an error stack.
 
+=item finally (&;$)
+
+  try     { ... }
+  catch   { ... }
+  finally { ... };
+
+Or
+
+  try     { ... }
+  finally { ... };
+
+Or even
+
+  try     { ... }
+  finally { ... }
+  catch   { ... };
+
+Intended to be the second or third element of C<try>. Finally blocks are always
+executed in the event of a successful C<try> or if C<catch> is run. This allows
+you to locate cleanup code which cannot be done via C<local()> e.g. closing a file
+handle.
+
+B<You must always do your own error handling in the finally block>. C<Try::Tiny> will
+not do anything about handling possible errors coming from code located in these
+blocks.
+
+In the same way C<catch()> blesses the code reference this subroutine does the same
+except it bless them as C<Try::Tiny::Finally>.
+
 =back
 
 =head1 BACKGROUND
index 1d257da..ba71ed3 100644 (file)
--- a/t/basic.t
+++ b/t/basic.t
@@ -3,7 +3,7 @@
 use strict;
 #use warnings;
 
-use Test::More tests => 22;
+use Test::More tests => 24;
 
 BEGIN { use_ok 'Try::Tiny' };
 
@@ -75,6 +75,12 @@ throws_ok {
 is( scalar(try { "foo", "bar", "gorch" }), "gorch", "scalar context" );
 is_deeply( [ try {qw(foo bar gorch)} ], [qw(foo bar gorch)], "list context" );
 
+{
+       my ($sub) = catch { my $a = $_; };
+       is(ref($sub), 'Try::Tiny::Catch', 'Checking catch subroutine scalar reference is correctly blessed');
+       my ($sub) = finally { my $a = $_; };
+       is(ref($sub), 'Try::Tiny::Finally', 'Checking finally subroutine scalar reference is correctly blessed');
+}
 
 lives_ok {
        try {
diff --git a/t/finally.t b/t/finally.t
new file mode 100644 (file)
index 0000000..d8bd0d4
--- /dev/null
@@ -0,0 +1,42 @@
+#!/usr/bin/perl
+
+use strict;
+#use warnings;
+
+use Test::More tests => 7;
+
+BEGIN { use_ok 'Try::Tiny' };
+
+try {
+       my $a = 1+1;
+} catch {
+       fail('Cannot go into catch block because we did not throw an exception')
+} finally {
+       pass('Moved into finally from try');
+};
+
+try {
+       die('Die');
+} catch {
+       ok($_ =~ /Die/, 'Error text as expected');
+       pass('Into catch block as we died in try');
+} finally {
+       pass('Moved into finally from catch');
+};
+
+try {
+       die('Die');
+} finally {
+       pass('Moved into finally from catch');
+} catch {
+       ok($_ =~ /Die/, 'Error text as expected');
+};
+
+try {
+       die('Die');
+} finally {
+       pass('Moved into finally block when try throws an exception and we have no catch block');
+};
+
+
+1;