This is a live mirror of the Perl 5 development currently hosted at https://github.com/perl/perl5
Continue what #4494 started; introduce uid and gid formats.
[perl5.git] / lib / exceptions.pl
CommitLineData
99b89507
LW
1# exceptions.pl
2# tchrist@convex.com
a6d71656
GS
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#
99b89507
LW
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;