| 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 |
projects / p5sagit/p5-mst-13.2.git / blame