home *** CD-ROM | disk | FTP | other *** search
/ OS/2 Shareware BBS: 10 Tools / 10-Tools.zip / perl_mlb.zip / exceptions.pl < prev    next >
Text File  |  1997-11-25  |  2KB  |  55 lines

  1. # exceptions.pl
  2. # tchrist@convex.com
  3. # Here's a little code I use for exception handling.  It's really just
  4. # glorfied eval/die.  The way to use use it is when you might otherwise
  5. # exit, use &throw to raise an exception.  The first enclosing &catch
  6. # handler looks at the exception and decides whether it can catch this kind
  7. # (catch takes a list of regexps to catch), and if so, it returns the one it
  8. # caught.  If it *can't* catch it, then it will reraise the exception
  9. # for someone else to possibly see, or to die otherwise.
  10. # I use oddly named variables in order to make darn sure I don't conflict 
  11. # with my caller.  I also hide in my own package, and eval the code in his.
  12. # The EXCEPTION: prefix is so you can tell whether it's a user-raised
  13. # exception or a perl-raised one (eval error).
  14. # --tom
  15. #
  16. # examples:
  17. #    if (&catch('/$user_input/', 'regexp', 'syntax error') {
  18. #        warn "oops try again";
  19. #        redo;
  20. #    }
  21. #
  22. #    if ($error = &catch('&subroutine()')) { # catches anything
  23. #
  24. #    &throw('bad input') if /^$/;
  25.  
  26. sub catch {
  27.     package exception;
  28.     local($__code__, @__exceptions__) = @_;
  29.     local($__package__) = caller;
  30.     local($__exception__);
  31.  
  32.     eval "package $__package__; $__code__";
  33.     if ($__exception__ = &'thrown) {
  34.     for (@__exceptions__) {
  35.         return $__exception__ if /$__exception__/;
  36.     } 
  37.     &'throw($__exception__);
  38.     } 
  39.  
  40. sub throw {
  41.     local($exception) = @_;
  42.     die "EXCEPTION: $exception\n";
  43.  
  44. sub thrown {
  45.     $@ =~ /^(EXCEPTION: )+(.+)/ && $2;
  46.  
  47. 1;
  48.