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