1package Try::Catch;
2use strict;
3use warnings;
4use Carp;
5$Carp::Internal{+__PACKAGE__}++;
6use base 'Exporter';
7our @EXPORT = our @EXPORT_OK = qw(try catch finally);
8our $VERSION = '1.1.0';
9
10sub _default_catch {
11    croak $_[0];
12}
13
14sub try(&;@) {
15    my $wantarray =  wantarray;
16    my $try       = shift;
17    my $caller    = pop;
18    my $finally   = pop;
19    my $catch     = pop;
20
21    if (!$caller || $caller ne __PACKAGE__){
22        croak "syntax error after try block \n" .
23                "usage : \n" .
24                "try { ... } catch { ... }; \n" .
25                "try { ... } finally { ... }; \n" .
26                "try { ... } catch { ... } finally { ... }; ";
27    }
28
29    #sane behaviour is to throw an error
30    #if there is no catch block
31    if (!$catch){
32        $catch = \&_default_catch;
33    }
34
35    my @ret;
36    my $prev_error = $@;
37    my $fail = not eval {
38        $@ = $prev_error;
39        if (!defined $wantarray) {
40            $try->();
41        } elsif (!$wantarray) {
42            $ret[0] = $try->();
43        } else {
44            @ret = $try->();
45        }
46        return 1;
47    };
48
49    my $error = $@;
50
51    if ($fail) {
52        my $ret = not eval {
53            $@ = $prev_error;
54            for ($error) {
55                if (!defined $wantarray) {
56                    $catch->($error);
57                } elsif (!$wantarray) {
58                    $ret[0] = $catch->($error);
59                } else {
60                    @ret = $catch->($error);
61                }
62                last; ## seems to boost speed by 7%
63            }
64            return 1;
65        };
66
67        if ($ret){
68            my $catch_error = $@;
69            if ($finally) {
70                $@ = $prev_error;
71                $finally->($error);
72            }
73            croak $catch_error;
74        }
75    }
76
77    if ($finally) {
78        $@ = $prev_error;
79        $finally->( $fail ? $error : () );
80    }
81
82    $@ = $prev_error;
83    return $wantarray ? @ret : $ret[0];
84}
85
86sub catch(&;@) {
87    croak 'Useless bare catch()' unless wantarray;
88    if (@_ > 1){
89        croak "syntax error after catch block - maybe a missing semicolon"
90            if !$_[2] || $_[2] ne __PACKAGE__;
91    } else {
92        return ( shift,  undef, __PACKAGE__);
93    }
94    return (@_);
95}
96
97sub finally(&;@) {
98    croak 'Useless bare finally()' unless wantarray;
99    if (@_ > 1) {
100        croak "syntax error after finally block - maybe a missing semicolon";
101    }
102    return ( shift, __PACKAGE__ );
103}
104
1051;
106
107__END__
108=head1 NAME
109
110Try::Catch - Try Catch exception handler based on Try::Tiny But faster
111
112=for html
113<a href="https://travis-ci.org/mamod/try-catch"><img src="https://travis-ci.org/mamod/try-catch.svg?branch=master"></a>
114
115=head1 SYNOPSIS
116
117    use Try::Catch;
118
119    try {
120        die "something went wrong";
121    } catch {
122
123    } finally {
124
125        ##some cleanup code
126
127    }; ##<--- semi colon is required.
128
129=head1 DESCRIPTION
130
131A small, fast, try catch blocks for perl, it's inspired and mostly copied from L<Try::Tiny> but with some
132modifications to boost execution speed, see L</Benchmarks>.
133
134I published a new module instead of contributing to Try::Tiny directly because I had to break some
135features available in Try::Tiny some to boost speed and some because I didn't like.
136
137=head1 Differences
138
139=over 4
140
141=item no multiple finally blocks
142
143=item try must be followed by catch, catch then finally, or finally
144
145this behaves exactly as how other implementations of try catch blocks
146
147=item if there is no catch block error will throw
148
149in case of try followed by finally block and no catch block, finally block will be fired
150then an exception will be thrown, this is also the default behaviour of try catch in other
151languages.
152
153=back
154
155=head1 CAVEATS
156
157Same as L<Try::Tiny/CAVEATS>
158
159=head1 Benchmarks
160
161This is not totally fair but please consider Try::Catch a stripped Try::Tiny version
162with no blessing and no usage of Sub::Name, so it must be faster, right! :)
163
164This is a simple test with just a try catch blocks with no exception
165
166    |  Module:      | Rate          | %         |
167    |-------------------------------------------|
168    |  Try::Tiny    | 98425/s       | -68%      |
169    |  Try::Catch   | 304878/s      | 210%      |
170
171
172Test with Try Catch, Finally Blocks, No Exception
173
174    |  Module:      | Rate          | %         |
175    |-------------------------------------------|
176    |  Try::Tiny    | 60423/s       | -75%      |
177    |  Try::Catch   | 245700/s      | 304%      |
178
179
180Test with Try, Catch, Finally Blocks, AND Exception
181
182    |  Module:      | Rate          | %         |
183    |-------------------------------------------|
184    |  Try::Tiny    | 41288/s       | -65%      |
185    |  Try::Catch   | 116414/s      | 182%      |
186
187
188I've also tested against L<TryCatch> and the results were good, considering
189that L<TryCatch> is an XS module
190
191    |  Module:      |  timing 500000 iterations                              |
192    |----------------------------------------------------------------------- |
193    |  TryCatch     |  1 secs (0.58 usr + 0.00 sys = 0.58 CPU) @ 865051.90/s |
194    |  Try::Catch   |  2 secs (1.73 usr + 0.00 sys = 1.73 CPU) @ 288350.63/s |
195    |  Try::Tiny    |  6 secs (6.16 usr + 0.02 sys = 6.17 CPU) @ 81011.02/s  |
196
197
198Benchmarks included in this dist inside bench folder
199
200=head1 See Also
201
202=over 4
203
204=item L<Try::Tiny>
205
206=item L<TryCatch>
207
208=back
209
210=head1 Known Bugs
211
212When doing block jump from try { } or catch { } then finally will not be called.
213
214For example
215
216    use Try::Catch;
217    for (1) {
218        try {
219            die;
220        } catch {
221            goto skip;
222        } finally {
223            #finally will not be called
224            print "finally was called\n";
225        }
226    }
227    skip:
228
229finally will work in most cases unless there is a block jump (last, goto, exit, ..)
230so I recommend avoid using finally at all as it's planned to be removed in v2.0.0
231
232=head1 AUTHOR
233
234Mamod A. Mehyar, E<lt>mamod.mehyar@gmail.comE<gt>
235
236=head1 LICENSE
237
238This library is free software; you can redistribute it and/or modify
239it under the same terms as Perl itself
240