5 carp - warn of errors (from perspective of caller)
7 cluck - warn of errors with stack backtrace
8 (not exported by default)
10 croak - die of errors (from perspective of caller)
12 confess - die of errors with stack backtrace
17 croak "We're outta here!";
20 cluck "This is how we got here!";
24 The Carp routines are useful in your own modules because
25 they act like die() or warn(), but report where the error
26 was in the code they were called from. Thus if you have a
27 routine Foo() that has a carp() in it, then the carp()
28 will report the error as occurring where Foo() was called,
29 not where carp() was called.
31 =head2 Forcing a Stack Trace
33 As a debugging aid, you can force Carp to treat a croak as a confess
34 and a carp as a cluck across I<all> modules. In other words, force a
35 detailed stack trace to be given. This can be very helpful when trying
36 to understand why, or from where, a warning or error is being generated.
38 This feature is enabled by 'importing' the non-existant symbol
39 'verbose'. You would typically enable it by saying
41 perl -MCarp=verbose script.pl
43 or by including the string C<MCarp=verbose> in the L<PERL5OPT>
48 # This package is heavily used. Be small. Be fast. Be good.
50 $CarpLevel = 0; # How many extra package levels to skip on carp.
51 $MaxEvalLen = 0; # How much eval '...text...' to show. 0 = all.
52 $MaxArgLen = 64; # How much of each argument to print. 0 = all.
53 $MaxArgNums = 8; # How many arguments to print. 0 = all.
57 @EXPORT = qw(confess croak carp);
58 @EXPORT_OK = qw(cluck verbose);
59 @EXPORT_FAIL = qw(verbose); # hook to enable verbose mode
63 if ($_[0] eq 'verbose') {
65 *shortmess = \&longmess;
73 my $error = join '', @_;
75 my $i = 1 + $CarpLevel;
76 my ($pack,$file,$line,$sub,$hargs,$eval,$require);
78 while (do { { package DB; @a = caller($i++) } } ) {
79 ($pack,$file,$line,$sub,$hargs,undef,$eval,$require) = @a;
80 if ($error =~ m/\n$/) {
85 $sub = "require $eval";
87 $eval =~ s/([\\\'])/\\$1/g;
88 if ($MaxEvalLen && length($eval) > $MaxEvalLen) {
89 substr($eval,$MaxEvalLen) = '...';
91 $sub = "eval '$eval'";
93 } elsif ($sub eq '(eval)') {
97 @a = @DB::args; # must get local copy of args
98 if ($MaxArgNums and @a > $MaxArgNums) {
103 $_ = "undef", next unless defined $_;
110 substr($_,$MaxArgLen) = '...'
111 if $MaxArgLen and $MaxArgLen < length;
113 $_ = "'$_'" unless /^-?[\d.]+$/;
114 s/([\200-\377])/sprintf("M-%c",ord($1)&0177)/eg;
115 s/([\0-\37\177])/sprintf("^%c",ord($1)^64)/eg;
117 $sub .= '(' . join(', ', @a) . ')';
119 $mess .= "\t$sub " if $error eq "called";
120 $mess .= "$error at $file line $line\n";
124 # this kludge circumvents die's incorrect handling of NUL
125 my $msg = \($mess || $error);
130 sub shortmess { # Short-circuit &longmess if called via multiple packages
131 my $error = join '', @_;
132 my ($prevpack) = caller(1);
133 my $extra = $CarpLevel;
135 my ($pack,$file,$line);
136 my %isa = ($prevpack,1);
138 @isa{@{"${prevpack}::ISA"}} = ()
139 if(defined @{"${prevpack}::ISA"});
141 while (($pack,$file,$line) = caller($i++)) {
142 if(defined @{$pack . "::ISA"}) {
143 my @i = @{$pack . "::ISA"};
147 if(exists $i{$prevpack} || exists $isa{$pack});
151 if(exists $isa{$pack});
155 @isa{@{$pack . "::ISA"}} = ()
156 if(defined @{$pack . "::ISA"});
159 # this kludge circumvents die's incorrect handling of NUL
160 (my $msg = "$error at $file line $line\n") =~ tr/\0//d;
171 sub confess { die longmess @_; }
172 sub croak { die shortmess @_; }
173 sub carp { warn shortmess @_; }
174 sub cluck { warn longmess @_; }