line |
stmt |
bran |
cond |
sub |
pod |
time |
code |
1
|
|
|
|
|
|
|
package Syntax::Feature::Try; |
2
|
|
|
|
|
|
|
|
3
|
26
|
|
|
26
|
|
2161130
|
use 5.014; |
|
26
|
|
|
|
|
79
|
|
|
26
|
|
|
|
|
897
|
|
4
|
26
|
|
|
26
|
|
107
|
use strict; |
|
26
|
|
|
|
|
36
|
|
|
26
|
|
|
|
|
625
|
|
5
|
26
|
|
|
26
|
|
111
|
use warnings; |
|
26
|
|
|
|
|
31
|
|
|
26
|
|
|
|
|
563
|
|
6
|
26
|
|
|
26
|
|
98
|
use XSLoader; |
|
26
|
|
|
|
|
29
|
|
|
26
|
|
|
|
|
533
|
|
7
|
26
|
|
|
26
|
|
98
|
use Scalar::Util qw/ blessed /; |
|
26
|
|
|
|
|
39
|
|
|
26
|
|
|
|
|
1583
|
|
8
|
|
|
|
|
|
|
|
9
|
|
|
|
|
|
|
BEGIN { |
10
|
26
|
|
|
26
|
|
56
|
our $VERSION = '1.000'; |
11
|
26
|
|
|
|
|
22403
|
XSLoader::load(); |
12
|
|
|
|
|
|
|
} |
13
|
|
|
|
|
|
|
|
14
|
|
|
|
|
|
|
sub install { |
15
|
56
|
|
|
56
|
0
|
136819
|
$^H{+HINTKEY_ENABLED} = 1; |
16
|
|
|
|
|
|
|
} |
17
|
|
|
|
|
|
|
|
18
|
|
|
|
|
|
|
sub uninstall { |
19
|
1
|
|
|
1
|
0
|
137
|
$^H{+HINTKEY_ENABLED} = 0; |
20
|
|
|
|
|
|
|
} |
21
|
|
|
|
|
|
|
|
22
|
|
|
|
|
|
|
# TODO convert "our" to "my" variables |
23
|
|
|
|
|
|
|
our $return_values; |
24
|
|
|
|
|
|
|
|
25
|
|
|
|
|
|
|
sub _statement { |
26
|
249
|
|
|
249
|
|
298991
|
my ($try_block, $catch_list, $finally_block) = @_; |
27
|
|
|
|
|
|
|
|
28
|
249
|
|
|
|
|
15453
|
my $stm_handler = bless {finally => $finally_block}, __PACKAGE__; |
29
|
|
|
|
|
|
|
|
30
|
249
|
|
|
|
|
14622
|
local $@; |
31
|
249
|
|
|
|
|
15507
|
my $exception = run_block($stm_handler, $try_block, 1); |
32
|
248
|
100
|
100
|
|
|
4388456
|
if ($exception and $catch_list) { |
33
|
124
|
|
|
|
|
49908
|
my $catch_block = _get_exception_handler($exception, $catch_list); |
34
|
124
|
100
|
|
|
|
10694
|
if ($catch_block) { |
35
|
123
|
|
|
|
|
10943
|
$exception = run_block($stm_handler, $catch_block, 1, $exception); |
36
|
|
|
|
|
|
|
} |
37
|
|
|
|
|
|
|
} |
38
|
|
|
|
|
|
|
|
39
|
248
|
100
|
|
|
|
101093
|
if ($finally_block) { |
40
|
164
|
|
|
|
|
15230
|
delete $stm_handler->{finally}; |
41
|
164
|
|
|
|
|
15632
|
run_block($stm_handler, $finally_block); |
42
|
|
|
|
|
|
|
} |
43
|
|
|
|
|
|
|
|
44
|
246
|
100
|
|
|
|
63751
|
if ($exception) { |
45
|
12
|
|
|
|
|
42
|
_rethrow($exception); |
46
|
|
|
|
|
|
|
} |
47
|
|
|
|
|
|
|
|
48
|
234
|
|
|
|
|
15247
|
$return_values = $stm_handler->{return}; |
49
|
234
|
|
|
|
|
15364
|
return $stm_handler->{return}; |
50
|
|
|
|
|
|
|
} |
51
|
|
|
|
|
|
|
|
52
|
|
|
|
|
|
|
sub DESTROY { |
53
|
249
|
|
|
249
|
|
19377
|
my ($self) = @_; |
54
|
249
|
100
|
|
|
|
46694
|
run_block($self, $self->{finally}) if $self->{finally}; |
55
|
|
|
|
|
|
|
} |
56
|
|
|
|
|
|
|
|
57
|
|
|
|
|
|
|
sub _get_exception_handler { |
58
|
124
|
|
|
124
|
|
9683
|
my ($exception, $catch_list) = @_; |
59
|
|
|
|
|
|
|
|
60
|
124
|
|
|
|
|
10063
|
foreach my $item (@{ $catch_list }) { |
|
124
|
|
|
|
|
19633
|
|
61
|
172
|
|
|
|
|
18336
|
my ($block_ref, @args) = @$item; |
62
|
172
|
100
|
|
|
|
18147
|
return $block_ref if _exception_match_args($exception, @args); |
63
|
|
|
|
|
|
|
} |
64
|
|
|
|
|
|
|
} |
65
|
|
|
|
|
|
|
|
66
|
|
|
|
|
|
|
sub _exception_match_args { |
67
|
172
|
|
|
172
|
|
17918
|
my ($exception, $className) = @_; |
68
|
|
|
|
|
|
|
|
69
|
172
|
100
|
|
|
|
18200
|
return 1 if not defined $className; # without args catch all exceptions |
70
|
|
|
|
|
|
|
|
71
|
151
|
100
|
|
|
|
18848
|
if (Moose::Util::TypeConstraints->can('find_type_constraint')) { |
72
|
6
|
|
|
|
|
15
|
my $type = Moose::Util::TypeConstraints::find_type_constraint($className); |
73
|
6
|
50
|
|
|
|
891
|
return $type->check($exception) if $type; |
74
|
|
|
|
|
|
|
} |
75
|
|
|
|
|
|
|
|
76
|
145
|
|
100
|
|
|
46471
|
return blessed($exception) && $exception->isa($className); |
77
|
|
|
|
|
|
|
} |
78
|
|
|
|
|
|
|
|
79
|
|
|
|
|
|
|
sub _rethrow { |
80
|
12
|
|
|
12
|
|
14
|
my ($exception) = @_; |
81
|
12
|
|
|
|
|
52
|
local $SIG{__DIE__} = undef; |
82
|
12
|
|
|
|
|
59
|
die $exception; |
83
|
|
|
|
|
|
|
} |
84
|
|
|
|
|
|
|
|
85
|
|
|
|
|
|
|
sub _get_return_value { |
86
|
103
|
|
|
103
|
|
7241
|
my $return = $return_values; |
87
|
103
|
|
|
|
|
6665
|
undef $return_values; |
88
|
|
|
|
|
|
|
|
89
|
103
|
100
|
|
|
|
19584
|
return wantarray ? @$return : $return->[0]; |
90
|
|
|
|
|
|
|
} |
91
|
|
|
|
|
|
|
|
92
|
|
|
|
|
|
|
1; |
93
|
|
|
|
|
|
|
|
94
|
|
|
|
|
|
|
__END__ |
95
|
|
|
|
|
|
|
|
96
|
|
|
|
|
|
|
=pod |
97
|
|
|
|
|
|
|
|
98
|
|
|
|
|
|
|
=head1 NAME |
99
|
|
|
|
|
|
|
|
100
|
|
|
|
|
|
|
Syntax::Feature::Try - try/catch/finally statement for exception handling |
101
|
|
|
|
|
|
|
|
102
|
|
|
|
|
|
|
=head1 SYNOPSIS |
103
|
|
|
|
|
|
|
|
104
|
|
|
|
|
|
|
use syntax 'try'; |
105
|
|
|
|
|
|
|
|
106
|
|
|
|
|
|
|
try { |
107
|
|
|
|
|
|
|
# run this code and handle errors |
108
|
|
|
|
|
|
|
} |
109
|
|
|
|
|
|
|
catch (My::Class::Err $e) { |
110
|
|
|
|
|
|
|
# handle exception based on class "My::Class::Err" |
111
|
|
|
|
|
|
|
} |
112
|
|
|
|
|
|
|
catch ($e) { |
113
|
|
|
|
|
|
|
# handle other exceptions |
114
|
|
|
|
|
|
|
} |
115
|
|
|
|
|
|
|
finally { |
116
|
|
|
|
|
|
|
# cleanup block |
117
|
|
|
|
|
|
|
} |
118
|
|
|
|
|
|
|
|
119
|
|
|
|
|
|
|
=head1 DESCRIPTION |
120
|
|
|
|
|
|
|
|
121
|
|
|
|
|
|
|
This module implements syntax for try/catch/finally statement with behaviour |
122
|
|
|
|
|
|
|
similar to other programming languages (like Java, Python, etc.). |
123
|
|
|
|
|
|
|
|
124
|
|
|
|
|
|
|
It handles correctly return/wantarray inside try/catch/finally blocks. |
125
|
|
|
|
|
|
|
|
126
|
|
|
|
|
|
|
It uses perl keyword/parser API. So it requires B<perl E<gt>= 5.14>. |
127
|
|
|
|
|
|
|
|
128
|
|
|
|
|
|
|
=head1 SYNTAX |
129
|
|
|
|
|
|
|
|
130
|
|
|
|
|
|
|
=head2 initiliazation |
131
|
|
|
|
|
|
|
|
132
|
|
|
|
|
|
|
To initialize this syntax feature call: |
133
|
|
|
|
|
|
|
|
134
|
|
|
|
|
|
|
use syntax 'try'; |
135
|
|
|
|
|
|
|
|
136
|
|
|
|
|
|
|
=head2 try |
137
|
|
|
|
|
|
|
|
138
|
|
|
|
|
|
|
The I<try block> is executed. |
139
|
|
|
|
|
|
|
If it throws an error, then first I<catch block> (in order) that can handle |
140
|
|
|
|
|
|
|
thrown error will be executed. Other I<catch blocks> will be skipped. |
141
|
|
|
|
|
|
|
|
142
|
|
|
|
|
|
|
If none of I<catch blocks> can handle the error, it is thrown out of |
143
|
|
|
|
|
|
|
whole statement. If I<try block> does not throw an error, |
144
|
|
|
|
|
|
|
all I<catch blocks> are skipped. |
145
|
|
|
|
|
|
|
|
146
|
|
|
|
|
|
|
=head2 catch error class |
147
|
|
|
|
|
|
|
|
148
|
|
|
|
|
|
|
catch (My::Error $err) { ... } |
149
|
|
|
|
|
|
|
|
150
|
|
|
|
|
|
|
This I<catch block> can handle error that is instance of class C<My::Error> |
151
|
|
|
|
|
|
|
or any of it's subclasses. |
152
|
|
|
|
|
|
|
|
153
|
|
|
|
|
|
|
Caught error is accessible inside I<catch block> |
154
|
|
|
|
|
|
|
via declared local variable C<$err>. |
155
|
|
|
|
|
|
|
|
156
|
|
|
|
|
|
|
=head2 catch all errors |
157
|
|
|
|
|
|
|
|
158
|
|
|
|
|
|
|
To catch all errors use syntax: |
159
|
|
|
|
|
|
|
|
160
|
|
|
|
|
|
|
catch ($e) { ... } |
161
|
|
|
|
|
|
|
|
162
|
|
|
|
|
|
|
Caught error is accessible inside I<catch block> |
163
|
|
|
|
|
|
|
via declared local variable C<$e>. |
164
|
|
|
|
|
|
|
|
165
|
|
|
|
|
|
|
=head2 catch without variable |
166
|
|
|
|
|
|
|
|
167
|
|
|
|
|
|
|
Variable name in catch block is not mandatory: |
168
|
|
|
|
|
|
|
|
169
|
|
|
|
|
|
|
try { |
170
|
|
|
|
|
|
|
... |
171
|
|
|
|
|
|
|
} |
172
|
|
|
|
|
|
|
catch (MyError::FileNotFound) { |
173
|
|
|
|
|
|
|
print "file not found"; |
174
|
|
|
|
|
|
|
} |
175
|
|
|
|
|
|
|
catch { |
176
|
|
|
|
|
|
|
print "operation failed"; |
177
|
|
|
|
|
|
|
} |
178
|
|
|
|
|
|
|
|
179
|
|
|
|
|
|
|
=head2 rethrow error |
180
|
|
|
|
|
|
|
|
181
|
|
|
|
|
|
|
To rethrow caught error call "die $err". |
182
|
|
|
|
|
|
|
|
183
|
|
|
|
|
|
|
For example (log any Connection::Error): |
184
|
|
|
|
|
|
|
|
185
|
|
|
|
|
|
|
try { ... } |
186
|
|
|
|
|
|
|
catch (Connection::Error $err) { |
187
|
|
|
|
|
|
|
log_error($err); |
188
|
|
|
|
|
|
|
die $err; |
189
|
|
|
|
|
|
|
} |
190
|
|
|
|
|
|
|
|
191
|
|
|
|
|
|
|
=head2 finally |
192
|
|
|
|
|
|
|
|
193
|
|
|
|
|
|
|
The I<finally block> is executed at the end of statement. |
194
|
|
|
|
|
|
|
It is always executed (even if try or catch block throw an error). |
195
|
|
|
|
|
|
|
|
196
|
|
|
|
|
|
|
my $fh; |
197
|
|
|
|
|
|
|
try { |
198
|
|
|
|
|
|
|
$fh = IO::File->new("/etc/hosts"); |
199
|
|
|
|
|
|
|
... |
200
|
|
|
|
|
|
|
} |
201
|
|
|
|
|
|
|
finally { |
202
|
|
|
|
|
|
|
$fh->close if $fh; |
203
|
|
|
|
|
|
|
} |
204
|
|
|
|
|
|
|
|
205
|
|
|
|
|
|
|
B<WARNING>: If finally block throws an exception, |
206
|
|
|
|
|
|
|
originaly thrown exception (from try/catch block) is discarded. |
207
|
|
|
|
|
|
|
You can convert errors inside finally block to warnings: |
208
|
|
|
|
|
|
|
|
209
|
|
|
|
|
|
|
try { |
210
|
|
|
|
|
|
|
# try block |
211
|
|
|
|
|
|
|
} |
212
|
|
|
|
|
|
|
finally { |
213
|
|
|
|
|
|
|
try { |
214
|
|
|
|
|
|
|
# cleanup code |
215
|
|
|
|
|
|
|
} |
216
|
|
|
|
|
|
|
catch ($e) { warn $e } |
217
|
|
|
|
|
|
|
} |
218
|
|
|
|
|
|
|
|
219
|
|
|
|
|
|
|
=head1 Supported features |
220
|
|
|
|
|
|
|
|
221
|
|
|
|
|
|
|
=head2 Exception::Class |
222
|
|
|
|
|
|
|
|
223
|
|
|
|
|
|
|
This module is compatible with Exception::Class |
224
|
|
|
|
|
|
|
|
225
|
|
|
|
|
|
|
use Exception::Class ( |
226
|
|
|
|
|
|
|
'My::Test::Error' |
227
|
|
|
|
|
|
|
); |
228
|
|
|
|
|
|
|
use syntax 'try'; |
229
|
|
|
|
|
|
|
|
230
|
|
|
|
|
|
|
try { |
231
|
|
|
|
|
|
|
... |
232
|
|
|
|
|
|
|
My::Test::Error->throw('invalid password'); |
233
|
|
|
|
|
|
|
} |
234
|
|
|
|
|
|
|
catch (My::Test::Error $err) { |
235
|
|
|
|
|
|
|
# handle error here |
236
|
|
|
|
|
|
|
} |
237
|
|
|
|
|
|
|
|
238
|
|
|
|
|
|
|
=head2 Moose::Util::TypeConstraints |
239
|
|
|
|
|
|
|
|
240
|
|
|
|
|
|
|
This module is able to handle subtypes defined using |
241
|
|
|
|
|
|
|
L<Moose::Util::TypeConstraints> (but it does not require to be this package |
242
|
|
|
|
|
|
|
installed if you don't use this feature). |
243
|
|
|
|
|
|
|
|
244
|
|
|
|
|
|
|
use Moose::Util::TypeConstraints; |
245
|
|
|
|
|
|
|
|
246
|
|
|
|
|
|
|
class_type 'Error' => { class => 'My::Error' }; |
247
|
|
|
|
|
|
|
subtype 'BillingError', as 'Error', where { $_->category eq 'billing' }; |
248
|
|
|
|
|
|
|
|
249
|
|
|
|
|
|
|
try { |
250
|
|
|
|
|
|
|
... |
251
|
|
|
|
|
|
|
} |
252
|
|
|
|
|
|
|
catch (BillingError $err) { |
253
|
|
|
|
|
|
|
# handle subtype BillingError |
254
|
|
|
|
|
|
|
} |
255
|
|
|
|
|
|
|
|
256
|
|
|
|
|
|
|
=head2 return from subroutine |
257
|
|
|
|
|
|
|
|
258
|
|
|
|
|
|
|
This module supports calling "return" inside try/catch/finally blocks |
259
|
|
|
|
|
|
|
to return values from subroutine. |
260
|
|
|
|
|
|
|
|
261
|
|
|
|
|
|
|
sub read_config { |
262
|
|
|
|
|
|
|
my $file; |
263
|
|
|
|
|
|
|
try { |
264
|
|
|
|
|
|
|
$fh = IO::File->new(...); |
265
|
|
|
|
|
|
|
return $fh->getline; # it returns value from subroutine "read_config" |
266
|
|
|
|
|
|
|
} |
267
|
|
|
|
|
|
|
catch ($e) { |
268
|
|
|
|
|
|
|
# log error |
269
|
|
|
|
|
|
|
} |
270
|
|
|
|
|
|
|
finally { |
271
|
|
|
|
|
|
|
$fh->close() if $fh; |
272
|
|
|
|
|
|
|
} |
273
|
|
|
|
|
|
|
} |
274
|
|
|
|
|
|
|
|
275
|
|
|
|
|
|
|
|
276
|
|
|
|
|
|
|
=head1 CAVEATS |
277
|
|
|
|
|
|
|
|
278
|
|
|
|
|
|
|
=head2 @_ |
279
|
|
|
|
|
|
|
|
280
|
|
|
|
|
|
|
C<@_> is not accessible inside try/catch/finally blocks, |
281
|
|
|
|
|
|
|
because these blocks are internally called in different context. |
282
|
|
|
|
|
|
|
|
283
|
|
|
|
|
|
|
=head2 next, last, redo |
284
|
|
|
|
|
|
|
|
285
|
|
|
|
|
|
|
C<next>, C<last> and C<redo> is not working inside try/catch/finally blocks, |
286
|
|
|
|
|
|
|
because these blocks are internally called in different context. |
287
|
|
|
|
|
|
|
|
288
|
|
|
|
|
|
|
=head1 BUGS |
289
|
|
|
|
|
|
|
|
290
|
|
|
|
|
|
|
None bugs known. |
291
|
|
|
|
|
|
|
|
292
|
|
|
|
|
|
|
=head1 SEE ALSO |
293
|
|
|
|
|
|
|
|
294
|
|
|
|
|
|
|
L<syntax> - Active syntax extensions |
295
|
|
|
|
|
|
|
|
296
|
|
|
|
|
|
|
L<Exception::Class> - A module that allows you to declare real exception |
297
|
|
|
|
|
|
|
classes in Perl |
298
|
|
|
|
|
|
|
|
299
|
|
|
|
|
|
|
L<Moose::Util::TypeConstraints> |
300
|
|
|
|
|
|
|
|
301
|
|
|
|
|
|
|
=head2 Other similar packages |
302
|
|
|
|
|
|
|
|
303
|
|
|
|
|
|
|
L<TryCatch> |
304
|
|
|
|
|
|
|
|
305
|
|
|
|
|
|
|
=over |
306
|
|
|
|
|
|
|
|
307
|
|
|
|
|
|
|
=item * |
308
|
|
|
|
|
|
|
|
309
|
|
|
|
|
|
|
It reports wrong line numbers from warn/die calls inside try/catch blocks. |
310
|
|
|
|
|
|
|
|
311
|
|
|
|
|
|
|
=item * |
312
|
|
|
|
|
|
|
|
313
|
|
|
|
|
|
|
It does not support "finally" block. |
314
|
|
|
|
|
|
|
|
315
|
|
|
|
|
|
|
=item * |
316
|
|
|
|
|
|
|
|
317
|
|
|
|
|
|
|
It works on perl E<lt> 5.14 |
318
|
|
|
|
|
|
|
|
319
|
|
|
|
|
|
|
=back |
320
|
|
|
|
|
|
|
|
321
|
|
|
|
|
|
|
L<Try> |
322
|
|
|
|
|
|
|
|
323
|
|
|
|
|
|
|
=over |
324
|
|
|
|
|
|
|
|
325
|
|
|
|
|
|
|
=item * |
326
|
|
|
|
|
|
|
|
327
|
|
|
|
|
|
|
It does not support catching errors by their ISA (i.e. it has only one catch block that takes all errors and you must write additinal if/else code to rethrow other exceptions). |
328
|
|
|
|
|
|
|
|
329
|
|
|
|
|
|
|
=back |
330
|
|
|
|
|
|
|
|
331
|
|
|
|
|
|
|
L<Try::Tiny> |
332
|
|
|
|
|
|
|
|
333
|
|
|
|
|
|
|
=over |
334
|
|
|
|
|
|
|
|
335
|
|
|
|
|
|
|
=item * |
336
|
|
|
|
|
|
|
|
337
|
|
|
|
|
|
|
It does not support catching errors by their ISA (i.e. it has only one catch block that takes all errors and you must write additinal if/else code to rethrow other exceptions). |
338
|
|
|
|
|
|
|
|
339
|
|
|
|
|
|
|
=item * |
340
|
|
|
|
|
|
|
|
341
|
|
|
|
|
|
|
It generates expression (instead of statement), i.e. it requires semicolon after last block. Missing semicolon before or after try/catch expression may be hard to debug (it is not always reported as syntax error). |
342
|
|
|
|
|
|
|
|
343
|
|
|
|
|
|
|
=item * |
344
|
|
|
|
|
|
|
|
345
|
|
|
|
|
|
|
It works on perl E<lt> 5.14 (It is written in pure perl). |
346
|
|
|
|
|
|
|
|
347
|
|
|
|
|
|
|
=back |
348
|
|
|
|
|
|
|
|
349
|
|
|
|
|
|
|
=head1 GIT REPOSITORY |
350
|
|
|
|
|
|
|
|
351
|
|
|
|
|
|
|
L<http://github.com/tomas-zemres/syntax-feature-try> |
352
|
|
|
|
|
|
|
|
353
|
|
|
|
|
|
|
=head1 AUTHOR |
354
|
|
|
|
|
|
|
|
355
|
|
|
|
|
|
|
Tomas Pokorny <tnt at cpan dot org> |
356
|
|
|
|
|
|
|
|
357
|
|
|
|
|
|
|
=head1 COPYRIGHT AND LICENCE |
358
|
|
|
|
|
|
|
|
359
|
|
|
|
|
|
|
Copyright 2013 - Tomas Pokorny. |
360
|
|
|
|
|
|
|
|
361
|
|
|
|
|
|
|
This program is free software; |
362
|
|
|
|
|
|
|
you can redistribute it and/or modify it under the same terms as Perl itself. |
363
|
|
|
|
|
|
|
|
364
|
|
|
|
|
|
|
=cut |