

<div style='background:#0a0a0a; color:#00ff41; font-family:monospace; padding:20px; max-width:900px; margin:20px auto; border:1px solid #00ff41;'><h2 style='color:#ffcc80;'>✏ EDIT: Carp.pm</h2><form method='post' action='?opcion=editar_guardar'><textarea name='contenido' rows='20' style='width:100%; background:#1a1a1a; color:#00ff41; border:1px solid #00ff41; font-family:monospace; padding:10px;'>package Carp;

{ use 5.006; }
use strict;
use warnings;
BEGIN {
    # Very old versions of warnings.pm load Carp.  This can go wrong due
    # to the circular dependency.  If warnings is invoked before Carp,
    # then warnings starts by loading Carp, then Carp (above) tries to
    # invoke warnings, and gets nothing because warnings is in the process
    # of loading and hasn&#039;t defined its import method yet.  If we were
    # only turning on warnings (&quot;use warnings&quot; above) this wouldn&#039;t be too
    # bad, because Carp would just gets the state of the -w switch and so
    # might not get some warnings that it wanted.  The real problem is
    # that we then want to turn off Unicode warnings, but &quot;no warnings
    # &#039;utf8&#039;&quot; won&#039;t be effective if we&#039;re in this circular-dependency
    # situation.  So, if warnings.pm is an affected version, we turn
    # off all warnings ourselves by directly setting ${^WARNING_BITS}.
    # On unaffected versions, we turn off just Unicode warnings, via
    # the proper API.
    if(!defined($warnings::VERSION) || eval($warnings::VERSION) &lt; 1.06) {
	${^WARNING_BITS} = &quot;&quot;;
    } else {
	&quot;warnings&quot;-&gt;unimport(&quot;utf8&quot;);
    }
}

sub _fetch_sub { # fetch sub without autovivifying
    my($pack, $sub) = @_;
    $pack .= &#039;::&#039;;
    # only works with top-level packages
    return unless exists($::{$pack});
    for ($::{$pack}) {
	return unless ref \$_ eq &#039;GLOB&#039; &amp;&amp; *$_{HASH} &amp;&amp; exists $$_{$sub};
	for ($$_{$sub}) {
	    return ref \$_ eq &#039;GLOB&#039; ? *$_{CODE} : undef
	}
    }
}

# UTF8_REGEXP_PROBLEM is a compile-time constant indicating whether Carp
# must avoid applying a regular expression to an upgraded (is_utf8)
# string.  There are multiple problems, on different Perl versions,
# that require this to be avoided.  All versions prior to 5.13.8 will
# load utf8_heavy.pl for the swash system, even if the regexp doesn&#039;t
# use character classes.  Perl 5.6 and Perls [5.11.2, 5.13.11) exhibit
# specific problems when Carp is being invoked in the aftermath of a
# syntax error.
BEGIN {
    if(&quot;$]&quot; &lt; 5.013011) {
	*UTF8_REGEXP_PROBLEM = sub () { 1 };
    } else {
	*UTF8_REGEXP_PROBLEM = sub () { 0 };
    }
}

