Commit | Line | Data |
a0d0e21e |
1 | package Carp; |
2 | |
3 | # This package implements handy routines for modules that wish to throw |
4 | # exceptions outside of the current package. |
5 | |
748a9306 |
6 | $CarpLevel = 0; # How many extra package levels to skip on carp. |
7 | |
a0d0e21e |
8 | require Exporter; |
9 | @ISA = Exporter; |
10 | @EXPORT = qw(confess croak carp); |
11 | |
12 | sub longmess { |
13 | my $error = shift; |
14 | my $mess = ""; |
748a9306 |
15 | my $i = 1 + $CarpLevel; |
a0d0e21e |
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 | |
748a9306 |
25 | sub shortmess { # Short-circuit &longmess if called via multiple packages |
26 | my $error = $_[0]; # Instead of "shift" |
a0d0e21e |
27 | my ($curpack) = caller(1); |
748a9306 |
28 | my $extra = $CarpLevel; |
a0d0e21e |
29 | my $i = 2; |
30 | my ($pack,$file,$line,$sub); |
31 | while (($pack,$file,$line,$sub) = caller($i++)) { |
748a9306 |
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 | } |
a0d0e21e |
40 | } |
748a9306 |
41 | goto &longmess; |
a0d0e21e |
42 | } |
43 | |
44 | sub confess { die longmess @_; } |
45 | sub croak { die shortmess @_; } |
46 | sub carp { warn shortmess @_; } |
47 | |
748a9306 |
48 | 1; |