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