Commit | Line | Data |
a0d0e21e |
1 | package Carp; |
2 | |
f06db76b |
3 | =head1 NAME |
4 | |
5 | carp - warn of errors (from perspective of caller) |
6 | |
7 | croak - die of errors (from perspective of caller) |
8 | |
9 | confess - die of errors with stack backtrace |
10 | |
11 | =head1 SYNOPSIS |
12 | |
13 | use Carp; |
14 | croak "We're outta here!"; |
15 | |
16 | =head1 DESCRIPTION |
17 | |
18 | The Carp routines are useful in your own modules because |
19 | they act like die() or warn(), but report where the error |
20 | was in the code they were called from. Thus if you have a |
21 | routine Foo() that has a carp() in it, then the carp() |
22 | will report the error as occurring where Foo() was called, |
23 | not where carp() was called. |
24 | |
25 | =cut |
26 | |
a0d0e21e |
27 | # This package implements handy routines for modules that wish to throw |
28 | # exceptions outside of the current package. |
29 | |
748a9306 |
30 | $CarpLevel = 0; # How many extra package levels to skip on carp. |
31 | |
a0d0e21e |
32 | require Exporter; |
33 | @ISA = Exporter; |
34 | @EXPORT = qw(confess croak carp); |
35 | |
36 | sub longmess { |
37 | my $error = shift; |
38 | my $mess = ""; |
748a9306 |
39 | my $i = 1 + $CarpLevel; |
a0d0e21e |
40 | my ($pack,$file,$line,$sub); |
41 | while (($pack,$file,$line,$sub) = caller($i++)) { |
c1bce5d7 |
42 | if ($error =~ m/\n$/) { |
43 | $mess .= $error; |
44 | } else { |
45 | $mess .= "\t$sub " if $error eq "called"; |
46 | $mess .= "$error at $file line $line\n"; |
47 | } |
a0d0e21e |
48 | $error = "called"; |
49 | } |
50 | $mess || $error; |
51 | } |
52 | |
748a9306 |
53 | sub shortmess { # Short-circuit &longmess if called via multiple packages |
54 | my $error = $_[0]; # Instead of "shift" |
a0d0e21e |
55 | my ($curpack) = caller(1); |
748a9306 |
56 | my $extra = $CarpLevel; |
a0d0e21e |
57 | my $i = 2; |
58 | my ($pack,$file,$line,$sub); |
59 | while (($pack,$file,$line,$sub) = caller($i++)) { |
748a9306 |
60 | if ($pack ne $curpack) { |
61 | if ($extra-- > 0) { |
62 | $curpack = $pack; |
63 | } |
64 | else { |
65 | return "$error at $file line $line\n"; |
66 | } |
67 | } |
a0d0e21e |
68 | } |
748a9306 |
69 | goto &longmess; |
a0d0e21e |
70 | } |
71 | |
72 | sub confess { die longmess @_; } |
73 | sub croak { die shortmess @_; } |
74 | sub carp { warn shortmess @_; } |
75 | |
748a9306 |
76 | 1; |