diff options
Diffstat (limited to 'lib/Carp.pm')
| -rw-r--r-- | lib/Carp.pm | 21 |
1 files changed, 16 insertions, 5 deletions
diff --git a/lib/Carp.pm b/lib/Carp.pm index 5daba5c289..c847b77b36 100644 --- a/lib/Carp.pm +++ b/lib/Carp.pm @@ -3,6 +3,8 @@ package Carp; # This package implements handy routines for modules that wish to throw # exceptions outside of the current package. +$CarpLevel = 0; # How many extra package levels to skip on carp. + require Exporter; @ISA = Exporter; @EXPORT = qw(confess croak carp); @@ -10,7 +12,7 @@ require Exporter; sub longmess { my $error = shift; my $mess = ""; - my $i = 2; + my $i = 1 + $CarpLevel; my ($pack,$file,$line,$sub); while (($pack,$file,$line,$sub) = caller($i++)) { $mess .= "\t$sub " if $error eq "called"; @@ -20,18 +22,27 @@ sub longmess { $mess || $error; } -sub shortmess { - my $error = shift; +sub shortmess { # Short-circuit &longmess if called via multiple packages + my $error = $_[0]; # Instead of "shift" my ($curpack) = caller(1); + my $extra = $CarpLevel; my $i = 2; my ($pack,$file,$line,$sub); while (($pack,$file,$line,$sub) = caller($i++)) { - return "$error at $file line $line\n" if $pack ne $curpack; + if ($pack ne $curpack) { + if ($extra-- > 0) { + $curpack = $pack; + } + else { + return "$error at $file line $line\n"; + } + } } - longmess $error; + goto &longmess; } sub confess { die longmess @_; } sub croak { die shortmess @_; } sub carp { warn shortmess @_; } +1; |