home *** CD-ROM | disk | FTP | other *** search
/ RISC DISC 2 / RISC_DISC_2.iso / pd_share / utilities / cli / perl / !Perl / Lib / pm / carp < prev    next >
Encoding:
Text File  |  1995-03-12  |  1.1 KB  |  49 lines
  1. package Carp;
  2.  
  3. # This package implements handy routines for modules that wish to throw
  4. # exceptions outside of the current package.
  5.  
  6. $CarpLevel = 0;        # How many extra package levels to skip on carp.
  7.  
  8. require Exporter;
  9. @ISA = Exporter;
  10. @EXPORT = qw(confess croak carp);
  11.  
  12. sub longmess {
  13.     my $error = shift;
  14.     my $mess = "";
  15.     my $i = 1 + $CarpLevel;
  16.     my ($pack,$file,$line,$sub);
  17.     while (($pack,$file,$line,$sub) = caller($i++)) {
  18.     $mess .= "\t$sub " if $error eq "called";
  19.     $mess .= "$error at $file line $line\n";
  20.     $error = "called";
  21.     }
  22.     $mess || $error;
  23. }
  24.  
  25. sub shortmess {    # Short-circuit &longmess if called via multiple packages
  26.     my $error = $_[0];    # Instead of "shift"
  27.     my ($curpack) = caller(1);
  28.     my $extra = $CarpLevel;
  29.     my $i = 2;
  30.     my ($pack,$file,$line,$sub);
  31.     while (($pack,$file,$line,$sub) = caller($i++)) {
  32.     if ($pack ne $curpack) {
  33.         if ($extra-- > 0) {
  34.         $curpack = $pack;
  35.         }
  36.         else {
  37.         return "$error at $file line $line\n";
  38.         }
  39.     }
  40.     }
  41.     goto &longmess;
  42. }
  43.  
  44. sub confess { die longmess @_; }
  45. sub croak { die shortmess @_; }
  46. sub carp { warn shortmess @_; }
  47.  
  48. 1;
  49.