lib/Carp.pm

   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;