consistent POD itemisation markup
[perl.git] / dist / Carp / lib / Carp.pm
1 package Carp;
2
3 { use 5.006; }
4 use strict;
5 use warnings;
6 BEGIN {
7     # Very old versions of warnings.pm load Carp.  This can go wrong due
8     # to the circular dependency.  If warnings is invoked before Carp,
9     # then warnings starts by loading Carp, then Carp (above) tries to
10     # invoke warnings, and gets nothing because warnings is in the process
11     # of loading and hasn't defined its import method yet.  If we were
12     # only turning on warnings ("use warnings" above) this wouldn't be too
13     # bad, because Carp would just gets the state of the -w switch and so
14     # might not get some warnings that it wanted.  The real problem is
15     # that we then want to turn off Unicode warnings, but "no warnings
16     # 'utf8'" won't be effective if we're in this circular-dependency
17     # situation.  So, if warnings.pm is an affected version, we turn
18     # off all warnings ourselves by directly setting ${^WARNING_BITS}.
19     # On unaffected versions, we turn off just Unicode warnings, via
20     # the proper API.
21     if(!defined($warnings::VERSION) || eval($warnings::VERSION) < 1.06) {
22         ${^WARNING_BITS} = "";
23     } else {
24         "warnings"->unimport("utf8");
25     }
26 }
27
28 BEGIN {
29     no strict "refs";
30     if(exists($::{"utf8::"}) && exists(*{$::{"utf8::"}}{HASH}->{"is_utf8"}) &&
31             defined(*{*{$::{"utf8::"}}{HASH}->{"is_utf8"}}{CODE})) {
32         *is_utf8 = \&{"utf8::is_utf8"};
33     } else {
34         *is_utf8 = sub { 0 };
35     }
36 }
37
38 BEGIN {
39     no strict "refs";
40     if(exists($::{"utf8::"}) && exists(*{$::{"utf8::"}}{HASH}->{"downgrade"}) &&
41             defined(*{*{$::{"utf8::"}}{HASH}->{"downgrade"}}{CODE})) {
42         *downgrade = \&{"utf8::downgrade"};
43     } else {
44         *downgrade = sub {};
45     }
46 }
47
48 our $VERSION = '1.32';
49
50 our $MaxEvalLen = 0;
51 our $Verbose    = 0;
52 our $CarpLevel  = 0;
53 our $MaxArgLen  = 64;    # How much of each argument to print. 0 = all.
54 our $MaxArgNums = 8;     # How many arguments to print. 0 = all.
55 our $RefArgFormatter = undef; # allow caller to format reference arguments
56
57 require Exporter;
58 our @ISA       = ('Exporter');
59 our @EXPORT    = qw(confess croak carp);
60 our @EXPORT_OK = qw(cluck verbose longmess shortmess);
61 our @EXPORT_FAIL = qw(verbose);    # hook to enable verbose mode
62
63 # The members of %Internal are packages that are internal to perl.
64 # Carp will not report errors from within these packages if it
65 # can.  The members of %CarpInternal are internal to Perl's warning
66 # system.  Carp will not report errors from within these packages
67 # either, and will not report calls *to* these packages for carp and
68 # croak.  They replace $CarpLevel, which is deprecated.    The
69 # $Max(EvalLen|(Arg(Len|Nums)) variables are used to specify how the eval
70 # text and function arguments should be formatted when printed.
71
72 our %CarpInternal;
73 our %Internal;
74
75 # disable these by default, so they can live w/o require Carp
76 $CarpInternal{Carp}++;
77 $CarpInternal{warnings}++;
78 $Internal{Exporter}++;
79 $Internal{'Exporter::Heavy'}++;
80
81 # if the caller specifies verbose usage ("perl -MCarp=verbose script.pl")
82 # then the following method will be called by the Exporter which knows
83 # to do this thanks to @EXPORT_FAIL, above.  $_[1] will contain the word
84 # 'verbose'.
85
86 sub export_fail { shift; $Verbose = shift if $_[0] eq 'verbose'; @_ }
87
88 sub _cgc {
89     no strict 'refs';
90     return \&{"CORE::GLOBAL::caller"} if defined &{"CORE::GLOBAL::caller"};
91     return;
92 }
93
94 sub longmess {
95     # Icky backwards compatibility wrapper. :-(
96     #
97     # The story is that the original implementation hard-coded the
98     # number of call levels to go back, so calls to longmess were off
99     # by one.  Other code began calling longmess and expecting this
100     # behaviour, so the replacement has to emulate that behaviour.
101     my $cgc = _cgc();
102     my $call_pack = $cgc ? $cgc->() : caller();
103     if ( $Internal{$call_pack} or $CarpInternal{$call_pack} ) {
104         return longmess_heavy(@_);
105     }
106     else {
107         local $CarpLevel = $CarpLevel + 1;
108         return longmess_heavy(@_);
109     }
110 }
111
112 our @CARP_NOT;
113
114 sub shortmess {
115     my $cgc = _cgc();
116
117     # Icky backwards compatibility wrapper. :-(
118     local @CARP_NOT = $cgc ? $cgc->() : caller();
119     shortmess_heavy(@_);
120 }
121
122 sub croak   { die shortmess @_ }
123 sub confess { die longmess @_ }
124 sub carp    { warn shortmess @_ }
125 sub cluck   { warn longmess @_ }
126
127 BEGIN {
128     if("$]" >= 5.015002 || ("$]" >= 5.014002 && "$]" < 5.015) ||
129             ("$]" >= 5.012005 && "$]" < 5.013)) {
130         *CALLER_OVERRIDE_CHECK_OK = sub () { 1 };
131     } else {
132         *CALLER_OVERRIDE_CHECK_OK = sub () { 0 };
133     }
134 }
135
136 sub caller_info {
137     my $i = shift(@_) + 1;
138     my %call_info;
139     my $cgc = _cgc();
140     {
141         # Some things override caller() but forget to implement the
142         # @DB::args part of it, which we need.  We check for this by
143         # pre-populating @DB::args with a sentinel which no-one else
144         # has the address of, so that we can detect whether @DB::args
145         # has been properly populated.  However, on earlier versions
146         # of perl this check tickles a bug in CORE::caller() which
147         # leaks memory.  So we only check on fixed perls.
148         @DB::args = \$i if CALLER_OVERRIDE_CHECK_OK;
149         package DB;
150         @call_info{
151             qw(pack file line sub has_args wantarray evaltext is_require) }
152             = $cgc ? $cgc->($i) : caller($i);
153     }
154
155     unless ( defined $call_info{file} ) {
156         return ();
157     }
158
159     my $sub_name = Carp::get_subname( \%call_info );
160     if ( $call_info{has_args} ) {
161         my @args;
162         if (CALLER_OVERRIDE_CHECK_OK && @DB::args == 1
163             && ref $DB::args[0] eq ref \$i
164             && $DB::args[0] == \$i ) {
165             @DB::args = ();    # Don't let anyone see the address of $i
166             local $@;
167             my $where = eval {
168                 my $func    = $cgc or return '';
169                 my $gv      =
170                     *{
171                         ( $::{"B::"} || return '')       # B stash
172                           ->{svref_2object} || return '' # entry in stash
173                      }{CODE}                             # coderef in entry
174                         ->($func)->GV;
175                 my $package = $gv->STASH->NAME;
176                 my $subname = $gv->NAME;
177                 return unless defined $package && defined $subname;
178
179                 # returning CORE::GLOBAL::caller isn't useful for tracing the cause:
180                 return if $package eq 'CORE::GLOBAL' && $subname eq 'caller';
181                 " in &${package}::$subname";
182             } || '';
183             @args
184                 = "** Incomplete caller override detected$where; \@DB::args were not set **";
185         }
186         else {
187             @args = @DB::args;
188             my $overflow;
189             if ( $MaxArgNums and @args > $MaxArgNums )
190             {    # More than we want to show?
191                 $#args = $MaxArgNums;
192                 $overflow = 1;
193             }
194
195             @args = map { Carp::format_arg($_) } @args;
196
197             if ($overflow) {
198                 push @args, '...';
199             }
200         }
201
202         # Push the args onto the subroutine
203         $sub_name .= '(' . join( ', ', @args ) . ')';
204     }
205     $call_info{sub_name} = $sub_name;
206     return wantarray() ? %call_info : \%call_info;
207 }
208
209 # Transform an argument to a function into a string.
210 our $in_recurse;
211 sub format_arg {
212     my $arg = shift;
213
214     if ( ref($arg) ) {
215          # legitimate, let's not leak it.
216         if (!$in_recurse &&
217             do {
218                 local $@;
219                 local $in_recurse = 1;
220                 local $SIG{__DIE__} = sub{};
221                 eval {$arg->can('CARP_TRACE') }
222             })
223         {
224             $arg = $arg->CARP_TRACE();
225         }
226         elsif (!$in_recurse &&
227                defined($RefArgFormatter) &&
228                do {
229                 local $@;
230                 local $in_recurse = 1;
231                 local $SIG{__DIE__} = sub{};
232                 eval {$arg = $RefArgFormatter->($arg); 1}
233                 })
234         {
235             1;
236         }
237         else
238         {
239             $arg = defined(&overload::StrVal) ? overload::StrVal($arg) : "$arg";
240         }
241     }
242     if ( defined($arg) ) {
243         $arg =~ s/'/\\'/g;
244         $arg = str_len_trim( $arg, $MaxArgLen );
245
246         # Quote it?
247         # Downgrade, and use [0-9] rather than \d, to avoid loading
248         # Unicode tables, which would be liable to fail if we're
249         # processing a syntax error.
250         downgrade($arg, 1);
251         $arg = "'$arg'" unless $arg =~ /^-?[0-9.]+\z/;
252     }
253     else {
254         $arg = 'undef';
255     }
256
257     # The following handling of "control chars" is direct from
258     # the original code - it is broken on Unicode though.
259     # Suggestions?
260     is_utf8($arg)
261         or $arg =~ s/([[:cntrl:]]|[[:^ascii:]])/sprintf("\\x{%x}",ord($1))/eg;
262     return $arg;
263 }
264
265 # Takes an inheritance cache and a package and returns
266 # an anon hash of known inheritances and anon array of
267 # inheritances which consequences have not been figured
268 # for.
269 sub get_status {
270     my $cache = shift;
271     my $pkg   = shift;
272     $cache->{$pkg} ||= [ { $pkg => $pkg }, [ trusts_directly($pkg) ] ];
273     return @{ $cache->{$pkg} };
274 }
275
276 # Takes the info from caller() and figures out the name of
277 # the sub/require/eval
278 sub get_subname {
279     my $info = shift;
280     if ( defined( $info->{evaltext} ) ) {
281         my $eval = $info->{evaltext};
282         if ( $info->{is_require} ) {
283             return "require $eval";
284         }
285         else {
286             $eval =~ s/([\\\'])/\\$1/g;
287             return "eval '" . str_len_trim( $eval, $MaxEvalLen ) . "'";
288         }
289     }
290
291     # this can happen on older perls when the sub (or the stash containing it)
292     # has been deleted
293     if ( !defined( $info->{sub} ) ) {
294         return '__ANON__::__ANON__';
295     }
296
297     return ( $info->{sub} eq '(eval)' ) ? 'eval {...}' : $info->{sub};
298 }
299
300 # Figures out what call (from the point of view of the caller)
301 # the long error backtrace should start at.
302 sub long_error_loc {
303     my $i;
304     my $lvl = $CarpLevel;
305     {
306         ++$i;
307         my $cgc = _cgc();
308         my @caller = $cgc ? $cgc->($i) : caller($i);
309         my $pkg = $caller[0];
310         unless ( defined($pkg) ) {
311
312             # This *shouldn't* happen.
313             if (%Internal) {
314                 local %Internal;
315                 $i = long_error_loc();
316                 last;
317             }
318             elsif (defined $caller[2]) {
319                 # this can happen when the stash has been deleted
320                 # in that case, just assume that it's a reasonable place to
321                 # stop (the file and line data will still be intact in any
322                 # case) - the only issue is that we can't detect if the
323                 # deleted package was internal (so don't do that then)
324                 # -doy
325                 redo unless 0 > --$lvl;
326                 last;
327             }
328             else {
329                 return 2;
330             }
331         }
332         redo if $CarpInternal{$pkg};
333         redo unless 0 > --$lvl;
334         redo if $Internal{$pkg};
335     }
336     return $i - 1;
337 }
338
339 sub longmess_heavy {
340     return @_ if ref( $_[0] );    # don't break references as exceptions
341     my $i = long_error_loc();
342     return ret_backtrace( $i, @_ );
343 }
344
345 # Returns a full stack backtrace starting from where it is
346 # told.
347 sub ret_backtrace {
348     my ( $i, @error ) = @_;
349     my $mess;
350     my $err = join '', @error;
351     $i++;
352
353     my $tid_msg = '';
354     if ( defined &threads::tid ) {
355         my $tid = threads->tid;
356         $tid_msg = " thread $tid" if $tid;
357     }
358
359     my %i = caller_info($i);
360     $mess = "$err at $i{file} line $i{line}$tid_msg";
361     if( defined $. ) {
362         local $@ = '';
363         local $SIG{__DIE__};
364         eval {
365             CORE::die;
366         };
367         if($@ =~ /^Died at .*(, <.*?> line \d+).$/ ) {
368             $mess .= $1;
369         }
370     }
371     $mess .= "\.\n";
372
373     while ( my %i = caller_info( ++$i ) ) {
374         $mess .= "\t$i{sub_name} called at $i{file} line $i{line}$tid_msg\n";
375     }
376
377     return $mess;
378 }
379
380 sub ret_summary {
381     my ( $i, @error ) = @_;
382     my $err = join '', @error;
383     $i++;
384
385     my $tid_msg = '';
386     if ( defined &threads::tid ) {
387         my $tid = threads->tid;
388         $tid_msg = " thread $tid" if $tid;
389     }
390
391     my %i = caller_info($i);
392     return "$err at $i{file} line $i{line}$tid_msg\.\n";
393 }
394
395 sub short_error_loc {
396     # You have to create your (hash)ref out here, rather than defaulting it
397     # inside trusts *on a lexical*, as you want it to persist across calls.
398     # (You can default it on $_[2], but that gets messy)
399     my $cache = {};
400     my $i     = 1;
401     my $lvl   = $CarpLevel;
402     {
403         my $cgc = _cgc();
404         my $called = $cgc ? $cgc->($i) : caller($i);
405         $i++;
406         my $caller = $cgc ? $cgc->($i) : caller($i);
407
408         if (!defined($caller)) {
409             my @caller = $cgc ? $cgc->($i) : caller($i);
410             if (@caller) {
411                 # if there's no package but there is other caller info, then
412                 # the package has been deleted - treat this as a valid package
413                 # in this case
414                 redo if defined($called) && $CarpInternal{$called};
415                 redo unless 0 > --$lvl;
416                 last;
417             }
418             else {
419                 return 0;
420             }
421         }
422         redo if $Internal{$caller};
423         redo if $CarpInternal{$caller};
424         redo if $CarpInternal{$called};
425         redo if trusts( $called, $caller, $cache );
426         redo if trusts( $caller, $called, $cache );
427         redo unless 0 > --$lvl;
428     }
429     return $i - 1;
430 }
431
432 sub shortmess_heavy {
433     return longmess_heavy(@_) if $Verbose;
434     return @_ if ref( $_[0] );    # don't break references as exceptions
435     my $i = short_error_loc();
436     if ($i) {
437         ret_summary( $i, @_ );
438     }
439     else {
440         longmess_heavy(@_);
441     }
442 }
443
444 # If a string is too long, trims it with ...
445 sub str_len_trim {
446     my $str = shift;
447     my $max = shift || 0;
448     if ( 2 < $max and $max < length($str) ) {
449         substr( $str, $max - 3 ) = '...';
450     }
451     return $str;
452 }
453
454 # Takes two packages and an optional cache.  Says whether the
455 # first inherits from the second.
456 #
457 # Recursive versions of this have to work to avoid certain
458 # possible endless loops, and when following long chains of
459 # inheritance are less efficient.
460 sub trusts {
461     my $child  = shift;
462     my $parent = shift;
463     my $cache  = shift;
464     my ( $known, $partial ) = get_status( $cache, $child );
465
466     # Figure out consequences until we have an answer
467     while ( @$partial and not exists $known->{$parent} ) {
468         my $anc = shift @$partial;
469         next if exists $known->{$anc};
470         $known->{$anc}++;
471         my ( $anc_knows, $anc_partial ) = get_status( $cache, $anc );
472         my @found = keys %$anc_knows;
473         @$known{@found} = ();
474         push @$partial, @$anc_partial;
475     }
476     return exists $known->{$parent};
477 }
478
479 # Takes a package and gives a list of those trusted directly
480 sub trusts_directly {
481     my $class = shift;
482     no strict 'refs';
483     my $stash = \%{"$class\::"};
484     for my $var (qw/ CARP_NOT ISA /) {
485         # Don't try using the variable until we know it exists,
486         # to avoid polluting the caller's namespace.
487         if ( $stash->{$var} && *{$stash->{$var}}{ARRAY} && @{$stash->{$var}} ) {
488            return @{$stash->{$var}}
489         }
490     }
491     return;
492 }
493
494 if(!defined($warnings::VERSION) ||
495         do { no warnings "numeric"; $warnings::VERSION < 1.03 }) {
496     # Very old versions of warnings.pm import from Carp.  This can go
497     # wrong due to the circular dependency.  If Carp is invoked before
498     # warnings, then Carp starts by loading warnings, then warnings
499     # tries to import from Carp, and gets nothing because Carp is in
500     # the process of loading and hasn't defined its import method yet.
501     # So we work around that by manually exporting to warnings here.
502     no strict "refs";
503     *{"warnings::$_"} = \&$_ foreach @EXPORT;
504 }
505
506 1;
507
508 __END__
509
510 =head1 NAME
511
512 Carp - alternative warn and die for modules
513
514 =head1 SYNOPSIS
515
516     use Carp;
517
518     # warn user (from perspective of caller)
519     carp "string trimmed to 80 chars";
520
521     # die of errors (from perspective of caller)
522     croak "We're outta here!";
523
524     # die of errors with stack backtrace
525     confess "not implemented";
526
527     # cluck, longmess and shortmess not exported by default
528     use Carp qw(cluck longmess shortmess);
529     cluck "This is how we got here!";
530     $long_message   = longmess( "message from cluck() or confess()" );
531     $short_message  = shortmess( "message from carp() or croak()" );
532
533 =head1 DESCRIPTION
534
535 The Carp routines are useful in your own modules because
536 they act like C<die()> or C<warn()>, but with a message which is more
537 likely to be useful to a user of your module.  In the case of
538 C<cluck()> and C<confess()>, that context is a summary of every
539 call in the call-stack; C<longmess()> returns the contents of the error
540 message.
541
542 For a shorter message you can use C<carp()> or C<croak()> which report the
543 error as being from where your module was called.  C<shortmess()> returns the
544 contents of this error message.  There is no guarantee that that is where the
545 error was, but it is a good educated guess.
546
547 You can also alter the way the output and logic of C<Carp> works, by
548 changing some global variables in the C<Carp> namespace. See the
549 section on C<GLOBAL VARIABLES> below.
550
551 Here is a more complete description of how C<carp> and C<croak> work.
552 What they do is search the call-stack for a function call stack where
553 they have not been told that there shouldn't be an error.  If every
554 call is marked safe, they give up and give a full stack backtrace
555 instead.  In other words they presume that the first likely looking
556 potential suspect is guilty.  Their rules for telling whether
557 a call shouldn't generate errors work as follows:
558
559 =over 4
560
561 =item 1.
562
563 Any call from a package to itself is safe.
564
565 =item 2.
566
567 Packages claim that there won't be errors on calls to or from
568 packages explicitly marked as safe by inclusion in C<@CARP_NOT>, or
569 (if that array is empty) C<@ISA>.  The ability to override what
570 @ISA says is new in 5.8.
571
572 =item 3.
573
574 The trust in item 2 is transitive.  If A trusts B, and B
575 trusts C, then A trusts C.  So if you do not override C<@ISA>
576 with C<@CARP_NOT>, then this trust relationship is identical to,
577 "inherits from".
578
579 =item 4.
580
581 Any call from an internal Perl module is safe.  (Nothing keeps
582 user modules from marking themselves as internal to Perl, but
583 this practice is discouraged.)
584
585 =item 5.
586
587 Any call to Perl's warning system (eg Carp itself) is safe.
588 (This rule is what keeps it from reporting the error at the
589 point where you call C<carp> or C<croak>.)
590
591 =item 6.
592
593 C<$Carp::CarpLevel> can be set to skip a fixed number of additional
594 call levels.  Using this is not recommended because it is very
595 difficult to get it to behave correctly.
596
597 =back
598
599 =head2 Forcing a Stack Trace
600
601 As a debugging aid, you can force Carp to treat a croak as a confess
602 and a carp as a cluck across I<all> modules. In other words, force a
603 detailed stack trace to be given.  This can be very helpful when trying
604 to understand why, or from where, a warning or error is being generated.
605
606 This feature is enabled by 'importing' the non-existent symbol
607 'verbose'. You would typically enable it by saying
608
609     perl -MCarp=verbose script.pl
610
611 or by including the string C<-MCarp=verbose> in the PERL5OPT
612 environment variable.
613
614 Alternately, you can set the global variable C<$Carp::Verbose> to true.
615 See the C<GLOBAL VARIABLES> section below.
616
617 =head2 Stack Trace formatting
618
619 At each stack level, the subroutine's name is displayed along with
620 its parameters.  For simple scalars, this is sufficient.  For complex
621 data types, such as objects and other references, this can simply
622 display C<'HASH(0x1ab36d8)'>.
623
624 Carp gives two ways to control this.
625
626 =over 4
627
628 =item 1.
629
630 For objects, a method, C<CARP_TRACE>, will be called, if it exists.  If
631 this method doesn't exist, or it recurses into C<Carp>, or it otherwise
632 throws an exception, this is skipped, and Carp moves on to the next option,
633 otherwise checking stops and the string returned is used.  It is recommended
634 that the object's type is part of the string to make debugging easier.
635
636 =item 2.
637
638 For any type of reference, C<$Carp::RefArgFormatter> is checked (see below).
639 This variable is expected to be a code reference, and the current parameter
640 is passed in.  If this function doesn't exist (the variable is undef), or
641 it recurses into C<Carp>, or it otherwise throws an exception, this is
642 skipped, and Carp moves on to the next option, otherwise checking stops
643 and the string returned is used.
644
645 =item 3.
646
647 Otherwise, if neither C<CARP_TRACE> nor C<$Carp::RefArgFormatter> is
648 available, stringify the value ignoring any overloading.
649
650 =back
651
652 =head1 GLOBAL VARIABLES
653
654 =head2 $Carp::MaxEvalLen
655
656 This variable determines how many characters of a string-eval are to
657 be shown in the output. Use a value of C<0> to show all text.
658
659 Defaults to C<0>.
660
661 =head2 $Carp::MaxArgLen
662
663 This variable determines how many characters of each argument to a
664 function to print. Use a value of C<0> to show the full length of the
665 argument.
666
667 Defaults to C<64>.
668
669 =head2 $Carp::MaxArgNums
670
671 This variable determines how many arguments to each function to show.
672 Use a value of C<0> to show all arguments to a function call.
673
674 Defaults to C<8>.
675
676 =head2 $Carp::Verbose
677
678 This variable makes C<carp()> and C<croak()> generate stack backtraces
679 just like C<cluck()> and C<confess()>.  This is how C<use Carp 'verbose'>
680 is implemented internally.
681
682 Defaults to C<0>.
683
684 =head2 $Carp::RefArgFormatter
685
686 This variable sets a general argument formatter to display references.
687 Plain scalars and objects that implement C<CARP_TRACE> will not go through
688 this formatter.  Calling C<Carp> from within this function is not supported.
689
690 local $Carp::RefArgFormatter = sub {
691     require Data::Dumper;
692     Data::Dumper::Dump($_[0]); # not necessarily safe
693 };
694
695 =head2 @CARP_NOT
696
697 This variable, I<in your package>, says which packages are I<not> to be
698 considered as the location of an error. The C<carp()> and C<cluck()>
699 functions will skip over callers when reporting where an error occurred.
700
701 NB: This variable must be in the package's symbol table, thus:
702
703     # These work
704     our @CARP_NOT; # file scope
705     use vars qw(@CARP_NOT); # package scope
706     @My::Package::CARP_NOT = ... ; # explicit package variable
707
708     # These don't work
709     sub xyz { ... @CARP_NOT = ... } # w/o declarations above
710     my @CARP_NOT; # even at top-level
711
712 Example of use:
713
714     package My::Carping::Package;
715     use Carp;
716     our @CARP_NOT;
717     sub bar     { .... or _error('Wrong input') }
718     sub _error  {
719         # temporary control of where'ness, __PACKAGE__ is implicit
720         local @CARP_NOT = qw(My::Friendly::Caller);
721         carp(@_)
722     }
723
724 This would make C<Carp> report the error as coming from a caller not
725 in C<My::Carping::Package>, nor from C<My::Friendly::Caller>.
726
727 Also read the L</DESCRIPTION> section above, about how C<Carp> decides
728 where the error is reported from.
729
730 Use C<@CARP_NOT>, instead of C<$Carp::CarpLevel>.
731
732 Overrides C<Carp>'s use of C<@ISA>.
733
734 =head2 %Carp::Internal
735
736 This says what packages are internal to Perl.  C<Carp> will never
737 report an error as being from a line in a package that is internal to
738 Perl.  For example:
739
740     $Carp::Internal{ (__PACKAGE__) }++;
741     # time passes...
742     sub foo { ... or confess("whatever") };
743
744 would give a full stack backtrace starting from the first caller
745 outside of __PACKAGE__.  (Unless that package was also internal to
746 Perl.)
747
748 =head2 %Carp::CarpInternal
749
750 This says which packages are internal to Perl's warning system.  For
751 generating a full stack backtrace this is the same as being internal
752 to Perl, the stack backtrace will not start inside packages that are
753 listed in C<%Carp::CarpInternal>.  But it is slightly different for
754 the summary message generated by C<carp> or C<croak>.  There errors
755 will not be reported on any lines that are calling packages in
756 C<%Carp::CarpInternal>.
757
758 For example C<Carp> itself is listed in C<%Carp::CarpInternal>.
759 Therefore the full stack backtrace from C<confess> will not start
760 inside of C<Carp>, and the short message from calling C<croak> is
761 not placed on the line where C<croak> was called.
762
763 =head2 $Carp::CarpLevel
764
765 This variable determines how many additional call frames are to be
766 skipped that would not otherwise be when reporting where an error
767 occurred on a call to one of C<Carp>'s functions.  It is fairly easy
768 to count these call frames on calls that generate a full stack
769 backtrace.  However it is much harder to do this accounting for calls
770 that generate a short message.  Usually people skip too many call
771 frames.  If they are lucky they skip enough that C<Carp> goes all of
772 the way through the call stack, realizes that something is wrong, and
773 then generates a full stack backtrace.  If they are unlucky then the
774 error is reported from somewhere misleading very high in the call
775 stack.
776
777 Therefore it is best to avoid C<$Carp::CarpLevel>.  Instead use
778 C<@CARP_NOT>, C<%Carp::Internal> and C<%Carp::CarpInternal>.
779
780 Defaults to C<0>.
781
782 =head1 BUGS
783
784 The Carp routines don't handle exception objects currently.
785 If called with a first argument that is a reference, they simply
786 call die() or warn(), as appropriate.
787
788 =head1 SEE ALSO
789
790 L<Carp::Always>,
791 L<Carp::Clan>
792
793 =head1 AUTHOR
794
795 The Carp module first appeared in Larry Wall's perl 5.000 distribution.
796 Since then it has been modified by several of the perl 5 porters.
797 Andrew Main (Zefram) <zefram@fysh.org> divested Carp into an independent
798 distribution.
799
800 =head1 COPYRIGHT
801
802 Copyright (C) 1994-2012 Larry Wall
803
804 Copyright (C) 2011, 2012 Andrew Main (Zefram) <zefram@fysh.org>
805
806 =head1 LICENSE
807
808 This module is free software; you can redistribute it and/or modify it
809 under the same terms as Perl itself.