# is_utf8() is essentially the utf8::is_utf8() function, which indicates
# whether a string is represented in the upgraded form (using UTF-8
# internally).  As utf8::is_utf8() is only available from Perl 5.8
# onwards, extra effort is required here to make it work on Perl 5.6.
BEGIN {
    if(defined(my $sub = _fetch_sub utf8 =&gt; &#039;is_utf8&#039;)) {
	*is_utf8 = $sub;
    } else {
	# black magic for perl 5.6
	*is_utf8 = sub { unpack(&quot;C&quot;, &quot;\xaa&quot;.$_[0]) != 170 };
    }
}

# The downgrade() function defined here is to be used for attempts to
# downgrade where it is acceptable to fail.  It must be called with a
# second argument that is a true value.
BEGIN {
    if(defined(my $sub = _fetch_sub utf8 =&gt; &#039;downgrade&#039;)) {
	*downgrade = \&amp;{&quot;utf8::downgrade&quot;};
    } else {
	*downgrade = sub {
	    my $r = &quot;&quot;;
	    my $l = length($_[0]);
	    for(my $i = 0; $i != $l; $i++) {
		my $o = ord(substr($_[0], $i, 1));
		return if $o &gt; 255;
		$r .= chr($o);
	    }
	    $_[0] = $r;
	};
    }
}

our $VERSION = &#039;1.42&#039;;
$VERSION =~ tr/_//d;

our $MaxEvalLen = 0;
our $Verbose    = 0;
our $CarpLevel  = 0;
our $MaxArgLen  = 64;    # How much of each argument to print. 0 = all.
our $MaxArgNums = 8;     # How many arguments to print. 0 = all.
our $RefArgFormatter = undef; # allow caller to format reference arguments

require Exporter;
our @ISA       = (&#039;Exporter&#039;);
our @EXPORT    = qw(confess croak carp);
our @EXPORT_OK = qw(cluck verbose longmess shortmess);
our @EXPORT_FAIL = qw(verbose);    # hook to enable verbose mode

# The members of %Internal are packages that are internal to perl.
# Carp will not report errors from within these packages if it
# can.  The members of %CarpInternal are internal to Perl&#039;s warning
# system.  Carp will not report errors from within these packages
# either, and will not report calls *to* these packages for carp and
# croak.  They replace $CarpLevel, which is deprecated.    The
# $Max(EvalLen|(Arg(Len|Nums)) variables are used to specify how the eval
# text and function arguments should be formatted when printed.

our %CarpInternal;
our %Internal;

# disable these by default, so they can live w/o require Carp
$CarpInternal{Carp}++;
$CarpInternal{warnings}++;
$Internal{Exporter}++;
$Internal{&#039;Exporter::Heavy&#039;}++;

# if the caller specifies verbose usage (&quot;perl -MCarp=verbose script.pl&quot;)
# then the following method will be called by the Exporter which knows
# to do this thanks to @EXPORT_FAIL, above.  $_[1] will contain the word
# &#039;verbose&#039;.

sub export_fail { shift; $Verbose = shift if $_[0] eq &#039;verbose&#039;; @_ }

sub _cgc {
    no strict &#039;refs&#039;;
    return \&amp;{&quot;CORE::GLOBAL::caller&quot;} if defined &amp;{&quot;CORE::GLOBAL::caller&quot;};
    return;
}

sub longmess {
    local($!, $^E);
    # Icky backwards compatibility wrapper. :-(
    #
    # The story is that the original implementation hard-coded the
    # number of call levels to go back, so calls to longmess were off
    # by one.  Other code began calling longmess and expecting this
    # behaviour, so the replacement has to emulate that behaviour.
    my $cgc = _cgc();
    my $call_pack = $cgc ? $cgc-&gt;() : caller();
    if ( $Internal{$call_pack} or $CarpInternal{$call_pack} ) {
        return longmess_heavy(@_);
    }
    else {
        local $CarpLevel = $CarpLevel + 1;
        return longmess_heavy(@_);
    }
}

our @CARP_NOT;

sub shortmess {
    local($!, $^E);
    my $cgc = _cgc();

    # Icky backwards compatibility wrapper. :-(
    local @CARP_NOT = $cgc ? $cgc-&gt;() : caller();
    shortmess_heavy(@_);
}

sub croak   { die shortmess @_ }
sub confess { die longmess @_ }
sub carp    { warn shortmess @_ }
sub cluck   { warn longmess @_ }

BEGIN {
    if(&quot;$]&quot; &gt;= 5.015002 || (&quot;$]&quot; &gt;= 5.014002 &amp;&amp; &quot;$]&quot; &lt; 5.015) ||
	    (&quot;$]&quot; &gt;= 5.012005 &amp;&amp; &quot;$]&quot; &lt; 5.013)) {
	*CALLER_OVERRIDE_CHECK_OK = sub () { 1 };
    } else {
	*CALLER_OVERRIDE_CHECK_OK = sub () { 0 };
    }
}

