File Coverage

inc/Try/Tiny.pm
Criterion Covered Total %
statement 36 53 67.9
branch 6 18 33.3
condition n/a
subroutine 6 9 66.6
pod 3 3 100.0
total 51 83 61.4


line stmt bran cond sub pod time code
1             #line 1
2             package Try::Tiny;
3 2     2   3693  
  2         5  
  2         94  
4             use strict;
5             #use warnings;
6 2     2   9  
  2         5  
  2         182  
7             use vars qw(@EXPORT @EXPORT_OK $VERSION @ISA);
8              
9 2     2   18 BEGIN {
10 2         350 require Exporter;
11             @ISA = qw(Exporter);
12             }
13              
14             $VERSION = "0.12";
15              
16             $VERSION = eval $VERSION;
17              
18             @EXPORT = @EXPORT_OK = qw(try catch finally);
19              
20             $Carp::Internal{+__PACKAGE__}++;
21              
22             # Need to prototype as @ not $$ because of the way Perl evaluates the prototype.
23             # Keeping it at $$ means you only ever get 1 sub because we need to eval in a list
24             # context & not a scalar one
25              
26 2     2 1 5 sub try (&;@) {
27             my ( $try, @code_refs ) = @_;
28              
29             # we need to save this here, the eval block will be in scalar context due
30 2         3 # to $failed
31             my $wantarray = wantarray;
32 2         3  
33             my ( $catch, @finally );
34              
35             # find labeled blocks in the argument list.
36 2         5 # catch and finally tag the blocks by blessing a scalar reference to them.
37 2 50       7 foreach my $code_ref (@code_refs) {
38             next unless $code_ref;
39 2         3  
40             my $ref = ref($code_ref);
41 2 50       7  
    0          
42 2         2 if ( $ref eq 'Try::Tiny::Catch' ) {
  2         8  
43             $catch = ${$code_ref};
44 0         0 } elsif ( $ref eq 'Try::Tiny::Finally' ) {
  0         0  
45             push @finally, ${$code_ref};
46 2     2   12 } else {
  2         4  
  2         1054  
47 0         0 use Carp;
48             confess("Unknown code ref type given '${ref}'. Check your usage & try again");
49             }
50             }
51              
52 2         5 # save the value of $@ so we can set $@ back to it in the beginning of the eval
53             my $prev_error = $@;
54 2         3  
55             my ( @ret, $error, $failed );
56              
57             # FIXME consider using local $SIG{__DIE__} to accumulate all errors. It's
58             # not perfect, but we could provide a list of additional errors for
59             # $catch->();
60              
61             {
62             # localize $@ to prevent clobbering of previous value by a successful
63 2         2 # eval.
  2         4  
64             local $@;
65              
66             # failed will be true if the eval dies, because 1 will not be returned
67 2         3 # from the eval body
68 2         2 $failed = not eval {
69             $@ = $prev_error;
70              
71 2 50       9 # evaluate the try block in the correct context
    50          
72 0         0 if ( $wantarray ) {
73             @ret = $try->();
74 0         0 } elsif ( defined $wantarray ) {
75             $ret[0] = $try->();
76 2         5 } else {
77             $try->();
78             };
79 0         0  
80             return 1; # properly set $fail to false
81             };
82              
83             # copy $@ to $error; when we leave this scope, local $@ will revert $@
84 2         6 # back to its previous value
85             $error = $@;
86             }
87              
88 0 0       0 # set up a scope guard to invoke the finally block at the end
89 2         4 my @guards =
90             map { Try::Tiny::ScopeGuard->_new($_, $failed ? $error : ()) }
91             @finally;
92              
93             # at this point $failed contains a true value if the eval died, even if some
94 2 50       7 # destructor overwrote $@ as the eval was unwinding.
95             if ( $failed ) {
96 2 50       5 # if we got an error, invoke the catch block.
97             if ( $catch ) {
98             # This works like given($error), but is backwards compatible and
99 2         4 # sets $_ in the dynamic scope for the body of C<$catch>
100 2         7 for ($error) {
101             return $catch->($error);
102             }
103              
104             # in case when() was used without an explicit return, the C
105             # loop will be aborted and there's no useful return value
106             }
107 0         0  
108             return;
109             } else {
110 0 0       0 # no failure, $@ is back to what it was, everything is fine
111             return $wantarray ? @ret : $ret[0];
112             }
113             }
114              
115 2     2 1 4 sub catch (&;@) {
116             my ( $block, @rest ) = @_;
117              
118 2         17 return (
119             bless(\$block, 'Try::Tiny::Catch'),
120             @rest,
121             );
122             }
123              
124 0     0 1   sub finally (&;@) {
125             my ( $block, @rest ) = @_;
126              
127 0           return (
128             bless(\$block, 'Try::Tiny::Finally'),
129             @rest,
130             );
131             }
132              
133             {
134             package # hide from PAUSE
135             Try::Tiny::ScopeGuard;
136              
137 0     0     sub _new {
138 0           shift;
139             bless [ @_ ];
140             }
141              
142 0     0     sub DESTROY {
  0            
143 0           my @guts = @{ shift() };
144 0           my $code = shift @guts;
145             $code->(@guts);
146             }
147             }
148              
149             __PACKAGE__
150              
151             __END__