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