#!/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 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");
    sub suspend_trap { logger(INFO, "SIGTSTP / CTRL-Z received. Suspending...");
                       # $SIG{TSTP} = 'IGNORE';
                       $SIG{TSTP} = 'DEFAULT';
                       kill 'TSTP', -(getpgrp $$);
                       # $SIG{TSTP} = \&suspend_trap; # Paranoid - for unreliable signals - see Perl cookbook ch16.17.3
    }
    
    # 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; };
    my @childs = ();
    $SIG{HUP}      = sub { logger(INFO, "SIGHUP received. Forking.");
                           my $pid = fork();
                           if ($pid){
                               logger(INFO, "Child PID $pid has been forked.");
                               push @childs, $pid;
                           }
    };
    $SIG{INT}      = sub { logger(INFO, "SIGINT / CTRL-C received (Interrupt from keyboard). Leaving..."); $stop_flag++; };
    $SIG{QUIT}     = sub { logger(INFO, "SIGQUIT / CTRL-\\ received (Quit from keyboard). Leaving..."); $stop_flag++; };
    $SIG{ABRT}     = sub { logger(INFO, "SIGABRT received (Probable abnormal process termination requested by a library). Leaving..."); $stop_flag++; };
    $SIG{TERM}     = sub { logger(INFO, "SIGTERM - External termination request. Leaving..."); $stop_flag++; };
    $SIG{TSTP}     = \&suspend_trap;
    $SIG{CONT}     = sub { $SIG{TSTP} = \&suspend_trap;
                           logger(INFO, "SIGCONT received - continue after suspension.");
                           kill 'CONT', @childs;
    };

    # 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, "Program PID $$ has started");
logger(INFO, sprintf("We %s connected to a TTY", -t () ? 'ARE' : 'ARE NOT'));
while (!$stop_flag){
    say "[$$] In loop; sleeping...";
    sleep 3;
};
logger(INFO, "Reached normal end. Ciao.");

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