This is a live mirror of the Perl 5 development currently hosted at https://github.com/perl/perl5
perl5.001 patch.1f
[perl5.git] / lib / Carp.pm
... / ...
CommitLineData
1package Carp;
2
3# This package implements handy routines for modules that wish to throw
4# exceptions outside of the current package.
5
6$CarpLevel = 0; # How many extra package levels to skip on carp.
7
8require Exporter;
9@ISA = Exporter;
10@EXPORT = qw(confess croak carp);
11
12sub longmess {
13 my $error = shift;
14 my $mess = "";
15 my $i = 1 + $CarpLevel;
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
25sub shortmess { # Short-circuit &longmess if called via multiple packages
26 my $error = $_[0]; # Instead of "shift"
27 my ($curpack) = caller(1);
28 my $extra = $CarpLevel;
29 my $i = 2;
30 my ($pack,$file,$line,$sub);
31 while (($pack,$file,$line,$sub) = caller($i++)) {
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 }
40 }
41 goto &longmess;
42}
43
44sub confess { die longmess @_; }
45sub croak { die shortmess @_; }
46sub carp { warn shortmess @_; }
47
481;