unless(defined($pkg)) {
# This *shouldn't* happen.
if (%Internal) {
local %Internal;
$i = long_error_loc();
last;
}
else {
# OK, now I am irritated.
return 2;
}
}
redo if $CarpInternal{$pkg};
redo unless 0 > --$lvl;
redo if $Internal{$pkg};
}
return $i - 1;
}
sub longmess_heavy {
return @_ if ref($_[0]); # don't break references as exceptions
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 '', @error;
$i++;
my $tid_msg = '';
if (defined &Thread::tid) {
my $tid = Thread->self->tid;
$tid_msg = " thread $tid" if $tid;
}
my %i = caller_info($i);
$mess = "$err at $i{file} line $i{line}$tid_msg\n";
while (my %i = caller_info(++$i)) {
$mess .= "\t$i{sub_name} called at $i{file} line $i{line}$tid_msg\n";
}
return $mess;
}
sub ret_summary {
my ($i, @error) = @_;
my $err = join '', @error;
$i++;
my $tid_msg = '';
if (defined &Thread::tid) {
my $tid = Thread->self->tid;
$tid_msg = " thread $tid" if $tid;
}
my %i = caller_info($i);
return "$err at $i{file} line $i{line}$tid_msg\n";
}
sub short_error_loc {
my $cache;
my $i = 1;
my $lvl = $CarpLevel;
{
my $called = caller($i++);
my $caller = caller($i);
return 0 unless defined($caller); # What happened?
redo if $Internal{$caller};
redo if $CarpInternal{$called};
redo if trusts($called, $caller, $cache);
redo if trusts($caller, $called, $cache);
redo unless 0 > --$lvl;
}
return $i - 1;
}
sub shortmess_heavy {
return longmess_heavy(@_) if $Verbose;
return @_ if ref($_[0]); # don'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 < $max and $max < length($str)) {
=2= |