/tags/rel-1-3-26/SWIG/Tools/WAD/Wad/wadhandler.pl
Perl | 36 lines | 35 code | 1 blank | 0 comment | 5 complexity | 8984e0adc8981ff71c325b4bbbe66567 MD5 | raw file
Possible License(s): LGPL-2.1, Cube, GPL-3.0, 0BSD, GPL-2.0
- 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;
- }