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