Capture signals in perl

Here’s a sample perl script

#! /usr/bin/perl
=pod

This program demonstrate the usage of %SIG to capture signals in perl.

An alternative solution is using pragma sigtrap.
    use sigtrap qw(handler hdl_int INT QUIT);
The disadvantage of sigtrap is that you can't save and restore
the original handlers.

=cut

use strict;
use warnings;
use Time::HiRes qw( usleep) ;

package ST;             # scope tracer
sub new {
    my $class = shift;
    my $name = shift;
    my $self = {
        name => $name,
    };
    print "++++++++++++++++enter $self->{name}\n";
    bless $self, $class;
    return $self;
}
sub DESTROY {
    my $self = shift;
    print "----------------leave $self->{name}\n";
}



package main;

my %orgSig = ();        # save original handlers if restoring is wished

sub listAllSignals {
    print "supported signals\n";
    foreach (sort keys %SIG) {
        unless (/NUM\d+/) {
            my $v = $SIG{$_} || '';
            print "  $_=$v\n";
        }
    }
}

sub longtask {
    # emulating a task that runs for a while.
    my $title = shift || 'some long-time task';
    my $loop = shift || 5;
    my $interval = shift || 1;
    my $v = new ST($title);
    foreach (1..$loop) {
        print "      $title: working ...$_\n";
        usleep($interval * 1000000);
    }
}

sub foo {
    my $s = ST->new('foo');
    my $greet = shift;

    print "$greet from foo\n";
    longtask('foo body', 10, 0.5);
}

sub hdl_int {
# signal is blocked and appended in the queue
# DURING the signal handler is running,
# so restoring original handler inside the handler
# IS GENERARLLY NOT a good idea unless that is expected behavior
    my $s = ST->new('hdl_int');
    longtask('hdl_int body', 5, 0.2);
#   $SIG{'INT'} = $orgSig{'INT'};
}

$orgSig{$_} = $SIG{$_} foreach (keys %SIG);
listAllSignals();

# these two signals are used for "normal" exit
$SIG{'INT'} = \&hdl_int;
$SIG{TERM} = sub { print "I captured TERM\n"; };

# There two can't be captured
#   For sure KILL (9) can't be captured
#   According to doc, QUIT is not able to be captured either,
#   however the interesting fact is that it's captured on debian 8
$SIG{QUIT} = sub { print "I captured QUIT\n"; };
$SIG{KILL} = sub { print "I captured KILL\n"; };


print("hello world, my pid=$$\n");
sleep(3);
foo("Greeting");
print("The end\n");

Here is the output when Control-C is pressed twice during the running

jasonz@jzdebian$ perl sig.pl
supported signals
  ABRT=
  ALRM=
  BUS=
  CHLD=
  CLD=
  CONT=
  FPE=IGNORE
  HUP=
  ILL=
  INT=
  IO=
  IOT=
  KILL=
  PIPE=
  POLL=
  PROF=
  PWR=
  QUIT=
  RTMAX=
  RTMIN=
  SEGV=
  STKFLT=
  STOP=
  SYS=
  TERM=
  TRAP=
  TSTP=
  TTIN=
  TTOU=
  UNUSED=
  URG=
  USR1=
  USR2=
  VTALRM=
  WINCH=
  XCPU=
  XFSZ=
hello world, my pid=47074
^C++++++++++++++++enter hdl_int
++++++++++++++++enter hdl_int body
      hdl_int body: working ...1
      hdl_int body: working ...2
      hdl_int body: working ...3
^C      hdl_int body: working ...4
      hdl_int body: working ...5
----------------leave hdl_int body
----------------leave hdl_int
++++++++++++++++enter hdl_int
++++++++++++++++enter hdl_int body
      hdl_int body: working ...1
      hdl_int body: working ...2
      hdl_int body: working ...3
      hdl_int body: working ...4
      hdl_int body: working ...5
----------------leave hdl_int body
----------------leave hdl_int
++++++++++++++++enter foo
Greeting from foo
++++++++++++++++enter foo body
      foo body: working ...1
      foo body: working ...2
      foo body: working ...3
      foo body: working ...4
      foo body: working ...5
      foo body: working ...6
      foo body: working ...7
      foo body: working ...8
      foo body: working ...9
      foo body: working ...10
----------------leave foo body
----------------leave foo
The end
jasonz@jzdebian$ 

The interesting fact is that QUIT is captured although the linux document declares that it is not capture-able. Here is the snippet of the output

  XCPU=
  XFSZ=
hello world, my pid=47344
++++++++++++++++enter foo
Greeting from foo
++++++++++++++++enter foo body
      foo body: working ...1
      foo body: working ...2
      foo body: working ...3
I captured QUIT
      foo body: working ...4
      foo body: working ...5
      foo body: working ...6
      foo body: working ...7
      foo body: working ...8
      foo body: working ...9
      foo body: working ...10
----------------leave foo body
----------------leave foo
The end
jasonz@jzdebian$ 

when a QUIT signal is sent

jasonz@jzdebian$ kill -QUIT 47344
jasonz@jzdebian$ 

Extended Usage – capture warn() and dir()

This is extremely convenient to log all those information

sub WARN_handler {
    my ($signal) = @_;
    log("WARN: $signal");
}
sub DIE_handler {
    my ($signal) = @_;
    log("DIE: $signal");
}
sub log {
    my (@array) = @_;
    open(LOGFILE, ">>my.log");
    print LOGFILE (@array);
    close(LOGFILE);
}

$SIG{__WARN__} = 'WARN_handler';
$SIG{__DIE__} = 'DIE_handler';
chdir('/printer') or warn($!);
chdir('/printer') or die($!);
Advertisements