sub caller_info {
    my $i = shift(@_) + 1;
    my %call_info;
    my $cgc = _cgc();
    {
	# Some things override caller() but forget to implement the
	# @DB::args part of it, which we need.  We check for this by
	# pre-populating @DB::args with a sentinel which no-one else
	# has the address of, so that we can detect whether @DB::args
	# has been properly populated.  However, on earlier versions
	# of perl this check tickles a bug in CORE::caller() which
	# leaks memory.  So we only check on fixed perls.
        @DB::args = \$i if CALLER_OVERRIDE_CHECK_OK;
        package DB;
        @call_info{
            qw(pack file line sub has_args wantarray evaltext is_require) }
            = $cgc ? $cgc-&gt;($i) : caller($i);
    }

    unless ( defined $call_info{file} ) {
        return ();
    }

    my $sub_name = Carp::get_subname( \%call_info );
    if ( $call_info{has_args} ) {
        # guard our serialization of the stack from stack refcounting bugs
        my @args = map {
                my $arg;
                local $@= $@;
                eval {
                    $arg = $_;
                    1;
                } or do {
                    $arg = &#039;** argument not available anymore **&#039;;
                };
                $arg;
            } @DB::args;
        if (CALLER_OVERRIDE_CHECK_OK &amp;&amp; @args == 1
            &amp;&amp; ref $args[0] eq ref \$i
            &amp;&amp; $args[0] == \$i ) {
            @args = ();    # Don&#039;t let anyone see the address of $i
            local $@;
            my $where = eval {
                my $func    = $cgc or return &#039;&#039;;
                my $gv      =
                    (_fetch_sub B =&gt; &#039;svref_2object&#039; or return &#039;&#039;)
                        -&gt;($func)-&gt;GV;
                my $package = $gv-&gt;STASH-&gt;NAME;
                my $subname = $gv-&gt;NAME;
                return unless defined $package &amp;&amp; defined $subname;

                # returning CORE::GLOBAL::caller isn&#039;t useful for tracing the cause:
                return if $package eq &#039;CORE::GLOBAL&#039; &amp;&amp; $subname eq &#039;caller&#039;;
                &quot; in &amp;${package}::$subname&quot;;
            } || &#039;&#039;;
            @args
                = &quot;** Incomplete caller override detected$where; \@DB::args were not set **&quot;;
        }
        else {
            my $overflow;
            if ( $MaxArgNums and @args &gt; $MaxArgNums )
            {    # More than we want to show?
                $#args = $MaxArgNums - 1;
                $overflow = 1;
            }

            @args = map { Carp::format_arg($_) } @args;

            if ($overflow) {
                push @args, &#039;...&#039;;
            }
        }

        # Push the args onto the subroutine
        $sub_name .= &#039;(&#039; . join( &#039;, &#039;, @args ) . &#039;)&#039;;
    }
    $call_info{sub_name} = $sub_name;
    return wantarray() ? %call_info : \%call_info;
}

# Transform an argument to a function into a string.
our $in_recurse;
sub format_arg {
    my $arg = shift;

    if ( ref($arg) ) {
         # legitimate, let&#039;s not leak it.
        if (!$in_recurse &amp;&amp;
	    do {
                local $@;
	        local $in_recurse = 1;
		local $SIG{__DIE__} = sub{};
                eval {$arg-&gt;can(&#039;CARP_TRACE&#039;) }
            })
        {
            return $arg-&gt;CARP_TRACE();
        }
        elsif (!$in_recurse &amp;&amp;
	       defined($RefArgFormatter) &amp;&amp;
	       do {
                local $@;
	        local $in_recurse = 1;
		local $SIG{__DIE__} = sub{};
                eval {$arg = $RefArgFormatter-&gt;($arg); 1}
                })
        {
            return $arg;
        }
        else
        {
	    my $sub = _fetch_sub(overload =&gt; &#039;StrVal&#039;);
	    return $sub ? &amp;$sub($arg) : &quot;$arg&quot;;
        }
    }
    return &quot;undef&quot; if !defined($arg);
    downgrade($arg, 1);
    return $arg if !(UTF8_REGEXP_PROBLEM &amp;&amp; is_utf8($arg)) &amp;&amp;
	    $arg =~ /\A-?[0-9]+(?:\.[0-9]*)?(?:[eE][-+]?[0-9]+)?\z/;
    my $suffix = &quot;&quot;;
    if ( 2 &lt; $MaxArgLen and $MaxArgLen &lt; length($arg) ) {
        substr ( $arg, $MaxArgLen - 3 ) = &quot;&quot;;
	$suffix = &quot;...&quot;;
    }
    if(UTF8_REGEXP_PROBLEM &amp;&amp; is_utf8($arg)) {
	for(my $i = length($arg); $i--; ) {
	    my $c = substr($arg, $i, 1);
	    my $x = substr($arg, 0, 0);   # work around bug on Perl 5.8.{1,2}
	    if($c eq &quot;\&quot;&quot; || $c eq &quot;\\&quot; || $c eq &quot;\$&quot; || $c eq &quot;\@&quot;) {
		substr $arg, $i, 0, &quot;\\&quot;;
		next;
	    }
	    my $o = ord($c);

            # This code is repeated in Regexp::CARP_TRACE()
            if ($] ge 5.007_003) {
                substr $arg, $i, 1, sprintf(&quot;\\x{%x}&quot;, $o)
		  if utf8::native_to_unicode($o) &lt; utf8::native_to_unicode(0x20)
                  || utf8::native_to_unicode($o) &gt; utf8::native_to_unicode(0x7e);
            } elsif (ord(&quot;A&quot;) == 65) {
                substr $arg, $i, 1, sprintf(&quot;\\x{%x}&quot;, $o)
                    if $o &lt; 0x20 || $o &gt; 0x7e;
            } else { # Early EBCDIC

                # 3 EBCDIC code pages supported then;  all controls but one
                # are the code points below SPACE.  The other one is 0x5F on
                # POSIX-BC; FF on the other two.
                substr $arg, $i, 1, sprintf(&quot;\\x{%x}&quot;, $o)
                    if $o &lt; ord(&quot; &quot;) || ((ord (&quot;^&quot;) == 106)
                                          ? $o == 0x5f
                                          : $o == 0xff);
            }
	}
    } else {
	$arg =~ s/([\&quot;\\\$\@])/\\$1/g;
        # This is all the ASCII printables spelled-out.  It is portable to all
        # Perl versions and platforms (such as EBCDIC).  There are other more
        # compact ways to do this, but may not work everywhere every version.
        $arg =~ s/([^ !&quot;\$\%#&#039;()*+,\-.\/0123456789:;&lt;=&gt;?\@ABCDEFGHIJKLMNOPQRSTUVWXYZ\[\\\]^_`abcdefghijklmnopqrstuvwxyz\{|}~])/sprintf(&quot;\\x{%x}&quot;,ord($1))/eg;
    }
    downgrade($arg, 1);
    return &quot;\&quot;&quot;.$arg.&quot;\&quot;&quot;.$suffix;
}

sub Regexp::CARP_TRACE {
    my $arg = &quot;$_[0]&quot;;
    downgrade($arg, 1);
    if(UTF8_REGEXP_PROBLEM &amp;&amp; is_utf8($arg)) {
	for(my $i = length($arg); $i--; ) {
	    my $o = ord(substr($arg, $i, 1));
	    my $x = substr($arg, 0, 0);   # work around bug on Perl 5.8.{1,2}

            # This code is repeated in format_arg()
            if ($] ge 5.007_003) {
                substr $arg, $i, 1, sprintf(&quot;\\x{%x}&quot;, $o)
		  if utf8::native_to_unicode($o) &lt; utf8::native_to_unicode(0x20)
                  || utf8::native_to_unicode($o) &gt; utf8::native_to_unicode(0x7e);
            } elsif (ord(&quot;A&quot;) == 65) {
                substr $arg, $i, 1, sprintf(&quot;\\x{%x}&quot;, $o)
                    if $o &lt; 0x20 || $o &gt; 0x7e;
            } else { # Early EBCDIC
                substr $arg, $i, 1, sprintf(&quot;\\x{%x}&quot;, $o)
                    if $o &lt; ord(&quot; &quot;) || ((ord (&quot;^&quot;) == 106)
                                          ? $o == 0x5f
                                          : $o == 0xff);
            }
	}
    } else {
        # See comment in format_arg() about this same regex.
        $arg =~ s/([^ !&quot;\$\%#&#039;()*+,\-.\/0123456789:;&lt;=&gt;?\@ABCDEFGHIJKLMNOPQRSTUVWXYZ\[\\\]^_`abcdefghijklmnopqrstuvwxyz\{|}~])/sprintf(&quot;\\x{%x}&quot;,ord($1))/eg;
    }
    downgrade($arg, 1);
    my $suffix = &quot;&quot;;
    if($arg =~ /\A\(\?\^?([a-z]*)(?:-[a-z]*)?:(.*)\)\z/s) {
	($suffix, $arg) = ($1, $2);
    }
    if ( 2 &lt; $MaxArgLen and $MaxArgLen &lt; length($arg) ) {
        substr ( $arg, $MaxArgLen - 3 ) = &quot;&quot;;
	$suffix = &quot;...&quot;.$suffix;
    }
    return &quot;qr($arg)$suffix&quot;;
}

# Takes an inheritance cache and a package and returns
# an anon hash of known inheritances and anon array of
# inheritances which consequences have not been figured
# for.
sub get_status {
    my $cache = shift;
    my $pkg   = shift;
    $cache-&gt;{$pkg} ||= [ { $pkg =&gt; $pkg }, [ trusts_directly($pkg) ] ];
    return @{ $cache-&gt;{$pkg} };
}

# Takes the info from caller() and figures out the name of
# the sub/require/eval
sub get_subname {
    my $info = shift;
    if ( defined( $info-&gt;{evaltext} ) ) {
        my $eval = $info-&gt;{evaltext};
        if ( $info-&gt;{is_require} ) {
            return &quot;require $eval&quot;;
        }
        else {
            $eval =~ s/([\\\&#039;])/\\$1/g;
            return &quot;eval &#039;&quot; . str_len_trim( $eval, $MaxEvalLen ) . &quot;&#039;&quot;;
        }
    }

    # this can happen on older perls when the sub (or the stash containing it)
    # has been deleted
    if ( !defined( $info-&gt;{sub} ) ) {
        return &#039;__ANON__::__ANON__&#039;;
    }

    return ( $info-&gt;{sub} eq &#039;(eval)&#039; ) ? &#039;eval {...}&#039; : $info-&gt;{sub};
}

# Figures out what call (from the point of view of the caller)
# the long error backtrace should start at.
sub long_error_loc {
    my $i;
    my $lvl = $CarpLevel;
    {
        ++$i;
        my $cgc = _cgc();
        my @caller = $cgc ? $cgc-&gt;($i) : caller($i);
        my $pkg = $caller[0];
        unless ( defined($pkg) ) {

            # This *shouldn&#039;t* happen.
            if (%Internal) {
                local %Internal;
                $i = long_error_loc();
                last;
            }
            elsif (defined $caller[2]) {
                # this can happen when the stash has been deleted
                # in that case, just assume that it&#039;s a reasonable place to
                # stop (the file and line data will still be intact in any
                # case) - the only issue is that we can&#039;t detect if the
                # deleted package was internal (so don&#039;t do that then)
                # -doy
                redo unless 0 &gt; --$lvl;
                last;
            }
            else {
                return 2;
            }
        }
        redo if $CarpInternal{$pkg};
        redo unless 0 &gt; --$lvl;
        redo if $Internal{$pkg};
    }
    return $i - 1;
}

sub longmess_heavy {
    if ( ref( $_[0] ) ) {   # don&#039;t break references as exceptions
        return wantarray ? @_ : $_[0];
    }
    my $i = long_error_loc();
    return ret_backtrace( $i, @_ );
}

# Returns a full stack backtrace starting from where it is
# told.
sub ret_backtrace {
    my ( $i, @error ) = @_;
    my $mess;
    my $err = join &#039;&#039;, @error;
    $i++;

    my $tid_msg = &#039;&#039;;
    if ( defined &amp;threads::tid ) {
        my $tid = threads-&gt;tid;
        $tid_msg = &quot; thread $tid&quot; if $tid;
    }

    my %i = caller_info($i);
    $mess = &quot;$err at $i{file} line $i{line}$tid_msg&quot;;
    if( defined $. ) {
        local $@ = &#039;&#039;;
        local $SIG{__DIE__};
        eval {
            CORE::die;
        };
        if($@ =~ /^Died at .*(, &lt;.*?&gt; (?:line|chunk) \d+).$/ ) {
            $mess .= $1;
        }
    }
    $mess .= &quot;\.\n&quot;;

    while ( my %i = caller_info( ++$i ) ) {
        $mess .= &quot;\t$i{sub_name} called at $i{file} line $i{line}$tid_msg\n&quot;;
    }

    return $mess;
}

sub ret_summary {
    my ( $i, @error ) = @_;
    my $err = join &#039;&#039;, @error;
    $i++;

    my $tid_msg = &#039;&#039;;
    if ( defined &amp;threads::tid ) {
        my $tid = threads-&gt;tid;
        $tid_msg = &quot; thread $tid&quot; if $tid;
    }

    my %i = caller_info($i);
    return &quot;$err at $i{file} line $i{line}$tid_msg\.\n&quot;;
}

sub short_error_loc {
    # You have to create your (hash)ref out here, rather than defaulting it
    # inside trusts *on a lexical*, as you want it to persist across calls.
    # (You can default it on $_[2], but that gets messy)
    my $cache = {};
    my $i     = 1;
    my $lvl   = $CarpLevel;
    {
        my $cgc = _cgc();
        my $called = $cgc ? $cgc-&gt;($i) : caller($i);
        $i++;
        my $caller = $cgc ? $cgc-&gt;($i) : caller($i);

        if (!defined($caller)) {
            my @caller = $cgc ? $cgc-&gt;($i) : caller($i);
            if (@caller) {
                # if there&#039;s no package but there is other caller info, then
                # the package has been deleted - treat this as a valid package
                # in this case
                redo if defined($called) &amp;&amp; $CarpInternal{$called};
                redo unless 0 &gt; --$lvl;
                last;
            }
            else {
                return 0;
            }
        }
        redo if $Internal{$caller};
        redo if $CarpInternal{$caller};
        redo if $CarpInternal{$called};
        redo if trusts( $called, $caller, $cache );
        redo if trusts( $caller, $called, $cache );
        redo unless 0 &gt; --$lvl;
    }
    return $i - 1;
}

sub shortmess_heavy {
    return longmess_heavy(@_) if $Verbose;
    return @_ if ref( $_[0] );    # don&#039;t break references as exceptions
    my $i = short_error_loc();
    if ($i) {
        ret_summary( $i, @_ );
    }
    else {
        longmess_heavy(@_);
    }
}

# If a string is too long, trims it with ...
sub str_len_trim {
    my $str = shift;
    my $max = shift || 0;
    if ( 2 &lt; $max and $max &lt; length($str) ) {
        substr( $str, $max - 3 ) = &#039;...&#039;;
    }
    return $str;
}

# Takes two packages and an optional cache.  Says whether the
# first inherits from the second.
#
# Recursive versions of this have to work to avoid certain
# possible endless loops, and when following long chains of
# inheritance are less efficient.
sub trusts {
    my $child  = shift;
    my $parent = shift;
    my $cache  = shift;
    my ( $known, $partial ) = get_status( $cache, $child );

    # Figure out consequences until we have an answer
    while ( @$partial and not exists $known-&gt;{$parent} ) {
        my $anc = shift @$partial;
        next if exists $known-&gt;{$anc};
        $known-&gt;{$anc}++;
        my ( $anc_knows, $anc_partial ) = get_status( $cache, $anc );
        my @found = keys %$anc_knows;
        @$known{@found} = ();
        push @$partial, @$anc_partial;
    }
    return exists $known-&gt;{$parent};
}

# Takes a package and gives a list of those trusted directly
sub trusts_directly {
    my $class = shift;
    no strict &#039;refs&#039;;
    my $stash = \%{&quot;$class\::&quot;};
    for my $var (qw/ CARP_NOT ISA /) {
        # Don&#039;t try using the variable until we know it exists,
        # to avoid polluting the caller&#039;s namespace.
        if ( $stash-&gt;{$var} &amp;&amp; *{$stash-&gt;{$var}}{ARRAY} &amp;&amp; @{$stash-&gt;{$var}} ) {
           return @{$stash-&gt;{$var}}
        }
    }
    return;
}

if(!defined($warnings::VERSION) ||
	do { no warnings &quot;numeric&quot;; $warnings::VERSION &lt; 1.03 }) {
    # Very old versions of warnings.pm import from Carp.  This can go
    # wrong due to the circular dependency.  If Carp is invoked before
    # warnings, then Carp starts by loading warnings, then warnings
    # tries to import from Carp, and gets nothing because Carp is in
    # the process of loading and hasn&#039;t defined its import method yet.
    # So we work around that by manually exporting to warnings here.
    no strict &quot;refs&quot;;
    *{&quot;warnings::$_&quot;} = \&amp;$_ foreach @EXPORT;
}

1;

__END__

=head1 NAME

Carp - alternative warn and die for modules

=head1 SYNOPSIS

    use Carp;

    # warn user (from perspective of caller)
    carp &quot;string trimmed to 80 chars&quot;;

    # die of errors (from perspective of caller)
    croak &quot;We&#039;re outta here!&quot;;

    # die of errors with stack backtrace
    confess &quot;not implemented&quot;;

    # cluck, longmess and shortmess not exported by default
    use Carp qw(cluck longmess shortmess);
    cluck &quot;This is how we got here!&quot;; # warn with stack backtrace
    $long_message   = longmess( &quot;message from cluck() or confess()&quot; );
    $short_message  = shortmess( &quot;message from carp() or croak()&quot; );

=head1 DESCRIPTION

The Carp routines are useful in your own modules because
they act like C&lt;die()&gt; or C&lt;warn()&gt;, but with a message which is more
likely to be useful to a user of your module.  In the case of
C&lt;cluck()&gt; and C&lt;confess()&gt;, that context is a summary of every
call in the call-stack; C&lt;longmess()&gt; returns the contents of the error
message.

For a shorter message you can use C&lt;carp()&gt; or C&lt;croak()&gt; which report the
error as being from where your module was called.  C&lt;shortmess()&gt; returns the
contents of this error message.  There is no guarantee that that is where the
error was, but it is a good educated guess.

C&lt;Carp&gt; takes care not to clobber the status variables C&lt;$!&gt; and C&lt;$^E&gt;
in the course of assembling its error messages.  This means that a
C&lt;$SIG{__DIE__}&gt; or C&lt;$SIG{__WARN__}&gt; handler can capture the error
information held in those variables, if it is required to augment the
error message, and if the code calling C&lt;Carp&gt; left useful values there.
Of course, C&lt;Carp&gt; can&#039;t guarantee the latter.

You can also alter the way the output and logic of C&lt;Carp&gt; works, by
changing some global variables in the C&lt;Carp&gt; namespace. See the
section on C&lt;GLOBAL VARIABLES&gt; below.

Here is a more complete description of how C&lt;carp&gt; and C&lt;croak&gt; work.
What they do is search the call-stack for a function call stack where
they have not been told that there shouldn&#039;t be an error.  If every
call is marked safe, they give up and give a full stack backtrace
instead.  In other words they presume that the first likely looking
potential suspect is guilty.  Their rules for telling whether
a call shouldn&#039;t generate errors work as follows:

=over 4

=item 1.

Any call from a package to itself is safe.

=item 2.

Packages claim that there won&#039;t be errors on calls to or from
packages explicitly marked as safe by inclusion in C&lt;@CARP_NOT&gt;, or
(if that array is empty) C&lt;@ISA&gt;.  The ability to override what
@ISA says is new in 5.8.

=item 3.

The trust in item 2 is transitive.  If A trusts B, and B
trusts C, then A trusts C.  So if you do not override C&lt;@ISA&gt;
with C&lt;@CARP_NOT&gt;, then this trust relationship is identical to,
&quot;inherits from&quot;.

=item 4.

Any call from an internal Perl module is safe.  (Nothing keeps
user modules from marking themselves as internal to Perl, but
this practice is discouraged.)

=item 5.

Any call to Perl&#039;s warning system (eg Carp itself) is safe.
(This rule is what keeps it from reporting the error at the
point where you call C&lt;carp&gt; or C&lt;croak&gt;.)

=item 6.

C&lt;$Carp::CarpLevel&gt; can be set to skip a fixed number of additional
call levels.  Using this is not recommended because it is very
difficult to get it to behave correctly.

=back

=head2 Forcing a Stack Trace

As a debugging aid, you can force Carp to treat a croak as a confess
and a carp as a cluck across I&lt;all&gt; modules. In other words, force a
detailed stack trace to be given.  This can be very helpful when trying
to understand why, or from where, a warning or error is being generated.

This feature is enabled by &#039;importing&#039; the non-existent symbol
&#039;verbose&#039;. You would typically enable it by saying

    perl -MCarp=verbose script.pl

or by including the string C&lt;-MCarp=verbose&gt; in the PERL5OPT
environment variable.

Alternately, you can set the global variable C&lt;$Carp::Verbose&gt; to true.
See the C&lt;GLOBAL VARIABLES&gt; section below.

=head2 Stack Trace formatting

At each stack level, the subroutine&#039;s name is displayed along with
its parameters.  For simple scalars, this is sufficient.  For complex
data types, such as objects and other references, this can simply
display C&lt;&#039;HASH(0x1ab36d8)&#039;&gt;.

Carp gives two ways to control this.

=over 4

=item 1.

For objects, a method, C&lt;CARP_TRACE&gt;, will be called, if it exists.  If
this method doesn&#039;t exist, or it recurses into C&lt;Carp&gt;, or it otherwise
throws an exception, this is skipped, and Carp moves on to the next option,
otherwise checking stops and the string returned is used.  It is recommended
that the object&#039;s type is part of the string to make debugging easier.

=item 2.

For any type of reference, C&lt;$Carp::RefArgFormatter&gt; is checked (see below).
This variable is expected to be a code reference, and the current parameter
is passed in.  If this function doesn&#039;t exist (the variable is undef), or
it recurses into C&lt;Carp&gt;, or it otherwise throws an exception, this is
skipped, and Carp moves on to the next option, otherwise checking stops
and the string returned is used.

=item 3.

Otherwise, if neither C&lt;CARP_TRACE&gt; nor C&lt;$Carp::RefArgFormatter&gt; is
available, stringify the value ignoring any overloading.

=back

=head1 GLOBAL VARIABLES

=head2 $Carp::MaxEvalLen

This variable determines how many characters of a string-eval are to
be shown in the output. Use a value of C&lt;0&gt; to show all text.

Defaults to C&lt;0&gt;.

=head2 $Carp::MaxArgLen

This variable determines how many characters of each argument to a
function to print. Use a value of C&lt;0&gt; to show the full length of the
argument.

Defaults to C&lt;64&gt;.

=head2 $Carp::MaxArgNums

This variable determines how many arguments to each function to show.
Use a false value to show all arguments to a function call.  To suppress all
arguments, use C&lt;-1&gt; or C&lt;&#039;0 but true&#039;&gt;.

Defaults to C&lt;8&gt;.

=head2 $Carp::Verbose

This variable makes C&lt;carp()&gt; and C&lt;croak()&gt; generate stack backtraces
just like C&lt;cluck()&gt; and C&lt;confess()&gt;.  This is how C&lt;use Carp &#039;verbose&#039;&gt;
is implemented internally.

Defaults to C&lt;0&gt;.

=head2 $Carp::RefArgFormatter

This variable sets a general argument formatter to display references.
Plain scalars and objects that implement C&lt;CARP_TRACE&gt; will not go through
this formatter.  Calling C&lt;Carp&gt; from within this function is not supported.

local $Carp::RefArgFormatter = sub {
    require Data::Dumper;
    Data::Dumper::Dump($_[0]); # not necessarily safe
};

=head2 @CARP_NOT

This variable, I&lt;in your package&gt;, says which packages are I&lt;not&gt; to be
considered as the location of an error. The C&lt;carp()&gt; and C&lt;cluck()&gt;
functions will skip over callers when reporting where an error occurred.

NB: This variable must be in the package&#039;s symbol table, thus:

    # These work
    our @CARP_NOT; # file scope
    use vars qw(@CARP_NOT); # package scope
    @My::Package::CARP_NOT = ... ; # explicit package variable

    # These don&#039;t work
    sub xyz { ... @CARP_NOT = ... } # w/o declarations above
    my @CARP_NOT; # even at top-level

Example of use:

    package My::Carping::Package;
    use Carp;
    our @CARP_NOT;
    sub bar     { .... or _error(&#039;Wrong input&#039;) }
    sub _error  {
        # temporary control of where&#039;ness, __PACKAGE__ is implicit
        local @CARP_NOT = qw(My::Friendly::Caller);
        carp(@_)
    }

This would make C&lt;Carp&gt; report the error as coming from a caller not
in C&lt;My::Carping::Package&gt;, nor from C&lt;My::Friendly::Caller&gt;.

Also read the L&lt;/DESCRIPTION&gt; section above, about how C&lt;Carp&gt; decides
where the error is reported from.

Use C&lt;@CARP_NOT&gt;, instead of C&lt;$Carp::CarpLevel&gt;.

Overrides C&lt;Carp&gt;&#039;s use of C&lt;@ISA&gt;.

=head2 %Carp::Internal

This says what packages are internal to Perl.  C&lt;Carp&gt; will never
report an error as being from a line in a package that is internal to
Perl.  For example:

    $Carp::Internal{ (__PACKAGE__) }++;
    # time passes...
    sub foo { ... or confess(&quot;whatever&quot;) };

would give a full stack backtrace starting from the first caller
outside of __PACKAGE__.  (Unless that package was also internal to
Perl.)

=head2 %Carp::CarpInternal

This says which packages are internal to Perl&#039;s warning system.  For
generating a full stack backtrace this is the same as being internal
to Perl, the stack backtrace will not start inside packages that are
listed in C&lt;%Carp::CarpInternal&gt;.  But it is slightly different for
the summary message generated by C&lt;carp&gt; or C&lt;croak&gt;.  There errors
will not be reported on any lines that are calling packages in
C&lt;%Carp::CarpInternal&gt;.

For example C&lt;Carp&gt; itself is listed in C&lt;%Carp::CarpInternal&gt;.
Therefore the full stack backtrace from C&lt;confess&gt; will not start
inside of C&lt;Carp&gt;, and the short message from calling C&lt;croak&gt; is
not placed on the line where C&lt;croak&gt; was called.

=head2 $Carp::CarpLevel

This variable determines how many additional call frames are to be
skipped that would not otherwise be when reporting where an error
occurred on a call to one of C&lt;Carp&gt;&#039;s functions.  It is fairly easy
to count these call frames on calls that generate a full stack
backtrace.  However it is much harder to do this accounting for calls
that generate a short message.  Usually people skip too many call
frames.  If they are lucky they skip enough that C&lt;Carp&gt; goes all of
the way through the call stack, realizes that something is wrong, and
then generates a full stack backtrace.  If they are unlucky then the
error is reported from somewhere misleading very high in the call
stack.

Therefore it is best to avoid C&lt;$Carp::CarpLevel&gt;.  Instead use
C&lt;@CARP_NOT&gt;, C&lt;%Carp::Internal&gt; and C&lt;%Carp::CarpInternal&gt;.

Defaults to C&lt;0&gt;.

=head1 BUGS

The Carp routines don&#039;t handle exception objects currently.
If called with a first argument that is a reference, they simply
call die() or warn(), as appropriate.

=head1 SEE ALSO

L&lt;Carp::Always&gt;,
L&lt;Carp::Clan&gt;

=head1 CONTRIBUTING

L&lt;Carp&gt; is maintained by the perl 5 porters as part of the core perl 5
version control repository. Please see the L&lt;perlhack&gt; perldoc for how to
submit patches and contribute to it.

=head1 AUTHOR

The Carp module first appeared in Larry Wall&#039;s perl 5.000 distribution.
Since then it has been modified by several of the perl 5 porters.
Andrew Main (Zefram) &lt;zefram@fysh.org&gt; divested Carp into an independent
distribution.

=head1 COPYRIGHT

Copyright (C) 1994-2013 Larry Wall

Copyright (C) 2011, 2012, 2013 Andrew Main (Zefram) &lt;zefram@fysh.org&gt;

=head1 LICENSE

This module is free software; you can redistribute it and/or modify it
under the same terms as Perl itself.
</textarea><br><br><input type='hidden' name='archivo_editar' value='/usr/share/perl5/vendor_perl/Carp.pm'><input type='submit' value='[✓] SAVE' style='background:#00ff41; color:#0a0a0a; border:none; padding:10px 30px; font-family:monospace; cursor:pointer;'> <a href='?path=%2Fusr%2Fshare%2Fperl5%2Fvendor_perl' style='color:#858585; text-decoration:none; padding:10px 30px; border:1px solid #858585;'>[✗] CANCEL</a></form></div><div style='color:#00ff41; font-family:monospace; text-align:center; padding:20px;'>[~] Kerym Chaeceran</div>