PageRenderTime 25ms CodeModel.GetById 16ms app.highlight 5ms RepoModel.GetById 2ms app.codeStats 0ms

/IronPython_Main/Runtime/Tests/LinqDlrTests/testenv/perl/lib/exceptions.pl

#
Perl | 61 lines | 21 code | 5 blank | 35 comment | 2 complexity | 6f444e01f56c96a2148940bbe37f0bd0 MD5 | raw file
 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;