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
1 package 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
8 require Exporter;
9 @ISA = Exporter;
10 @EXPORT = qw(confess croak carp);
11
12 sub 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
25 sub 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
44 sub confess { die longmess @_; }
45 sub croak { die shortmess @_; }
46 sub carp { warn shortmess @_; }
47
48 1;