[Summary view] [Print] [Text view]

   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  
  37  sub 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  
  52  sub throw {
  53      local($exception) = @_;
  54      die "EXCEPTION: $exception\n";
  55  } 
  56  
  57  sub thrown {
  58      $@ =~ /^(EXCEPTION: )+(.+)/ && $2;
  59  } 
  60  
  61  1;