File Coverage

blib/lib/exceptions.pl
Criterion Covered Total %
statement 0 11 0.0
branch 0 6 0.0
condition n/a
subroutine 0 3 0.0
pod n/a
total 0 20 0.0


line stmt bran cond sub pod time code
1             # exceptions.pl
2             # tchrist@convex.com
3             #
4             # This library is no longer being maintained, and is included for backward
5             # compatibility with Perl 4 programs which may require it.
6             #
7             # In particular, this should not be used as an example of modern Perl
8             # programming techniques.
9             #
10             #
11             # Here's a little code I use for exception handling. It's really just
12             # glorfied eval/die. The way to use use it is when you might otherwise
13             # exit, use &throw to raise an exception. The first enclosing &catch
14             # handler looks at the exception and decides whether it can catch this kind
15             # (catch takes a list of regexps to catch), and if so, it returns the one it
16             # caught. If it *can't* catch it, then it will reraise the exception
17             # for someone else to possibly see, or to die otherwise.
18             #
19             # I use oddly named variables in order to make darn sure I don't conflict
20             # with my caller. I also hide in my own package, and eval the code in his.
21             #
22             # The EXCEPTION: prefix is so you can tell whether it's a user-raised
23             # exception or a perl-raised one (eval error).
24             #
25             # --tom
26             #
27             # examples:
28             # if (&catch('/$user_input/', 'regexp', 'syntax error') {
29             # warn "oops try again";
30             # redo;
31             # }
32             #
33             # if ($error = &catch('&subroutine()')) { # catches anything
34             #
35             # &throw('bad input') if /^$/;
36              
37             sub catch {
38             package exception;
39 0     0     local($__code__, @__exceptions__) = @_;
40 0           local($__package__) = caller;
41 0           local($__exception__);
42              
43 0           eval "package $__package__; $__code__";
44 0 0         if ($__exception__ = &::thrown) {
45 0           for (@__exceptions__) {
46 0 0         return $__exception__ if /$__exception__/;
47             }
48 0           &::throw($__exception__);
49             }
50             }
51              
52             sub throw {
53 0     0     local($exception) = @_;
54 0           die "EXCEPTION: $exception\n";
55             }
56              
57             sub thrown {
58 0 0   0     $@ =~ /^(EXCEPTION: )+(.+)/ && $2;
59             }
60              
61             1;