1N/A# Carp::Heavy uses some variables in common with Carp. 1N/ACarp::Heavy - heavy machinery, no user serviceable parts inside 1N/A# use strict; # not yet 1N/A# On one line so MakeMaker will see it. 1N/A my $i =
shift(@_) +
1;
1N/A $
#args = $MaxArgNums; 1N/A # Push the args onto the subroutine 1N/A# Transform an argument to a function into a string. 1N/A $
arg =
"'$arg'" unless $
arg =~ /^-?[\d.]+\z/;
1N/A # The following handling of "control chars" is direct from 1N/A # the original code - I think it is broken on Unicode though. 1N/A# Takes an inheritance cache and a package and returns 1N/A# an anon hash of known inheritances and anon array of 1N/A# inheritances which consequences have not been figured 1N/A# Takes the info from caller() and figures out the name of 1N/A return "require $eval";
1N/A return ($
info->{
sub}
eq '(eval)') ?
'eval {...}' : $
info->{
sub};
1N/A# Figures out what call (from the point of view of the caller) 1N/A# the long error backtrace should start at. 1N/A # This *shouldn't* happen. 1N/A # OK, now I am irritated. 1N/A return @_
if ref($_[
0]);
# don't break references as exceptions 1N/A# Returns a full stack backtrace starting from where it is 1N/A {
if ($
err =~ /\n$/) {
# extra block to localise $1 etc 1N/A $
mess =
"$err at $i{file} line $i{line}$tid_msg\n";
1N/A $
mess .=
"\t$i{sub_name} called at $i{file} line $i{line}$tid_msg\n";
1N/A return "$err at $i{file} line $i{line}$tid_msg\n";
1N/A return 0 unless defined($
caller);
# What happened? 1N/A return @_
if ref($_[
0]);
# don't break references as exceptions 1N/A# If a string is too long, trims it with ... 1N/A# Takes two packages and an optional cache. Says whether the 1N/A# first inherits from the second. 1N/A# Recursive versions of this have to work to avoid certain 1N/A# possible endless loops, and when following long chains of 1N/A# inheritance are less efficient. 1N/A # Figure out consequences until we have an answer 1N/A# Takes a package and gives a list of those trusted directly 1N/A return @{
"$class\::CARP_NOT"}
1N/A ? @{
"$class\::CARP_NOT"}
1N/A : @{
"$class\::ISA"};