Commit | Line | Data |
90266299 |
1 | package Fatal; |
2 | |
3 | use Carp; |
4 | use strict; |
5 | use vars qw( $AUTOLOAD $Debug ); |
6 | |
7 | $Debug = 0; |
8 | |
9 | sub import { |
10 | my $self = shift(@_); |
11 | my($sym, $pkg); |
12 | $pkg = (caller)[0]; |
13 | foreach $sym (@_) { |
14 | &_make_fatal($sym, $pkg); |
15 | } |
16 | }; |
17 | |
18 | sub AUTOLOAD { |
19 | my $cmd = $AUTOLOAD; |
20 | $cmd =~ s/.*:://; |
21 | &_make_fatal($cmd, (caller)[0]); |
22 | goto &$AUTOLOAD; |
23 | } |
24 | |
25 | sub _make_fatal { |
26 | my($sub, $pkg) = @_; |
27 | my($name, $code, $sref); |
28 | |
29 | $sub = "${pkg}::$sub" unless $sub =~ /::/; |
30 | $name = $sub; |
31 | $name =~ s/.*::// or $name =~ s/^&//; |
32 | print "# _make_fatal: sub=$sub pkg=$pkg name=$name\n" if $Debug; |
33 | croak "Bad subroutine name for Fatal: $name" unless $name =~ /^\w+$/; |
34 | $code = "sub $name {\n\tlocal(\$\", \$!) = (', ', 0);\n"; |
35 | if (defined(&$sub)) { |
36 | # user subroutine |
37 | $sref = \&$sub; |
38 | $code .= "\t&\$sref"; |
39 | } else { |
40 | # CORE subroutine |
41 | $code .= "\tCORE::$name"; |
42 | } |
43 | $code .= "\(\@_\) || croak \"Can't $name\(\@_\): \$!\";\n}\n"; |
44 | print $code if $Debug; |
45 | eval($code); |
46 | die($@) if $@; |
47 | local($^W) = 0; # to avoid: Subroutine foo redefined ... |
48 | no strict 'refs'; # to avoid: Can't use string (...) as a symbol ref ... |
49 | *{$sub} = \&{"Fatal::$name"}; |
50 | } |
51 | |
52 | 1; |
53 | |
54 | __END__ |
55 | |
56 | =head1 NAME |
57 | |
58 | Fatal - replace functions with equivalents which succeed or die |
59 | |
60 | =head1 SYNOPSIS |
61 | |
62 | use Fatal qw(open print close); |
63 | |
64 | sub juggle { . . . } |
65 | import Fatal 'juggle'; |
66 | |
67 | =head1 DESCRIPTION |
68 | |
69 | C<Fatal> provides a way to conveniently replace functions which normally |
70 | return a false value when they fail with equivalents which halt execution |
71 | if they are not successful. This lets you use these functions without |
72 | having to test their return values explicitly on each call. Errors are |
73 | reported via C<die>, so you can trap them using C<$SIG{__DIE__}> if you |
74 | wish to take some action before the program exits. |
75 | |
76 | The do-or-die equivalents are set up simply by calling Fatal's C<import> |
77 | routine, passing it the names of the functions to be replaced. You may |
78 | wrap both user-defined functions and CORE operators in this way. |
79 | |
80 | =head1 AUTHOR |
81 | |
82 | Lionel.Cons@cern.ch |