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
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
e94bb470
Z
311sub 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
ba7a4549
RGS
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.
340sub get_status {
341 my $cache = shift;
d38ea511
DR
342 my $pkg = shift;
343 $cache->{$pkg} ||= [ { $pkg => $pkg }, [ trusts_directly($pkg) ] ];
344 return @{ $cache->{$pkg} };
ba7a4549
RGS
345}
346
347# Takes the info from caller() and figures out the name of
348# the sub/require/eval
349sub get_subname {
d38ea511
DR
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 }
ba7a4549 360 }
ba7a4549 361
5bbc4d5d
JL
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
d38ea511 368 return ( $info->{sub} eq '(eval)' ) ? 'eval {...}' : $info->{sub};
ba7a4549
RGS
369}
370
371# Figures out what call (from the point of view of the caller)
372# the long error backtrace should start at.
373sub long_error_loc {
d38ea511
DR
374 my $i;
375 my $lvl = $CarpLevel;
376 {
377 ++$i;
378 my $cgc = _cgc();
c541cacf
RS
379 my @caller = $cgc ? $cgc->($i) : caller($i);
380 my $pkg = $caller[0];
d38ea511
DR
381 unless ( defined($pkg) ) {
382
383 # This *shouldn't* happen.
384 if (%Internal) {
385 local %Internal;
386 $i = long_error_loc();
387 last;
388 }
c541cacf 389 elsif (defined $caller[2]) {
5bbc4d5d
JL
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;
d38ea511 398 }
c541cacf
RS
399 else {
400 return 2;
401 }
d38ea511
DR
402 }
403 redo if $CarpInternal{$pkg};
404 redo unless 0 > --$lvl;
405 redo if $Internal{$pkg};
ba7a4549 406 }
d38ea511 407 return $i - 1;
ba7a4549
RGS
408}
409
ba7a4549 410sub longmess_heavy {
d38ea511
DR
411 return @_ if ref( $_[0] ); # don't break references as exceptions
412 my $i = long_error_loc();
413 return ret_backtrace( $i, @_ );
ba7a4549
RGS
414}
415
416# Returns a full stack backtrace starting from where it is
417# told.
418sub ret_backtrace {
d38ea511
DR
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);
89988fbd 431 $mess = "$err at $i{file} line $i{line}$tid_msg";
432 if( defined $. ) {
433 local $@ = '';
63a756fa 434 local $SIG{__DIE__};
89988fbd 435 eval {
781fa0f4 436 CORE::die;
89988fbd 437 };
438 if($@ =~ /^Died at .*(, <.*?> line \d+).$/ ) {
439 $mess .= $1;
440 }
441 }
879b0cab 442 $mess .= "\.\n";
d38ea511
DR
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;
ba7a4549
RGS
449}
450
451sub ret_summary {
d38ea511
DR
452 my ( $i, @error ) = @_;
453 my $err = join '', @error;
454 $i++;
ba7a4549 455
d38ea511
DR
456 my $tid_msg = '';
457 if ( defined &threads::tid ) {
458 my $tid = threads->tid;
459 $tid_msg = " thread $tid" if $tid;
460 }
ba7a4549 461
d38ea511 462 my %i = caller_info($i);
879b0cab 463 return "$err at $i{file} line $i{line}$tid_msg\.\n";
ba7a4549
RGS
464}
465
d38ea511
DR
466sub 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
5bbc4d5d
JL
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 }
d38ea511
DR
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}
ba7a4549
RGS
502
503sub shortmess_heavy {
d38ea511
DR
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 }
ba7a4549
RGS
513}
514
515# If a string is too long, trims it with ...
516sub str_len_trim {
d38ea511
DR
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;
ba7a4549
RGS
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.
531sub trusts {
d38ea511 532 my $child = shift;
ba7a4549 533 my $parent = shift;
d38ea511
DR
534 my $cache = shift;
535 my ( $known, $partial ) = get_status( $cache, $child );
536
ba7a4549 537 # Figure out consequences until we have an answer
d38ea511 538 while ( @$partial and not exists $known->{$parent} ) {
ba7a4549
RGS
539 my $anc = shift @$partial;
540 next if exists $known->{$anc};
541 $known->{$anc}++;
d38ea511 542 my ( $anc_knows, $anc_partial ) = get_status( $cache, $anc );
ba7a4549
RGS
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
551sub trusts_directly {
552 my $class = shift;
553 no strict 'refs';
1a4f8f41
BF
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.
79f8d0e8
BF
558 if ( $stash->{$var} && *{$stash->{$var}}{ARRAY} && @{$stash->{$var}} ) {
559 return @{$stash->{$var}}
1a4f8f41
BF
560 }
561 }
562 return;
ba7a4549
RGS
563}
564
1104801e
Z
565if(!defined($warnings::VERSION) ||
566 do { no warnings "numeric"; $warnings::VERSION < 1.03 }) {
edda670c
Z
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
748a9306 5771;
ba7a4549 578
0cda2667
DM
579__END__
580
581=head1 NAME
582
aaca3d9d 583Carp - alternative warn and die for modules
0cda2667 584
0cda2667
DM
585=head1 SYNOPSIS
586
587 use Carp;
aaca3d9d
MS
588
589 # warn user (from perspective of caller)
590 carp "string trimmed to 80 chars";
591
592 # die of errors (from perspective of caller)
0cda2667
DM
593 croak "We're outta here!";
594
aaca3d9d
MS
595 # die of errors with stack backtrace
596 confess "not implemented";
597
ed504453
JK
598 # cluck, longmess and shortmess not exported by default
599 use Carp qw(cluck longmess shortmess);
0cda2667 600 cluck "This is how we got here!";
ed504453
JK
601 $long_message = longmess( "message from cluck() or confess()" );
602 $short_message = shortmess( "message from carp() or croak()" );
0cda2667 603
0cda2667
DM
604=head1 DESCRIPTION
605
606The Carp routines are useful in your own modules because
ed504453 607they act like C<die()> or C<warn()>, but with a message which is more
0cda2667 608likely to be useful to a user of your module. In the case of
ed504453
JK
609C<cluck()> and C<confess()>, that context is a summary of every
610call in the call-stack; C<longmess()> returns the contents of the error
611message.
612
613For a shorter message you can use C<carp()> or C<croak()> which report the
614error as being from where your module was called. C<shortmess()> returns the
615contents of this error message. There is no guarantee that that is where the
616error was, but it is a good educated guess.
0cda2667
DM
617
618You can also alter the way the output and logic of C<Carp> works, by
619changing some global variables in the C<Carp> namespace. See the
620section on C<GLOBAL VARIABLES> below.
621
3b46207f 622Here is a more complete description of how C<carp> and C<croak> work.
d735c2ef
BT
623What they do is search the call-stack for a function call stack where
624they have not been told that there shouldn't be an error. If every
625call is marked safe, they give up and give a full stack backtrace
626instead. In other words they presume that the first likely looking
627potential suspect is guilty. Their rules for telling whether
0cda2667
DM
628a call shouldn't generate errors work as follows:
629
630=over 4
631
632=item 1.
633
634Any call from a package to itself is safe.
635
636=item 2.
637
638Packages claim that there won't be errors on calls to or from
d735c2ef
BT
639packages explicitly marked as safe by inclusion in C<@CARP_NOT>, or
640(if that array is empty) C<@ISA>. The ability to override what
0cda2667
DM
641@ISA says is new in 5.8.
642
643=item 3.
644
645The trust in item 2 is transitive. If A trusts B, and B
d735c2ef
BT
646trusts C, then A trusts C. So if you do not override C<@ISA>
647with C<@CARP_NOT>, then this trust relationship is identical to,
0cda2667
DM
648"inherits from".
649
650=item 4.
651
652Any call from an internal Perl module is safe. (Nothing keeps
653user modules from marking themselves as internal to Perl, but
654this practice is discouraged.)
655
656=item 5.
657
d735c2ef
BT
658Any call to Perl's warning system (eg Carp itself) is safe.
659(This rule is what keeps it from reporting the error at the
660point where you call C<carp> or C<croak>.)
661
662=item 6.
663
664C<$Carp::CarpLevel> can be set to skip a fixed number of additional
665call levels. Using this is not recommended because it is very
666difficult to get it to behave correctly.
0cda2667
DM
667
668=back
669
670=head2 Forcing a Stack Trace
671
672As a debugging aid, you can force Carp to treat a croak as a confess
673and a carp as a cluck across I<all> modules. In other words, force a
674detailed stack trace to be given. This can be very helpful when trying
675to understand why, or from where, a warning or error is being generated.
676
677This 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
11ed4d01 682or by including the string C<-MCarp=verbose> in the PERL5OPT
0cda2667
DM
683environment variable.
684
685Alternately, you can set the global variable C<$Carp::Verbose> to true.
686See the C<GLOBAL VARIABLES> section below.
687
b4bf645b
DM
688=head2 Stack Trace formatting
689
690At each stack level, the subroutine's name is displayed along with
691its parameters. For simple scalars, this is sufficient. For complex
692data types, such as objects and other references, this can simply
693display C<'HASH(0x1ab36d8)'>.
694
f7c3eab3 695Carp gives two ways to control this.
b4bf645b
DM
696
697=over 4
698
699=item 1.
700
701For objects, a method, C<CARP_TRACE>, will be called, if it exists. If
702this method doesn't exist, or it recurses into C<Carp>, or it otherwise
703throws an exception, this is skipped, and Carp moves on to the next option,
704otherwise checking stops and the string returned is used. It is recommended
705that the object's type is part of the string to make debugging easier.
706
707=item 2.
708
709For any type of reference, C<$Carp::RefArgFormatter> is checked (see below).
710This variable is expected to be a code reference, and the current parameter
711is passed in. If this function doesn't exist (the variable is undef), or
712it recurses into C<Carp>, or it otherwise throws an exception, this is
f7c3eab3 713skipped, and Carp moves on to the next option, otherwise checking stops
b4bf645b
DM
714and the string returned is used.
715
05e287df 716=item 3.
b4bf645b 717
f7c3eab3
TC
718Otherwise, if neither C<CARP_TRACE> nor C<$Carp::RefArgFormatter> is
719available, stringify the value ignoring any overloading.
b4bf645b
DM
720
721=back
722
0cda2667
DM
723=head1 GLOBAL VARIABLES
724
0cda2667
DM
725=head2 $Carp::MaxEvalLen
726
727This variable determines how many characters of a string-eval are to
728be shown in the output. Use a value of C<0> to show all text.
729
730Defaults to C<0>.
731
732=head2 $Carp::MaxArgLen
733
734This variable determines how many characters of each argument to a
735function to print. Use a value of C<0> to show the full length of the
736argument.
737
738Defaults to C<64>.
739
740=head2 $Carp::MaxArgNums
741
742This variable determines how many arguments to each function to show.
743Use a value of C<0> to show all arguments to a function call.
744
745Defaults to C<8>.
746
747=head2 $Carp::Verbose
748
ed504453
JK
749This variable makes C<carp()> and C<croak()> generate stack backtraces
750just like C<cluck()> and C<confess()>. This is how C<use Carp 'verbose'>
d735c2ef
BT
751is implemented internally.
752
753Defaults to C<0>.
754
b4bf645b
DM
755=head2 $Carp::RefArgFormatter
756
757This variable sets a general argument formatter to display references.
758Plain scalars and objects that implement C<CARP_TRACE> will not go through
759this formatter. Calling C<Carp> from within this function is not supported.
760
761local $Carp::RefArgFormatter = sub {
762 require Data::Dumper;
763 Data::Dumper::Dump($_[0]); # not necessarily safe
764};
765
b60d6605
AG
766=head2 @CARP_NOT
767
768This variable, I<in your package>, says which packages are I<not> to be
769considered as the location of an error. The C<carp()> and C<cluck()>
770functions will skip over callers when reporting where an error occurred.
771
772NB: 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
783Example 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
795This would make C<Carp> report the error as coming from a caller not
796in C<My::Carping::Package>, nor from C<My::Friendly::Caller>.
797
345e2394 798Also read the L</DESCRIPTION> section above, about how C<Carp> decides
b60d6605
AG
799where the error is reported from.
800
801Use C<@CARP_NOT>, instead of C<$Carp::CarpLevel>.
802
803Overrides C<Carp>'s use of C<@ISA>.
804
d735c2ef
BT
805=head2 %Carp::Internal
806
807This says what packages are internal to Perl. C<Carp> will never
808report an error as being from a line in a package that is internal to
809Perl. For example:
810
2a6a7022 811 $Carp::Internal{ (__PACKAGE__) }++;
d735c2ef
BT
812 # time passes...
813 sub foo { ... or confess("whatever") };
814
815would give a full stack backtrace starting from the first caller
816outside of __PACKAGE__. (Unless that package was also internal to
817Perl.)
818
819=head2 %Carp::CarpInternal
820
821This says which packages are internal to Perl's warning system. For
822generating a full stack backtrace this is the same as being internal
823to Perl, the stack backtrace will not start inside packages that are
824listed in C<%Carp::CarpInternal>. But it is slightly different for
825the summary message generated by C<carp> or C<croak>. There errors
826will not be reported on any lines that are calling packages in
827C<%Carp::CarpInternal>.
828
829For example C<Carp> itself is listed in C<%Carp::CarpInternal>.
830Therefore the full stack backtrace from C<confess> will not start
831inside of C<Carp>, and the short message from calling C<croak> is
832not placed on the line where C<croak> was called.
833
834=head2 $Carp::CarpLevel
0cda2667 835
d735c2ef
BT
836This variable determines how many additional call frames are to be
837skipped that would not otherwise be when reporting where an error
838occurred on a call to one of C<Carp>'s functions. It is fairly easy
839to count these call frames on calls that generate a full stack
840backtrace. However it is much harder to do this accounting for calls
841that generate a short message. Usually people skip too many call
842frames. If they are lucky they skip enough that C<Carp> goes all of
843the way through the call stack, realizes that something is wrong, and
844then generates a full stack backtrace. If they are unlucky then the
845error is reported from somewhere misleading very high in the call
846stack.
847
848Therefore it is best to avoid C<$Carp::CarpLevel>. Instead use
3b46207f 849C<@CARP_NOT>, C<%Carp::Internal> and C<%Carp::CarpInternal>.
0cda2667
DM
850
851Defaults to C<0>.
852
0cda2667
DM
853=head1 BUGS
854
855The Carp routines don't handle exception objects currently.
856If called with a first argument that is a reference, they simply
857call die() or warn(), as appropriate.
858
6ffbec2c
Z
859Some of the Carp code assumes that Perl's basic character encoding is
860ASCII, and will go wrong on an EBCDIC platform.
861
634ff085
Z
862=head1 SEE ALSO
863
864L<Carp::Always>,
865L<Carp::Clan>
866
867=head1 AUTHOR
868
869The Carp module first appeared in Larry Wall's perl 5.000 distribution.
870Since then it has been modified by several of the perl 5 porters.
871Andrew Main (Zefram) <zefram@fysh.org> divested Carp into an independent
872distribution.
873
874=head1 COPYRIGHT
875
3f2a9fa3 876Copyright (C) 1994-2013 Larry Wall
634ff085 877
3f2a9fa3 878Copyright (C) 2011, 2012, 2013 Andrew Main (Zefram) <zefram@fysh.org>
634ff085
Z
879
880=head1 LICENSE
881
882This module is free software; you can redistribute it and/or modify it
883under the same terms as Perl itself.