home *** CD-ROM | disk | FTP | other *** search
/ OS/2 Shareware BBS: 10 Tools / 10-Tools.zip / perl560.zip / lib / exceptions.pl < prev    next >
Text File  |  1999-07-25  |  2KB  |  62 lines
  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;
  62.