f675cd2e3d
git-svn-id: https://swig.svn.sourceforge.net/svnroot/swig/trunk/SWIG@953 626c5289-ae23-0410-ae9c-e8d60b6d4f22
36 lines
1 KiB
Perl
36 lines
1 KiB
Perl
package libwadpl;
|
|
sub wad_handler_traceback {
|
|
package DB;
|
|
my $es = "";
|
|
($pack,$file,$line) = caller(1);
|
|
|
|
for ($i = 2; ($p,$f,$l,$s,$h,$w,$e,$r) = caller($i); $i++) {
|
|
@a = ();
|
|
for $arg (@args) {
|
|
$_ = "$arg";
|
|
s/([\'\\])/\\$1/g;
|
|
s/([^\0]*)/'$1'/
|
|
unless /^(?: -?[\d.]+ | \*[\w:]* )$/x;
|
|
s/([\200-\377])/sprintf("M-%c",ord($1)&0177)/eg;
|
|
s/([\0-\37\177])/sprintf("^%c",ord($1)^64)/eg;
|
|
push(@a, $_);
|
|
}
|
|
$w = $w ? '@ = ' : '$ = ';
|
|
$a = $h ? '(' . join(', ', @a) . ')' : '';
|
|
$e =~ s/\n\s*\;\s*\Z// if $e;
|
|
$e =~ s/[\\\']/\\$1/g if $e;
|
|
if ($r) {
|
|
$s = "require '$e'";
|
|
} elsif (defined $r) {
|
|
$s = "eval '$e'";
|
|
} elsif ($s eq '(eval)') {
|
|
$s = "eval {...}";
|
|
}
|
|
$f = "file `$f'" unless $f eq '-e';
|
|
$mess = "$w$s$a called from $f line $l\n";
|
|
$es = $mess . $es;
|
|
|
|
}
|
|
$es = "Signal at $file line $line\n" . $es;
|
|
return $es;
|
|
}
|