#!/usr/bin/perl

# test_signal.pl - Testing signals handlers
# to test without TTY, you can use 'nohup perl test_signal.pl'
# to test the suspend/continue either
#    in foreground: C-z then 'bg' or 'fg'
#    in background: kill -tstp <pid> / kill -cont <pid>

use strict;
use warnings;
use feature 'say';
use POSIX qw(:signal_h :errno_h :sys_wait_h); 

use constant {
    FATAL => 0,
    ERROR => 1,
    INFO  => 2,
    DEBUG => 3,
    TRACE => 4
};

$|++;

my $stop_flag = 0;
BEGIN {
    my $LOG_LVL = TRACE;
    logger(INFO, "Setting up signal handlers");
    my $childs = {};
    sub suspend_trap { logger(INFO, "SIGTSTP / CTRL-Z (Terminal Stop) received. Suspending...");
                       # there is also SIGSTOP that is untrappable STOP
                       # $SIG{TSTP} = 'IGNORE';
                       $SIG{TSTP} = 'DEFAULT';
                       kill 'TSTP', -(getpgrp $$);  # propagate the signal to the whole pgroup
                       # $SIG{TSTP} = \&suspend_trap; # DISABLED due to endless notifications - Paranoid - for unreliable signals - see Perl cookbook ch16.17.3
    }

    sub child_reaper { logger(INFO, "SIGCHLD received.");
                       my $pid;
                       while (($pid = waitpid(-1, &WNOHANG)) > 0){
                           # note
                           # $exit_value = $? >> 8;   -> WEXITSTATUS
                           # $signal_num = $? & 127;  -> WTERMSIG
                           # $dumped_core = $? & 128;
                           if(WIFEXITED($?)){
                               logger(INFO, sprintf("Child %d exited normally with value %d", $pid, WEXITSTATUS($?)));
                               delete $childs->{$pid};
                           } elsif (WIFSIGNALED($?)){
                               logger(INFO, sprintf("Child %d was killed by a signal %d", $pid, WTERMSIG($?)));
                               delete $childs->{$pid};
                           } else {
                               logger(INFO, "False alarm for child $pid"); # "false alarm" WTF?!! - Perl cookbook ch16.20
                           }
                           logger(INFO, "Child $pid dumped core") if $? & 128;
                       }
                       $SIG{CHLD} = \&child_reaper; # Paranoid - for unreliable signals - see Perl cookbook ch16.20
    }
    
    # A handler can be
    # code ref (sub)
    # name of sub
    # 'IGNORE'
    # 'DEFAULT'
    $SIG{__WARN__} = sub { my $m = shift; chomp $m; logger(ERROR, $m); };
    $SIG{__DIE__}  = sub { my $m = shift; chomp $m; logger(FATAL, $m . " Leaving..."); exit; };
    $SIG{HUP}      = sub { logger(INFO, "SIGHUP received. Forking.");
                           my $pid = fork();
                           if ($pid){
                               logger(INFO, "Child PID $pid has been forked.");
                               $childs->{$pid}++;;
                           }
    };
    $SIG{INT}      = sub { logger(INFO, "SIGINT / CTRL-C received (Interrupt from keyboard). Leaving..."); $stop_flag++; kill 'INT', keys %$childs; };
    $SIG{QUIT}     = sub { logger(INFO, "SIGQUIT / CTRL-\\ received (Quit from keyboard). Leaving..."); $stop_flag++; kill 'QUIT', keys %$childs; };
    $SIG{ABRT}     = sub { logger(INFO, "SIGABRT received (Probable abnormal process termination requested by a library). Leaving..."); $stop_flag++; kill 'ABRT', keys %$childs; };
    $SIG{TERM}     = sub { logger(INFO, "SIGTERM - External termination request. Leaving..."); $stop_flag++; kill 'TERM', keys %$childs;};
    $SIG{TSTP}     = \&suspend_trap;
    $SIG{CONT}     = sub { $SIG{TSTP} = \&suspend_trap;
                           logger(INFO, "SIGCONT received - continue after suspension.");
                           kill 'CONT', keys %$childs; # we could also send to the whole pgroup like for TSTP
    };
    $SIG{CHLD}     = \&child_reaper;

    # Log some text, depending on the current log level
    sub logger {
        my ($lvl, $msg) = @_;
        say __stamp($msg) if ($LOG_LVL >= $lvl);
    }
    
    # This sub Copyright (c) 1996,97,98,99,2000,01 by Randal L. Schwartz
    sub __stamp {
        my ($message) = @_;
        my $stamp = sprintf "[%d] %s [%02d@%02d:%02d:%02d] ", $$, ${^GLOBAL_PHASE}, (localtime)[3,2,1,0];
        $message =~ s/^/$stamp/gm;
        $message;
    }
    logger(INFO, "End of BEGIN (...or beginning of end? ;o)");
}

logger(INFO, "Program PID $$ has started");
logger(INFO, sprintf("We %s connected to a TTY", -t () ? 'ARE' : 'ARE NOT'));
while (!$stop_flag){
    logger(INFO, "In loop; sleeping...");
    sleep 3;
};
logger(INFO, "Reached normal end. Ciao.");

END { logger(INFO, "That's all folks!") };