This is a live mirror of the Perl 5 development currently hosted at https://github.com/perl/perl5
untodo the no-longer-failing todo test for rgs' patch
[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
S
11
12warn( "The 'exceptions.pl' legacy library is deprecated and will be"
13 . " removed in the next major release of perl." );
14
99b89507
LW
15# Here's a little code I use for exception handling. It's really just
16# glorfied eval/die. The way to use use it is when you might otherwise
17# exit, use &throw to raise an exception. The first enclosing &catch
18# handler looks at the exception and decides whether it can catch this kind
19# (catch takes a list of regexps to catch), and if so, it returns the one it
20# caught. If it *can't* catch it, then it will reraise the exception
21# for someone else to possibly see, or to die otherwise.
22#
23# I use oddly named variables in order to make darn sure I don't conflict
24# with my caller. I also hide in my own package, and eval the code in his.
25#
26# The EXCEPTION: prefix is so you can tell whether it's a user-raised
27# exception or a perl-raised one (eval error).
28#
29# --tom
30#
31# examples:
32# if (&catch('/$user_input/', 'regexp', 'syntax error') {
33# warn "oops try again";
34# redo;
35# }
36#
37# if ($error = &catch('&subroutine()')) { # catches anything
38#
39# &throw('bad input') if /^$/;
40
41sub catch {
42 package exception;
43 local($__code__, @__exceptions__) = @_;
44 local($__package__) = caller;
45 local($__exception__);
46
47 eval "package $__package__; $__code__";
48 if ($__exception__ = &'thrown) {
49 for (@__exceptions__) {
50 return $__exception__ if /$__exception__/;
51 }
52 &'throw($__exception__);
53 }
54}
55
56sub throw {
57 local($exception) = @_;
58 die "EXCEPTION: $exception\n";
59}
60
61sub thrown {
62 $@ =~ /^(EXCEPTION: )+(.+)/ && $2;
63}
64
651;