This is a live mirror of the Perl 5 development currently hosted at https://github.com/perl/perl5
Make pp_reverse fetch the lexical $_ from the correct pad
[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.
25209816
S
6# This legacy library is deprecated and will be removed in a future
7# release of perl.
a6d71656
GS
8#
9# In particular, this should not be used as an example of modern Perl
10# programming techniques.
25209816 11
99b89507
LW
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
38sub 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
53sub throw {
54 local($exception) = @_;
55 die "EXCEPTION: $exception\n";
56}
57
58sub thrown {
59 $@ =~ /^(EXCEPTION: )+(.+)/ && $2;
60}
61
621;