PageRenderTime 38ms CodeModel.GetById 14ms RepoModel.GetById 0ms app.codeStats 0ms

/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
  1. package libwadpl;
  2. sub wad_handler_traceback {
  3. package DB;
  4. my $es = "";
  5. ($pack,$file,$line) = caller(1);
  6. for ($i = 2; ($p,$f,$l,$s,$h,$w,$e,$r) = caller($i); $i++) {
  7. @a = ();
  8. for $arg (@args) {
  9. $_ = "$arg";
  10. s/([\'\\])/\\$1/g;
  11. s/([^\0]*)/'$1'/
  12. unless /^(?: -?[\d.]+ | \*[\w:]* )$/x;
  13. s/([\200-\377])/sprintf("M-%c",ord($1)&0177)/eg;
  14. s/([\0-\37\177])/sprintf("^%c",ord($1)^64)/eg;
  15. push(@a, $_);
  16. }
  17. $w = $w ? '@ = ' : '$ = ';
  18. $a = $h ? '(' . join(', ', @a) . ')' : '';
  19. $e =~ s/\n\s*\;\s*\Z// if $e;
  20. $e =~ s/[\\\']/\\$1/g if $e;
  21. if ($r) {
  22. $s = "require '$e'";
  23. } elsif (defined $r) {
  24. $s = "eval '$e'";
  25. } elsif ($s eq '(eval)') {
  26. $s = "eval {...}";
  27. }
  28. $f = "file `$f'" unless $f eq '-e';
  29. $mess = "$w$s$a called from $f line $l\n";
  30. $es = $mess . $es;
  31. }
  32. $es = "Signal at $file line $line\n" . $es;
  33. return $es;
  34. }