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
37sub catch {
38    package exception;
39    local($__code__, @__exceptions__) = @_;
40    local($__package__) = caller;
41    local($__exception__);
42
43    eval "package $__package__; $__code__";
44    if ($__exception__ = &'thrown) {
45	for (@__exceptions__) {
46	    return $__exception__ if /$__exception__/;
47	}
48	&'throw($__exception__);
49    }
50}
51
52sub throw {
53    local($exception) = @_;
54    die "EXCEPTION: $exception\n";
55}
56
57sub thrown {
58    $@ =~ /^(EXCEPTION: )+(.+)/ && $2;
59}
60
611;
62