view release on metacpan or  search on metacpan

lib/Devel/Trepan/SigHandler.pm  view on Meta::CPAN

sub canonic_signame($)
{
    my $name_num = shift;
    my $signum = lookup_signum($name_num);
    my $signame;
    unless (defined $signum) {
        # Maybe signame is a number?
        if ($name_num =~ /^[+-]?[0-9]+$/) {
            $signame = lookup_signame($name_num);
            return undef unless defined($signame);
        } else {
            return undef;
        }
        return $signame
    }

    $signame = uc $name_num;
    return substr($signame, 3) if 0 == index($signame, 'SIG');
    return $signame;
}

my %FATAL_SIGNALS = ('KILL' => 1, 'STOP' => 1);

# I copied these from GDB source code.
my %SIGNAL_DESCRIPTION = (
  "HUP"    => "Hangup",
  "INT"    => "Interrupt",
  "QUIT"   => "Quit",
  "ILL"    => "Illegal instruction",
  "TRAP"   => "Trace/breakpoint trap",
  "ABRT"   => "Aborted",
  "EMT"    => "Emulation trap",
  "FPE"    => "Arithmetic exception",
  "KILL"   => "Killed",
  "BUS"    => "Bus error",
  "SEGV"   => "Segmentation fault",
  "SYS"    => "Bad system call",
  "PIPE"   => "Broken pipe",
  "ALRM"   => "Alarm clock",
  "TERM"   => "Terminated",
  "URG"    => "Urgent I/O condition",
  "STOP"   => "Stopped (signal)",
  "TSTP"   => "Stopped (user)",
  "CONT"   => "Continued",
  "CHLD"   => "Child status changed",
  "TTIN"   => "Stopped (tty input)",
  "TTOU"   => "Stopped (tty output)",
  "IO"     => "I/O possible",
  "XCPU"   => "CPU time limit exceeded",
  "XFSZ"   => "File size limit exceeded",
  "VTALRM" => "Virtual timer expired",
  "PROF"   => "Profiling timer expired",
  "WINCH"  => "Window size changed",
  "LOST"   => "Resource lost",
  "USR1"   => "User-defined signal 1",
  "USR2"   => "User-defined signal 2",
  "PWR"    => "Power fail/restart",
  "POLL"   => "Pollable event occurred",
  "WIND"   => "WIND",
  "PHONE"  => "PHONE",
  "WAITING"=> "Process's LWPs are blocked",
  "LWP"    => "Signal LWP",
  "DANGER" => "Swap space dangerously low",
  "GRANT"  => "Monitor mode granted",
  "RETRACT"=> "Need to relinquish monitor mode",
  "MSG"    => "Monitor mode data available",
  "SOUND"  => "Sound completed",
  "SAK"    => "Secure attention"
);


# Signal Handling information Object for the debugger
#     - Do we print/not print when signal is caught
#     - Do we pass/not pass the signal to the program
#     - Do we stop/not stop when signal is caught
#
#     Parameter dbgr is a Debugger object. ignore is a list of
#     signals to ignore. If you want no signals, use [] as None uses the
#     default set. Parameter default_print specifies whether or not we
#     print receiving a signals that is not ignored.
#
#     All the methods which change these attributes return None on error, or
#     True/False if we have set the action (pass/print/stop) for a signal
#     handler.
sub new($$$$$$)
{
    my ($class, $handler, $print_fn, $errprint_fn, $secprint_fn,
        $ignore_list) = @_;
    # Ignore signal handling initially for these known signals.
    unless (defined($ignore_list)) {
        $ignore_list = {
            'ALRM'    => 1,
            'CHLD'    => 1,
            'URG'     => 1,
            'IO'      => 1,
            'CLD'     => 1,
            'VTALRM'  => 1,
            'PROF'    => 1,
            'WINCH'   => 1,
            'POLL'    => 1,
            'WAITING' => 1,
            'LWP'     => 1,
            'CANCEL'  => 1,
            'TRAP'    => 1,
            'TERM'    => 1,
            'TSTP'    => 1,
            'QUIT'    => 1,
            'ILL'     => 1
        };
    };

    my $self = {
        handler     => $handler,
        print_fn    => $print_fn,
        errprint_fn => $errprint_fn || $print_fn,
        secprint_fn => $secprint_fn || $print_fn,
        sigs        => {},
        ignore_list => $ignore_list,
        orig_set_signal  => \%SIG,
        info_fmt => "%-14s%-4s\t%-4s\t%-5s\t%-4s\t%s",
    };