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