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