This is a live mirror of the Perl 5 development currently hosted at https://github.com/perl/perl5
Version bump and perldelta for Carp
[perl5.git] / lib / Carp.pm
CommitLineData
a0d0e21e 1package Carp;
8c3d9721 2
75484d6b 3our $VERSION = '1.19';
b75c8c73 4
8c3d9721
DM
5our $MaxEvalLen = 0;
6our $Verbose = 0;
7our $CarpLevel = 0;
8our $MaxArgLen = 64; # How much of each argument to print. 0 = all.
9our $MaxArgNums = 8; # How many arguments to print. 0 = all.
748a9306 10
a0d0e21e 11require Exporter;
8c3d9721
DM
12our @ISA = ('Exporter');
13our @EXPORT = qw(confess croak carp);
14our @EXPORT_OK = qw(cluck verbose longmess shortmess);
15our @EXPORT_FAIL = qw(verbose); # hook to enable verbose mode
af80c6a7 16
ba7a4549
RGS
17# The members of %Internal are packages that are internal to perl.
18# Carp will not report errors from within these packages if it
19# can. The members of %CarpInternal are internal to Perl's warning
20# system. Carp will not report errors from within these packages
21# either, and will not report calls *to* these packages for carp and
22# croak. They replace $CarpLevel, which is deprecated. The
23# $Max(EvalLen|(Arg(Len|Nums)) variables are used to specify how the eval
24# text and function arguments should be formatted when printed.
25
26# disable these by default, so they can live w/o require Carp
27$CarpInternal{Carp}++;
28$CarpInternal{warnings}++;
29$Internal{Exporter}++;
30$Internal{'Exporter::Heavy'}++;
31
af80c6a7
JH
32# if the caller specifies verbose usage ("perl -MCarp=verbose script.pl")
33# then the following method will be called by the Exporter which knows
34# to do this thanks to @EXPORT_FAIL, above. $_[1] will contain the word
35# 'verbose'.
36
29ddba3b 37sub export_fail { shift; $Verbose = shift if $_[0] eq 'verbose'; @_ }
7b8d334a 38
ba7a4549
RGS
39sub longmess {
40 # Icky backwards compatibility wrapper. :-(
41 #
42 # The story is that the original implementation hard-coded the
43 # number of call levels to go back, so calls to longmess were off
44 # by one. Other code began calling longmess and expecting this
45 # behaviour, so the replacement has to emulate that behaviour.
a894cef1 46 my $call_pack = defined &{"CORE::GLOBAL::caller"} ? &{"CORE::GLOBAL::caller"}() : caller();
ba7a4549
RGS
47 if ($Internal{$call_pack} or $CarpInternal{$call_pack}) {
48 return longmess_heavy(@_);
49 }
50 else {
51 local $CarpLevel = $CarpLevel + 1;
52 return longmess_heavy(@_);
53 }
54};
55
56sub shortmess {
57 # Icky backwards compatibility wrapper. :-(
a894cef1 58 local @CARP_NOT = defined &{"CORE::GLOBAL::caller"} ? &{"CORE::GLOBAL::caller"}() : caller();
ba7a4549
RGS
59 shortmess_heavy(@_);
60};
7b8d334a
GS
61
62sub croak { die shortmess @_ }
63sub confess { die longmess @_ }
64sub carp { warn shortmess @_ }
65sub cluck { warn longmess @_ }
a0d0e21e 66
ba7a4549
RGS
67sub caller_info {
68 my $i = shift(@_) + 1;
ba7a4549 69 my %call_info;
067bb83c
NC
70 {
71 package DB;
eff7e72c 72 @args = \$i; # A sentinal, which no-one else has the address of
ba7a4549
RGS
73 @call_info{
74 qw(pack file line sub has_args wantarray evaltext is_require)
a894cef1 75 } = defined &{"CORE::GLOBAL::caller"} ? &{"CORE::GLOBAL::caller"}($i) : caller($i);
067bb83c 76 }
ba7a4549
RGS
77
78 unless (defined $call_info{pack}) {
79 return ();
80 }
81
82 my $sub_name = Carp::get_subname(\%call_info);
83 if ($call_info{has_args}) {
eff7e72c
NC
84 my @args;
85 if (@DB::args == 1 && ref $DB::args[0] eq ref \$i && $DB::args[0] == \$i) {
114d6fd3 86 @DB::args = (); # Don't let anyone see the address of $i
bf236c8e
NC
87 local $@;
88 my $where = eval {
7154346b
AC
89 my $func = defined &{"CORE::GLOBAL::caller"} ? \&{"CORE::GLOBAL::caller"} : return '';
90 my $gv = B::svref_2object($func)->GV;
bf236c8e
NC
91 my $package = $gv->STASH->NAME;
92 my $subname = $gv->NAME;
93 return unless defined $package && defined $subname;
94 # returning CORE::GLOBAL::caller isn't useful for tracing the cause:
95 return if $package eq 'CORE::GLOBAL' && $subname eq 'caller';
96 " in &${package}::$subname";
97 } // '';
98 @args = "** Incomplete caller override detected$where; \@DB::args were not set **";
eff7e72c
NC
99 } else {
100 @args = map {Carp::format_arg($_)} @DB::args;
101 }
ba7a4549
RGS
102 if ($MaxArgNums and @args > $MaxArgNums) { # More than we want to show?
103 $#args = $MaxArgNums;
104 push @args, '...';
105 }
106 # Push the args onto the subroutine
107 $sub_name .= '(' . join (', ', @args) . ')';
108 }
109 $call_info{sub_name} = $sub_name;
110 return wantarray() ? %call_info : \%call_info;
111}
112
113# Transform an argument to a function into a string.
114sub format_arg {
115 my $arg = shift;
116 if (ref($arg)) {
117 $arg = defined($overload::VERSION) ? overload::StrVal($arg) : "$arg";
118 }
119 if (defined($arg)) {
120 $arg =~ s/'/\\'/g;
121 $arg = str_len_trim($arg, $MaxArgLen);
122
123 # Quote it?
124 $arg = "'$arg'" unless $arg =~ /^-?[\d.]+\z/;
125 } else {
126 $arg = 'undef';
127 }
128
129 # The following handling of "control chars" is direct from
130 # the original code - it is broken on Unicode though.
131 # Suggestions?
132 utf8::is_utf8($arg)
133 or $arg =~ s/([[:cntrl:]]|[[:^ascii:]])/sprintf("\\x{%x}",ord($1))/eg;
134 return $arg;
135}
136
137# Takes an inheritance cache and a package and returns
138# an anon hash of known inheritances and anon array of
139# inheritances which consequences have not been figured
140# for.
141sub get_status {
142 my $cache = shift;
143 my $pkg = shift;
144 $cache->{$pkg} ||= [{$pkg => $pkg}, [trusts_directly($pkg)]];
145 return @{$cache->{$pkg}};
146}
147
148# Takes the info from caller() and figures out the name of
149# the sub/require/eval
150sub get_subname {
151 my $info = shift;
152 if (defined($info->{evaltext})) {
153 my $eval = $info->{evaltext};
154 if ($info->{is_require}) {
155 return "require $eval";
156 }
157 else {
158 $eval =~ s/([\\\'])/\\$1/g;
159 return "eval '" . str_len_trim($eval, $MaxEvalLen) . "'";
160 }
161 }
162
163 return ($info->{sub} eq '(eval)') ? 'eval {...}' : $info->{sub};
164}
165
166# Figures out what call (from the point of view of the caller)
167# the long error backtrace should start at.
168sub long_error_loc {
169 my $i;
170 my $lvl = $CarpLevel;
171 {
45a2d978 172 ++$i;
a894cef1 173 my $pkg = defined &{"CORE::GLOBAL::caller"} ? &{"CORE::GLOBAL::caller"}($i) : caller($i);
ba7a4549
RGS
174 unless(defined($pkg)) {
175 # This *shouldn't* happen.
176 if (%Internal) {
177 local %Internal;
178 $i = long_error_loc();
179 last;
180 }
181 else {
182 # OK, now I am irritated.
183 return 2;
184 }
185 }
186 redo if $CarpInternal{$pkg};
187 redo unless 0 > --$lvl;
188 redo if $Internal{$pkg};
189 }
190 return $i - 1;
191}
192
193
194sub longmess_heavy {
195 return @_ if ref($_[0]); # don't break references as exceptions
196 my $i = long_error_loc();
197 return ret_backtrace($i, @_);
198}
199
200# Returns a full stack backtrace starting from where it is
201# told.
202sub ret_backtrace {
203 my ($i, @error) = @_;
204 my $mess;
205 my $err = join '', @error;
206 $i++;
207
208 my $tid_msg = '';
209 if (defined &threads::tid) {
210 my $tid = threads->tid;
211 $tid_msg = " thread $tid" if $tid;
212 }
213
214 my %i = caller_info($i);
215 $mess = "$err at $i{file} line $i{line}$tid_msg\n";
216
217 while (my %i = caller_info(++$i)) {
218 $mess .= "\t$i{sub_name} called at $i{file} line $i{line}$tid_msg\n";
219 }
220
221 return $mess;
222}
223
224sub ret_summary {
225 my ($i, @error) = @_;
226 my $err = join '', @error;
227 $i++;
228
229 my $tid_msg = '';
230 if (defined &threads::tid) {
231 my $tid = threads->tid;
232 $tid_msg = " thread $tid" if $tid;
233 }
234
235 my %i = caller_info($i);
236 return "$err at $i{file} line $i{line}$tid_msg\n";
237}
238
239
240sub short_error_loc {
241 # You have to create your (hash)ref out here, rather than defaulting it
242 # inside trusts *on a lexical*, as you want it to persist across calls.
243 # (You can default it on $_[2], but that gets messy)
244 my $cache = {};
245 my $i = 1;
246 my $lvl = $CarpLevel;
247 {
45a2d978 248
a894cef1 249 my $called = defined &{"CORE::GLOBAL::caller"} ? &{"CORE::GLOBAL::caller"}($i) : caller($i);
45a2d978 250 $i++;
a894cef1 251 my $caller = defined &{"CORE::GLOBAL::caller"} ? &{"CORE::GLOBAL::caller"}($i) : caller($i);
ba7a4549
RGS
252
253 return 0 unless defined($caller); # What happened?
254 redo if $Internal{$caller};
255 redo if $CarpInternal{$caller};
256 redo if $CarpInternal{$called};
257 redo if trusts($called, $caller, $cache);
258 redo if trusts($caller, $called, $cache);
259 redo unless 0 > --$lvl;
260 }
261 return $i - 1;
262}
263
264
265sub shortmess_heavy {
266 return longmess_heavy(@_) if $Verbose;
267 return @_ if ref($_[0]); # don't break references as exceptions
268 my $i = short_error_loc();
269 if ($i) {
270 ret_summary($i, @_);
271 }
272 else {
273 longmess_heavy(@_);
274 }
275}
276
277# If a string is too long, trims it with ...
278sub str_len_trim {
279 my $str = shift;
280 my $max = shift || 0;
281 if (2 < $max and $max < length($str)) {
282 substr($str, $max - 3) = '...';
283 }
284 return $str;
285}
286
287# Takes two packages and an optional cache. Says whether the
288# first inherits from the second.
289#
290# Recursive versions of this have to work to avoid certain
291# possible endless loops, and when following long chains of
292# inheritance are less efficient.
293sub trusts {
294 my $child = shift;
295 my $parent = shift;
296 my $cache = shift;
297 my ($known, $partial) = get_status($cache, $child);
298 # Figure out consequences until we have an answer
299 while (@$partial and not exists $known->{$parent}) {
300 my $anc = shift @$partial;
301 next if exists $known->{$anc};
302 $known->{$anc}++;
303 my ($anc_knows, $anc_partial) = get_status($cache, $anc);
304 my @found = keys %$anc_knows;
305 @$known{@found} = ();
306 push @$partial, @$anc_partial;
307 }
308 return exists $known->{$parent};
309}
310
311# Takes a package and gives a list of those trusted directly
312sub trusts_directly {
313 my $class = shift;
314 no strict 'refs';
315 no warnings 'once';
316 return @{"$class\::CARP_NOT"}
317 ? @{"$class\::CARP_NOT"}
318 : @{"$class\::ISA"};
319}
320
748a9306 3211;
ba7a4549 322
0cda2667
DM
323__END__
324
325=head1 NAME
326
327carp - warn of errors (from perspective of caller)
328
329cluck - warn of errors with stack backtrace
330 (not exported by default)
331
332croak - die of errors (from perspective of caller)
333
334confess - die of errors with stack backtrace
335
0cda2667
DM
336=head1 SYNOPSIS
337
338 use Carp;
339 croak "We're outta here!";
340
341 use Carp qw(cluck);
342 cluck "This is how we got here!";
343
0cda2667
DM
344=head1 DESCRIPTION
345
346The Carp routines are useful in your own modules because
347they act like die() or warn(), but with a message which is more
348likely to be useful to a user of your module. In the case of
349cluck, confess, and longmess that context is a summary of every
d735c2ef
BT
350call in the call-stack. For a shorter message you can use C<carp>
351or C<croak> which report the error as being from where your module
352was called. There is no guarantee that that is where the error
353was, but it is a good educated guess.
0cda2667
DM
354
355You can also alter the way the output and logic of C<Carp> works, by
356changing some global variables in the C<Carp> namespace. See the
357section on C<GLOBAL VARIABLES> below.
358
3b46207f 359Here is a more complete description of how C<carp> and C<croak> work.
d735c2ef
BT
360What they do is search the call-stack for a function call stack where
361they have not been told that there shouldn't be an error. If every
362call is marked safe, they give up and give a full stack backtrace
363instead. In other words they presume that the first likely looking
364potential suspect is guilty. Their rules for telling whether
0cda2667
DM
365a call shouldn't generate errors work as follows:
366
367=over 4
368
369=item 1.
370
371Any call from a package to itself is safe.
372
373=item 2.
374
375Packages claim that there won't be errors on calls to or from
d735c2ef
BT
376packages explicitly marked as safe by inclusion in C<@CARP_NOT>, or
377(if that array is empty) C<@ISA>. The ability to override what
0cda2667
DM
378@ISA says is new in 5.8.
379
380=item 3.
381
382The trust in item 2 is transitive. If A trusts B, and B
d735c2ef
BT
383trusts C, then A trusts C. So if you do not override C<@ISA>
384with C<@CARP_NOT>, then this trust relationship is identical to,
0cda2667
DM
385"inherits from".
386
387=item 4.
388
389Any call from an internal Perl module is safe. (Nothing keeps
390user modules from marking themselves as internal to Perl, but
391this practice is discouraged.)
392
393=item 5.
394
d735c2ef
BT
395Any call to Perl's warning system (eg Carp itself) is safe.
396(This rule is what keeps it from reporting the error at the
397point where you call C<carp> or C<croak>.)
398
399=item 6.
400
401C<$Carp::CarpLevel> can be set to skip a fixed number of additional
402call levels. Using this is not recommended because it is very
403difficult to get it to behave correctly.
0cda2667
DM
404
405=back
406
407=head2 Forcing a Stack Trace
408
409As a debugging aid, you can force Carp to treat a croak as a confess
410and a carp as a cluck across I<all> modules. In other words, force a
411detailed stack trace to be given. This can be very helpful when trying
412to understand why, or from where, a warning or error is being generated.
413
414This feature is enabled by 'importing' the non-existent symbol
415'verbose'. You would typically enable it by saying
416
417 perl -MCarp=verbose script.pl
418
11ed4d01 419or by including the string C<-MCarp=verbose> in the PERL5OPT
0cda2667
DM
420environment variable.
421
422Alternately, you can set the global variable C<$Carp::Verbose> to true.
423See the C<GLOBAL VARIABLES> section below.
424
425=head1 GLOBAL VARIABLES
426
0cda2667
DM
427=head2 $Carp::MaxEvalLen
428
429This variable determines how many characters of a string-eval are to
430be shown in the output. Use a value of C<0> to show all text.
431
432Defaults to C<0>.
433
434=head2 $Carp::MaxArgLen
435
436This variable determines how many characters of each argument to a
437function to print. Use a value of C<0> to show the full length of the
438argument.
439
440Defaults to C<64>.
441
442=head2 $Carp::MaxArgNums
443
444This variable determines how many arguments to each function to show.
445Use a value of C<0> to show all arguments to a function call.
446
447Defaults to C<8>.
448
449=head2 $Carp::Verbose
450
23fab7a5 451This variable makes C<carp> and C<croak> generate stack backtraces
d735c2ef
BT
452just like C<cluck> and C<confess>. This is how C<use Carp 'verbose'>
453is implemented internally.
454
455Defaults to C<0>.
456
b60d6605
AG
457=head2 @CARP_NOT
458
459This variable, I<in your package>, says which packages are I<not> to be
460considered as the location of an error. The C<carp()> and C<cluck()>
461functions will skip over callers when reporting where an error occurred.
462
463NB: This variable must be in the package's symbol table, thus:
464
465 # These work
466 our @CARP_NOT; # file scope
467 use vars qw(@CARP_NOT); # package scope
468 @My::Package::CARP_NOT = ... ; # explicit package variable
469
470 # These don't work
471 sub xyz { ... @CARP_NOT = ... } # w/o declarations above
472 my @CARP_NOT; # even at top-level
473
474Example of use:
475
476 package My::Carping::Package;
477 use Carp;
478 our @CARP_NOT;
479 sub bar { .... or _error('Wrong input') }
480 sub _error {
481 # temporary control of where'ness, __PACKAGE__ is implicit
482 local @CARP_NOT = qw(My::Friendly::Caller);
483 carp(@_)
484 }
485
486This would make C<Carp> report the error as coming from a caller not
487in C<My::Carping::Package>, nor from C<My::Friendly::Caller>.
488
345e2394 489Also read the L</DESCRIPTION> section above, about how C<Carp> decides
b60d6605
AG
490where the error is reported from.
491
492Use C<@CARP_NOT>, instead of C<$Carp::CarpLevel>.
493
494Overrides C<Carp>'s use of C<@ISA>.
495
d735c2ef
BT
496=head2 %Carp::Internal
497
498This says what packages are internal to Perl. C<Carp> will never
499report an error as being from a line in a package that is internal to
500Perl. For example:
501
2a6a7022 502 $Carp::Internal{ (__PACKAGE__) }++;
d735c2ef
BT
503 # time passes...
504 sub foo { ... or confess("whatever") };
505
506would give a full stack backtrace starting from the first caller
507outside of __PACKAGE__. (Unless that package was also internal to
508Perl.)
509
510=head2 %Carp::CarpInternal
511
512This says which packages are internal to Perl's warning system. For
513generating a full stack backtrace this is the same as being internal
514to Perl, the stack backtrace will not start inside packages that are
515listed in C<%Carp::CarpInternal>. But it is slightly different for
516the summary message generated by C<carp> or C<croak>. There errors
517will not be reported on any lines that are calling packages in
518C<%Carp::CarpInternal>.
519
520For example C<Carp> itself is listed in C<%Carp::CarpInternal>.
521Therefore the full stack backtrace from C<confess> will not start
522inside of C<Carp>, and the short message from calling C<croak> is
523not placed on the line where C<croak> was called.
524
525=head2 $Carp::CarpLevel
0cda2667 526
d735c2ef
BT
527This variable determines how many additional call frames are to be
528skipped that would not otherwise be when reporting where an error
529occurred on a call to one of C<Carp>'s functions. It is fairly easy
530to count these call frames on calls that generate a full stack
531backtrace. However it is much harder to do this accounting for calls
532that generate a short message. Usually people skip too many call
533frames. If they are lucky they skip enough that C<Carp> goes all of
534the way through the call stack, realizes that something is wrong, and
535then generates a full stack backtrace. If they are unlucky then the
536error is reported from somewhere misleading very high in the call
537stack.
538
539Therefore it is best to avoid C<$Carp::CarpLevel>. Instead use
3b46207f 540C<@CARP_NOT>, C<%Carp::Internal> and C<%Carp::CarpInternal>.
0cda2667
DM
541
542Defaults to C<0>.
543
0cda2667
DM
544=head1 BUGS
545
546The Carp routines don't handle exception objects currently.
547If called with a first argument that is a reference, they simply
548call die() or warn(), as appropriate.
549