This is a live mirror of the Perl 5 development currently hosted at https://github.com/perl/perl5
Update documentation
[perl5.git] / lib / Carp.pm
CommitLineData
a0d0e21e
LW
1package Carp;
2
f06db76b
AD
3=head1 NAME
4
5carp - warn of errors (from perspective of caller)
6
7croak - die of errors (from perspective of caller)
8
9confess - 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
18The Carp routines are useful in your own modules because
19they act like die() or warn(), but report where the error
20was in the code they were called from. Thus if you have a
21routine Foo() that has a carp() in it, then the carp()
22will report the error as occurring where Foo() was called,
23not where carp() was called.
24
25=cut
26
a0d0e21e
LW
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.
c07a80fd 31$MaxEvalLen = 0; # How much eval '...text...' to show. 0 = all.
748a9306 32
a0d0e21e
LW
33require Exporter;
34@ISA = Exporter;
35@EXPORT = qw(confess croak carp);
36
37sub longmess {
38 my $error = shift;
39 my $mess = "";
748a9306 40 my $i = 1 + $CarpLevel;
c07a80fd
PP
41 my ($pack,$file,$line,$sub,$eval,$require);
42 while (($pack,$file,$line,$sub,undef,undef,$eval,$require) = caller($i++)) {
c1bce5d7
PP
43 if ($error =~ m/\n$/) {
44 $mess .= $error;
45 } else {
c07a80fd
PP
46 if (defined $eval) {
47 if ($require) {
48 $sub = "require $eval";
49 } else {
50 $eval =~ s/[\\\']/\\$&/g;
51 if ($MaxEvalLen && length($eval) > $MaxEvalLen) {
52 substr($eval,$MaxEvalLen) = '...';
53 }
54 $sub = "eval '$eval'";
55 }
56 } elsif ($sub eq '(eval)') {
57 $sub = 'eval {...}';
58 }
c1bce5d7
PP
59 $mess .= "\t$sub " if $error eq "called";
60 $mess .= "$error at $file line $line\n";
61 }
a0d0e21e
LW
62 $error = "called";
63 }
64 $mess || $error;
65}
66
748a9306
LW
67sub shortmess { # Short-circuit &longmess if called via multiple packages
68 my $error = $_[0]; # Instead of "shift"
a0d0e21e 69 my ($curpack) = caller(1);
748a9306 70 my $extra = $CarpLevel;
a0d0e21e 71 my $i = 2;
c07a80fd
PP
72 my ($pack,$file,$line);
73 while (($pack,$file,$line) = caller($i++)) {
748a9306
LW
74 if ($pack ne $curpack) {
75 if ($extra-- > 0) {
76 $curpack = $pack;
77 }
78 else {
79 return "$error at $file line $line\n";
80 }
81 }
a0d0e21e 82 }
748a9306 83 goto &longmess;
a0d0e21e
LW
84}
85
86sub confess { die longmess @_; }
87sub croak { die shortmess @_; }
88sub carp { warn shortmess @_; }
89
748a9306 901;