dist/Carp/lib/Carp.pm

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