Commit | Line | Data |
a0d0e21e |
1 | package sigtrap; |
2 | |
3 | require Carp; |
4 | |
5 | sub import { |
6 | my $pack = shift; |
7 | my @sigs = @_; |
8 | @sigs or @sigs = qw(QUIT ILL TRAP ABRT EMT FPE BUS SEGV SYS PIPE TERM); |
9 | foreach $sig (@sigs) { |
10 | $SIG{$sig} = 'sigtrap::trap'; |
11 | } |
12 | } |
13 | |
14 | sub trap { |
15 | package DB; # To get subroutine args. |
16 | $SIG{'ABRT'} = DEFAULT; |
17 | kill 'ABRT', $$ if $panic++; |
18 | syswrite(STDERR, 'Caught a SIG', 12); |
19 | syswrite(STDERR, $_[0], length($_[0])); |
20 | syswrite(STDERR, ' at ', 4); |
21 | ($pack,$file,$line) = caller; |
22 | syswrite(STDERR, $file, length($file)); |
23 | syswrite(STDERR, ' line ', 6); |
24 | syswrite(STDERR, $line, length($line)); |
25 | syswrite(STDERR, "\n", 1); |
26 | |
27 | # Now go for broke. |
28 | for ($i = 1; ($p,$f,$l,$s,$h,$w) = caller($i); $i++) { |
29 | @a = (); |
30 | for $arg (@args) { |
31 | $_ = "$arg"; |
32 | s/'/\\'/g; |
33 | s/([^\0]*)/'$1'/ |
34 | unless /^(?: -?[\d.]+ | \*[\w:]* )$/x; |
35 | s/([\200-\377])/sprintf("M-%c",ord($1)&0177)/eg; |
36 | s/([\0-\37\177])/sprintf("^%c",ord($1)^64)/eg; |
37 | push(@a, $_); |
38 | } |
39 | $w = $w ? '@ = ' : '$ = '; |
40 | $a = $h ? '(' . join(', ', @a) . ')' : ''; |
41 | $mess = "$w$s$a called from $f line $l\n"; |
42 | syswrite(STDERR, $mess, length($mess)); |
43 | } |
44 | kill 'ABRT', $$; |
45 | } |
46 | |
47 | 1; |