| 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; |
| } |
