dist/Carp/lib/Carp.pm

   1 package Carp;
   2
   3 { use 5.006; }
   4 use strict;
   5 use warnings;
   6
   7 BEGIN {
   8     no strict "refs";
   9     if(exists($::{"utf8::"}) && exists(*{$::{"utf8::"}}{HASH}->{"is_utf8"}) &&
  10             defined(*{*{$::{"utf8::"}}{HASH}->{"is_utf8"}}{CODE})) {
  11         *is_utf8 = \&{"utf8::is_utf8"};
  12     } else {
  13         *is_utf8 = sub { 0 };
  14     }
  15 }
  16
  17 BEGIN {
  18     no strict "refs";
  19     if(exists($::{"utf8::"}) && exists(*{$::{"utf8::"}}{HASH}->{"downgrade"}) &&
  20             defined(*{*{$::{"utf8::"}}{HASH}->{"downgrade"}}{CODE})) {
  21         *downgrade = \&{"utf8::downgrade"};
  22     } else {
  23         *downgrade = sub {};
  24     }
  25 }
  26
  27 our $VERSION = '1.30';
  28
  29 our $MaxEvalLen = 0;
  30 our $Verbose    = 0;
  31 our $CarpLevel  = 0;
  32 our $MaxArgLen  = 64;    # How much of each argument to print. 0 = all.
  33 our $MaxArgNums = 8;     # How many arguments to print. 0 = all.
  34
  35 require Exporter;
  36 our @ISA       = ('Exporter');
  37 our @EXPORT    = qw(confess croak carp);
  38 our @EXPORT_OK = qw(cluck verbose longmess shortmess);
  39 our @EXPORT_FAIL = qw(verbose);    # hook to enable verbose mode
  40
  41 # The members of %Internal are packages that are internal to perl.
  42 # Carp will not report errors from within these packages if it
  43 # can.  The members of %CarpInternal are internal to Perl's warning
  44 # system.  Carp will not report errors from within these packages
  45 # either, and will not report calls *to* these packages for carp and
  46 # croak.  They replace $CarpLevel, which is deprecated.    The
  47 # $Max(EvalLen|(Arg(Len|Nums)) variables are used to specify how the eval
  48 # text and function arguments should be formatted when printed.
  49
  50 our %CarpInternal;
  51 our %Internal;
  52
  53 # disable these by default, so they can live w/o require Carp
  54 $CarpInternal{Carp}++;
  55 $CarpInternal{warnings}++;
  56 $Internal{Exporter}++;
  57 $Internal{'Exporter::Heavy'}++;
  58
  59 # if the caller specifies verbose usage ("perl -MCarp=verbose script.pl")
  60 # then the following method will be called by the Exporter which knows
  61 # to do this thanks to @EXPORT_FAIL, above.  $_[1] will contain the word
  62 # 'verbose'.
  63
  64 sub export_fail { shift; $Verbose = shift if $_[0] eq 'verbose'; @_ }
  65
  66 sub _cgc {
  67     no strict 'refs';
  68     return \&{"CORE::GLOBAL::caller"} if defined &{"CORE::GLOBAL::caller"};
  69     return;
  70 }
  71
  72 sub longmess {
  73     # Icky backwards compatibility wrapper. :-(
  74     #
  75     # The story is that the original implementation hard-coded the
  76     # number of call levels to go back, so calls to longmess were off
  77     # by one.  Other code began calling longmess and expecting this
  78     # behaviour, so the replacement has to emulate that behaviour.
  79     my $cgc = _cgc();
  80     my $call_pack = $cgc ? $cgc->() : caller();
  81     if ( $Internal{$call_pack} or $CarpInternal{$call_pack} ) {
  82         return longmess_heavy(@_);
  83     }
  84     else {
  85         local $CarpLevel = $CarpLevel + 1;
  86         return longmess_heavy(@_);
  87     }
  88 }
  89
  90 our @CARP_NOT;
  91
  92 sub shortmess {
  93     my $cgc = _cgc();
  94
  95     # Icky backwards compatibility wrapper. :-(
  96     local @CARP_NOT = $cgc ? $cgc->() : caller();
  97     shortmess_heavy(@_);
  98 }
  99
 100 sub croak   { die shortmess @_ }
 101 sub confess { die longmess @_ }
 102 sub carp    { warn shortmess @_ }
 103 sub cluck   { warn longmess @_ }
 104
 105 BEGIN {
 106     if("$]" >= 5.015002 || ("$]" >= 5.014002 && "$]" < 5.015) ||
 107             ("$]" >= 5.012005 && "$]" < 5.013)) {
 108         *CALLER_OVERRIDE_CHECK_OK = sub () { 1 };
 109     } else {
 110         *CALLER_OVERRIDE_CHECK_OK = sub () { 0 };
 111     }
 112 }
 113
 114 sub caller_info {
 115     my $i = shift(@_) + 1;
 116     my %call_info;
 117     my $cgc = _cgc();
 118     {
 119         # Some things override caller() but forget to implement the
 120         # @DB::args part of it, which we need.  We check for this by
 121         # pre-populating @DB::args with a sentinel which no-one else
 122         # has the address of, so that we can detect whether @DB::args
 123         # has been properly populated.  However, on earlier versions
 124         # of perl this check tickles a bug in CORE::caller() which
 125         # leaks memory.  So we only check on fixed perls.
 126         @DB::args = \$i if CALLER_OVERRIDE_CHECK_OK;
 127         package DB;
 128         @call_info{
 129             qw(pack file line sub has_args wantarray evaltext is_require) }
 130             = $cgc ? $cgc->($i) : caller($i);
 131     }
 132
 133     unless ( defined $call_info{file} ) {
 134         return ();
 135     }
 136
 137     my $sub_name = Carp::get_subname( \%call_info );
 138     if ( $call_info{has_args} ) {
 139         my @args;
 140         if (CALLER_OVERRIDE_CHECK_OK && @DB::args == 1
 141             && ref $DB::args[0] eq ref \$i
 142             && $DB::args[0] == \$i ) {
 143             @DB::args = ();    # Don't let anyone see the address of $i
 144             local $@;
 145             my $where = eval {
 146                 my $func    = $cgc or return '';
 147                 my $gv      =
 148                     *{
 149                         ( $::{"B::"} || return '')       # B stash
 150                           ->{svref_2object} || return '' # entry in stash
 151                      }{CODE}                             # coderef in entry
 152                         ->($func)->GV;
 153                 my $package = $gv->STASH->NAME;
 154                 my $subname = $gv->NAME;
 155                 return unless defined $package && defined $subname;
 156
 157                 # returning CORE::GLOBAL::caller isn't useful for tracing the cause:
 158                 return if $package eq 'CORE::GLOBAL' && $subname eq 'caller';
 159                 " in &${package}::$subname";
 160             } || '';
 161             @args
 162                 = "** Incomplete caller override detected$where; \@DB::args were not set **";
 163         }
 164         else {
 165             @args = @DB::args;
 166             my $overflow;
 167             if ( $MaxArgNums and @args > $MaxArgNums )
 168             {    # More than we want to show?
 169                 $#args = $MaxArgNums;
 170                 $overflow = 1;
 171             }
 172
 173             @args = map { Carp::format_arg($_) } @args;
 174
 175             if ($overflow) {
 176                 push @args, '...';
 177             }
 178         }
 179
 180         # Push the args onto the subroutine
 181         $sub_name .= '(' . join( ', ', @args ) . ')';
 182     }
 183     $call_info{sub_name} = $sub_name;
 184     return wantarray() ? %call_info : \%call_info;
 185 }
 186
 187 # Transform an argument to a function into a string.
 188 sub format_arg {
 189     my $arg = shift;
 190     if ( ref($arg) ) {
 191         $arg = defined($overload::VERSION) ? overload::StrVal($arg) : "$arg";
 192     }
 193     if ( defined($arg) ) {
 194         $arg =~ s/'/\\'/g;
 195         $arg = str_len_trim( $arg, $MaxArgLen );
 196
 197         # Quote it?
 198         # Downgrade, and use [0-9] rather than \d, to avoid loading
 199         # Unicode tables, which would be liable to fail if we're
 200         # processing a syntax error.
 201         downgrade($arg, 1);
 202         $arg = "'$arg'" unless $arg =~ /^-?[0-9.]+\z/;
 203     }
 204     else {
 205         $arg = 'undef';
 206     }
 207
 208     # The following handling of "control chars" is direct from
 209     # the original code - it is broken on Unicode though.
 210     # Suggestions?
 211     is_utf8($arg)
 212         or $arg =~ s/([[:cntrl:]]|[[:^ascii:]])/sprintf("\\x{%x}",ord($1))/eg;
 213     return $arg;
 214 }
 215
 216 # Takes an inheritance cache and a package and returns
 217 # an anon hash of known inheritances and anon array of
 218 # inheritances which consequences have not been figured
 219 # for.
 220 sub get_status {
 221     my $cache = shift;
 222     my $pkg   = shift;
 223     $cache->{$pkg} ||= [ { $pkg => $pkg }, [ trusts_directly($pkg) ] ];
 224     return @{ $cache->{$pkg} };
 225 }
 226
 227 # Takes the info from caller() and figures out the name of
 228 # the sub/require/eval
 229 sub get_subname {
 230     my $info = shift;
 231     if ( defined( $info->{evaltext} ) ) {
 232         my $eval = $info->{evaltext};
 233         if ( $info->{is_require} ) {
 234             return "require $eval";
 235         }
 236         else {
 237             $eval =~ s/([\\\'])/\\$1/g;
 238             return "eval '" . str_len_trim( $eval, $MaxEvalLen ) . "'";
 239         }
 240     }
 241
 242     # this can happen on older perls when the sub (or the stash containing it)
 243     # has been deleted
 244     if ( !defined( $info->{sub} ) ) {
 245         return '__ANON__::__ANON__';
 246     }
 247
 248     return ( $info->{sub} eq '(eval)' ) ? 'eval {...}' : $info->{sub};
 249 }
 250
 251 # Figures out what call (from the point of view of the caller)
 252 # the long error backtrace should start at.
 253 sub long_error_loc {
 254     my $i;
 255     my $lvl = $CarpLevel;
 256     {
 257         ++$i;
 258         my $cgc = _cgc();
 259         my @caller = $cgc ? $cgc->($i) : caller($i);
 260         my $pkg = $caller[0];
 261         unless ( defined($pkg) ) {
 262
 263             # This *shouldn't* happen.
 264             if (%Internal) {
 265                 local %Internal;
 266                 $i = long_error_loc();
 267                 last;
 268             }
 269             elsif (defined $caller[2]) {
 270                 # this can happen when the stash has been deleted
 271                 # in that case, just assume that it's a reasonable place to
 272                 # stop (the file and line data will still be intact in any
 273                 # case) - the only issue is that we can't detect if the
 274                 # deleted package was internal (so don't do that then)
 275                 # -doy
 276                 redo unless 0 > --$lvl;
 277                 last;
 278             }
 279             else {
 280                 return 2;
 281             }
 282         }
 283         redo if $CarpInternal{$pkg};
 284         redo unless 0 > --$lvl;
 285         redo if $Internal{$pkg};
 286     }
 287     return $i - 1;
 288 }
 289
 290 sub longmess_heavy {
 291     return @_ if ref( $_[0] );    # don't break references as exceptions
 292     my $i = long_error_loc();
 293     return ret_backtrace( $i, @_ );
 294 }
 295
 296 # Returns a full stack backtrace starting from where it is
 297 # told.
 298 sub ret_backtrace {
 299     my ( $i, @error ) = @_;
 300     my $mess;
 301     my $err = join '', @error;
 302     $i++;
 303
 304     my $tid_msg = '';
 305     if ( defined &threads::tid ) {
 306         my $tid = threads->tid;
 307         $tid_msg = " thread $tid" if $tid;
 308     }
 309
 310     my %i = caller_info($i);
 311     $mess = "$err at $i{file} line $i{line}$tid_msg";
 312     if( defined $. ) {
 313         local $@ = '';
 314         local $SIG{__DIE__};
 315         eval {
 316             CORE::die;
 317         };
 318         if($@ =~ /^Died at .*(, <.*?> line \d+).$/ ) {
 319             $mess .= $1;
 320         }
 321     }
 322     $mess .= "\.\n";
 323
 324     while ( my %i = caller_info( ++$i ) ) {
 325         $mess .= "\t$i{sub_name} called at $i{file} line $i{line}$tid_msg\n";
 326     }
 327
 328     return $mess;
 329 }
 330
 331 sub ret_summary {
 332     my ( $i, @error ) = @_;
 333     my $err = join '', @error;
 334     $i++;
 335
 336     my $tid_msg = '';
 337     if ( defined &threads::tid ) {
 338         my $tid = threads->tid;
 339         $tid_msg = " thread $tid" if $tid;
 340     }
 341
 342     my %i = caller_info($i);
 343     return "$err at $i{file} line $i{line}$tid_msg\.\n";
 344 }
 345
 346 sub short_error_loc {
 347     # You have to create your (hash)ref out here, rather than defaulting it
 348     # inside trusts *on a lexical*, as you want it to persist across calls.
 349     # (You can default it on $_[2], but that gets messy)
 350     my $cache = {};
 351     my $i     = 1;
 352     my $lvl   = $CarpLevel;
 353     {
 354         my $cgc = _cgc();
 355         my $called = $cgc ? $cgc->($i) : caller($i);
 356         $i++;
 357         my $caller = $cgc ? $cgc->($i) : caller($i);
 358
 359         if (!defined($caller)) {
 360             my @caller = $cgc ? $cgc->($i) : caller($i);
 361             if (@caller) {
 362                 # if there's no package but there is other caller info, then
 363                 # the package has been deleted - treat this as a valid package
 364                 # in this case
 365                 redo if defined($called) && $CarpInternal{$called};
 366                 redo unless 0 > --$lvl;
 367                 last;
 368             }
 369             else {
 370                 return 0;
 371             }
 372         }
 373         redo if $Internal{$caller};
 374         redo if $CarpInternal{$caller};
 375         redo if $CarpInternal{$called};
 376         redo if trusts( $called, $caller, $cache );
 377         redo if trusts( $caller, $called, $cache );
 378         redo unless 0 > --$lvl;
 379     }
 380     return $i - 1;
 381 }
 382
 383 sub shortmess_heavy {
 384     return longmess_heavy(@_) if $Verbose;
 385     return @_ if ref( $_[0] );    # don't break references as exceptions
 386     my $i = short_error_loc();
 387     if ($i) {
 388         ret_summary( $i, @_ );
 389     }
 390     else {
 391         longmess_heavy(@_);
 392     }
 393 }
 394
 395 # If a string is too long, trims it with ...
 396 sub str_len_trim {
 397     my $str = shift;
 398     my $max = shift || 0;
 399     if ( 2 < $max and $max < length($str) ) {
 400         substr( $str, $max - 3 ) = '...';
 401     }
 402     return $str;
 403 }
 404
 405 # Takes two packages and an optional cache.  Says whether the
 406 # first inherits from the second.
 407 #
 408 # Recursive versions of this have to work to avoid certain
 409 # possible endless loops, and when following long chains of
 410 # inheritance are less efficient.
 411 sub trusts {
 412     my $child  = shift;
 413     my $parent = shift;
 414     my $cache  = shift;
 415     my ( $known, $partial ) = get_status( $cache, $child );
 416
 417     # Figure out consequences until we have an answer
 418     while ( @$partial and not exists $known->{$parent} ) {
 419         my $anc = shift @$partial;
 420         next if exists $known->{$anc};
 421         $known->{$anc}++;
 422         my ( $anc_knows, $anc_partial ) = get_status( $cache, $anc );
 423         my @found = keys %$anc_knows;
 424         @$known{@found} = ();
 425         push @$partial, @$anc_partial;
 426     }
 427     return exists $known->{$parent};
 428 }
 429
 430 # Takes a package and gives a list of those trusted directly
 431 sub trusts_directly {
 432     my $class = shift;
 433     no strict 'refs';
 434     my $stash = \%{"$class\::"};
 435     for my $var (qw/ CARP_NOT ISA /) {
 436         # Don't try using the variable until we know it exists,
 437         # to avoid polluting the caller's namespace.
 438         if ( $stash->{$var} && @{"$class\::$var"} ) {
 439            return @{"$class\::$var"}
 440         }
 441     }
 442     return;
 443 }
 444
 445 if(!defined($warnings::VERSION) ||
 446         do { no warnings "numeric"; $warnings::VERSION < 1.03 }) {
 447     # Very old versions of warnings.pm import from Carp.  This can go
 448     # wrong due to the circular dependency.  If Carp is invoked before
 449     # warnings, then Carp starts by loading warnings, then warnings
 450     # tries to import from Carp, and gets nothing because Carp is in
 451     # the process of loading and hasn't defined its import method yet.
 452     # So we work around that by manually exporting to warnings here.
 453     no strict "refs";
 454     *{"warnings::$_"} = \&$_ foreach @EXPORT;
 455 }
 456
 457 1;
 458
 459 __END__
 460
 461 =head1 NAME
 462
 463 Carp - alternative warn and die for modules
 464
 465 =head1 SYNOPSIS
 466
 467     use Carp;
 468
 469     # warn user (from perspective of caller)
 470     carp "string trimmed to 80 chars";
 471
 472     # die of errors (from perspective of caller)
 473     croak "We're outta here!";
 474
 475     # die of errors with stack backtrace
 476     confess "not implemented";
 477
 478     # cluck, longmess and shortmess not exported by default
 479     use Carp qw(cluck longmess shortmess);
 480     cluck "This is how we got here!";
 481     $long_message   = longmess( "message from cluck() or confess()" );
 482     $short_message  = shortmess( "message from carp() or croak()" );
 483
 484 =head1 DESCRIPTION
 485
 486 The Carp routines are useful in your own modules because
 487 they act like C<die()> or C<warn()>, but with a message which is more
 488 likely to be useful to a user of your module.  In the case of
 489 C<cluck()> and C<confess()>, that context is a summary of every
 490 call in the call-stack; C<longmess()> returns the contents of the error
 491 message.
 492
 493 For a shorter message you can use C<carp()> or C<croak()> which report the
 494 error as being from where your module was called.  C<shortmess()> returns the
 495 contents of this error message.  There is no guarantee that that is where the
 496 error was, but it is a good educated guess.
 497
 498 You can also alter the way the output and logic of C<Carp> works, by
 499 changing some global variables in the C<Carp> namespace. See the
 500 section on C<GLOBAL VARIABLES> below.
 501
 502 Here is a more complete description of how C<carp> and C<croak> work.
 503 What they do is search the call-stack for a function call stack where
 504 they have not been told that there shouldn't be an error.  If every
 505 call is marked safe, they give up and give a full stack backtrace
 506 instead.  In other words they presume that the first likely looking
 507 potential suspect is guilty.  Their rules for telling whether
 508 a call shouldn't generate errors work as follows:
 509
 510 =over 4
 511
 512 =item 1.
 513
 514 Any call from a package to itself is safe.
 515
 516 =item 2.
 517
 518 Packages claim that there won't be errors on calls to or from
 519 packages explicitly marked as safe by inclusion in C<@CARP_NOT>, or
 520 (if that array is empty) C<@ISA>.  The ability to override what
 521 @ISA says is new in 5.8.
 522
 523 =item 3.
 524
 525 The trust in item 2 is transitive.  If A trusts B, and B
 526 trusts C, then A trusts C.  So if you do not override C<@ISA>
 527 with C<@CARP_NOT>, then this trust relationship is identical to,
 528 "inherits from".
 529
 530 =item 4.
 531
 532 Any call from an internal Perl module is safe.  (Nothing keeps
 533 user modules from marking themselves as internal to Perl, but
 534 this practice is discouraged.)
 535
 536 =item 5.
 537
 538 Any call to Perl's warning system (eg Carp itself) is safe.
 539 (This rule is what keeps it from reporting the error at the
 540 point where you call C<carp> or C<croak>.)
 541
 542 =item 6.
 543
 544 C<$Carp::CarpLevel> can be set to skip a fixed number of additional
 545 call levels.  Using this is not recommended because it is very
 546 difficult to get it to behave correctly.
 547
 548 =back
 549
 550 =head2 Forcing a Stack Trace
 551
 552 As a debugging aid, you can force Carp to treat a croak as a confess
 553 and a carp as a cluck across I<all> modules. In other words, force a
 554 detailed stack trace to be given.  This can be very helpful when trying
 555 to understand why, or from where, a warning or error is being generated.
 556
 557 This feature is enabled by 'importing' the non-existent symbol
 558 'verbose'. You would typically enable it by saying
 559
 560     perl -MCarp=verbose script.pl
 561
 562 or by including the string C<-MCarp=verbose> in the PERL5OPT
 563 environment variable.
 564
 565 Alternately, you can set the global variable C<$Carp::Verbose> to true.
 566 See the C<GLOBAL VARIABLES> section below.
 567
 568 =head1 GLOBAL VARIABLES
 569
 570 =head2 $Carp::MaxEvalLen
 571
 572 This variable determines how many characters of a string-eval are to
 573 be shown in the output. Use a value of C<0> to show all text.
 574
 575 Defaults to C<0>.
 576
 577 =head2 $Carp::MaxArgLen
 578
 579 This variable determines how many characters of each argument to a
 580 function to print. Use a value of C<0> to show the full length of the
 581 argument.
 582
 583 Defaults to C<64>.
 584
 585 =head2 $Carp::MaxArgNums
 586
 587 This variable determines how many arguments to each function to show.
 588 Use a value of C<0> to show all arguments to a function call.
 589
 590 Defaults to C<8>.
 591
 592 =head2 $Carp::Verbose
 593
 594 This variable makes C<carp()> and C<croak()> generate stack backtraces
 595 just like C<cluck()> and C<confess()>.  This is how C<use Carp 'verbose'>
 596 is implemented internally.
 597
 598 Defaults to C<0>.
 599
 600 =head2 @CARP_NOT
 601
 602 This variable, I<in your package>, says which packages are I<not> to be
 603 considered as the location of an error. The C<carp()> and C<cluck()>
 604 functions will skip over callers when reporting where an error occurred.
 605
 606 NB: This variable must be in the package's symbol table, thus:
 607
 608     # These work
 609     our @CARP_NOT; # file scope
 610     use vars qw(@CARP_NOT); # package scope
 611     @My::Package::CARP_NOT = ... ; # explicit package variable
 612
 613     # These don't work
 614     sub xyz { ... @CARP_NOT = ... } # w/o declarations above
 615     my @CARP_NOT; # even at top-level
 616
 617 Example of use:
 618
 619     package My::Carping::Package;
 620     use Carp;
 621     our @CARP_NOT;
 622     sub bar     { .... or _error('Wrong input') }
 623     sub _error  {
 624         # temporary control of where'ness, __PACKAGE__ is implicit
 625         local @CARP_NOT = qw(My::Friendly::Caller);
 626         carp(@_)
 627     }
 628
 629 This would make C<Carp> report the error as coming from a caller not
 630 in C<My::Carping::Package>, nor from C<My::Friendly::Caller>.
 631
 632 Also read the L</DESCRIPTION> section above, about how C<Carp> decides
 633 where the error is reported from.
 634
 635 Use C<@CARP_NOT>, instead of C<$Carp::CarpLevel>.
 636
 637 Overrides C<Carp>'s use of C<@ISA>.
 638
 639 =head2 %Carp::Internal
 640
 641 This says what packages are internal to Perl.  C<Carp> will never
 642 report an error as being from a line in a package that is internal to
 643 Perl.  For example:
 644
 645     $Carp::Internal{ (__PACKAGE__) }++;
 646     # time passes...
 647     sub foo { ... or confess("whatever") };
 648
 649 would give a full stack backtrace starting from the first caller
 650 outside of __PACKAGE__.  (Unless that package was also internal to
 651 Perl.)
 652
 653 =head2 %Carp::CarpInternal
 654
 655 This says which packages are internal to Perl's warning system.  For
 656 generating a full stack backtrace this is the same as being internal
 657 to Perl, the stack backtrace will not start inside packages that are
 658 listed in C<%Carp::CarpInternal>.  But it is slightly different for
 659 the summary message generated by C<carp> or C<croak>.  There errors
 660 will not be reported on any lines that are calling packages in
 661 C<%Carp::CarpInternal>.
 662
 663 For example C<Carp> itself is listed in C<%Carp::CarpInternal>.
 664 Therefore the full stack backtrace from C<confess> will not start
 665 inside of C<Carp>, and the short message from calling C<croak> is
 666 not placed on the line where C<croak> was called.
 667
 668 =head2 $Carp::CarpLevel
 669
 670 This variable determines how many additional call frames are to be
 671 skipped that would not otherwise be when reporting where an error
 672 occurred on a call to one of C<Carp>'s functions.  It is fairly easy
 673 to count these call frames on calls that generate a full stack
 674 backtrace.  However it is much harder to do this accounting for calls
 675 that generate a short message.  Usually people skip too many call
 676 frames.  If they are lucky they skip enough that C<Carp> goes all of
 677 the way through the call stack, realizes that something is wrong, and
 678 then generates a full stack backtrace.  If they are unlucky then the
 679 error is reported from somewhere misleading very high in the call
 680 stack.
 681
 682 Therefore it is best to avoid C<$Carp::CarpLevel>.  Instead use
 683 C<@CARP_NOT>, C<%Carp::Internal> and C<%Carp::CarpInternal>.
 684
 685 Defaults to C<0>.
 686
 687 =head1 BUGS
 688
 689 The Carp routines don't handle exception objects currently.
 690 If called with a first argument that is a reference, they simply
 691 call die() or warn(), as appropriate.
 692
 693 =head1 SEE ALSO
 694
 695 L<Carp::Always>,
 696 L<Carp::Clan>
 697
 698 =head1 AUTHOR
 699
 700 The Carp module first appeared in Larry Wall's perl 5.000 distribution.
 701 Since then it has been modified by several of the perl 5 porters.
 702 Andrew Main (Zefram) <zefram@fysh.org> divested Carp into an independent
 703 distribution.
 704
 705 =head1 COPYRIGHT
 706
 707 Copyright (C) 1994-2012 Larry Wall
 708
 709 Copyright (C) 2011, 2012 Andrew Main (Zefram) <zefram@fysh.org>
 710
 711 =head1 LICENSE
 712
 713 This module is free software; you can redistribute it and/or modify it
 714 under the same terms as Perl itself.