5 carp - warn of errors (from perspective of caller)
7 croak - die of errors (from perspective of caller)
9 confess - die of errors with stack backtrace
14 croak "We're outta here!";
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.
27 # This package implements handy routines for modules that wish to throw
28 # exceptions outside of the current package.
30 $CarpLevel = 0; # How many extra package levels to skip on carp.
31 $MaxEvalLen = 0; # How much eval '...text...' to show. 0 = all.
32 $MaxArgLen = 64; # How much of each argument to print. 0 = all.
33 $MaxArgNums = 8; # How many arguments to print. 0 = all.
37 @EXPORT = qw(confess croak carp);
40 my $error = join '', @_;
42 my $i = 1 + $CarpLevel;
43 my ($pack,$file,$line,$sub,$hargs,$eval,$require);
45 while (do { { package DB; @a = caller($i++) } } ) {
46 ($pack,$file,$line,$sub,$hargs,undef,$eval,$require) = @a;
47 if ($error =~ m/\n$/) {
52 $sub = "require $eval";
54 $eval =~ s/([\\\'])/\\$1/g;
55 if ($MaxEvalLen && length($eval) > $MaxEvalLen) {
56 substr($eval,$MaxEvalLen) = '...';
58 $sub = "eval '$eval'";
60 } elsif ($sub eq '(eval)') {
64 @a = @DB::args; # must get local copy of args
65 if ($MaxArgNums and @a > $MaxArgNums) {
70 $_ = "undef", next unless defined $_;
77 substr($_,$MaxArgLen) = '...'
78 if $MaxArgLen and $MaxArgLen < length;
80 $_ = "'$_'" unless /^-?[\d.]+$/;
81 s/([\200-\377])/sprintf("M-%c",ord($1)&0177)/eg;
82 s/([\0-\37\177])/sprintf("^%c",ord($1)^64)/eg;
84 $sub .= '(' . join(', ', @a) . ')';
86 $mess .= "\t$sub " if $error eq "called";
87 $mess .= "$error at $file line $line\n";
91 # this kludge circumvents die's incorrect handling of NUL
92 my $msg = \($mess || $error);
97 sub shortmess { # Short-circuit &longmess if called via multiple packages
98 my $error = join '', @_;
99 my ($prevpack) = caller(1);
100 my $extra = $CarpLevel;
102 my ($pack,$file,$line);
103 my %isa = ($prevpack,1);
105 @isa{@{"${prevpack}::ISA"}} = ()
106 if(defined @{"${prevpack}::ISA"});
108 while (($pack,$file,$line) = caller($i++)) {
109 if(defined @{$pack . "::ISA"}) {
110 my @i = @{$pack . "::ISA"};
114 if(exists $i{$prevpack} || exists $isa{$pack});
118 if(exists $isa{$pack});
122 @isa{@{$pack . "::ISA"}} = ()
123 if(defined @{$pack . "::ISA"});
126 # this kludge circumvents die's incorrect handling of NUL
127 (my $msg = "$error at $file line $line\n") =~ tr/\0//d;
138 sub confess { die longmess @_; }
139 sub croak { die shortmess @_; }
140 sub carp { warn shortmess @_; }