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

p4 – perforce common commands for batch operations

p4 help
get online help
p4 dirs //Drivers/*
list direct directories under given path (//Drivers)
p4 files //Drivers/…
list files (recursively) under given path (//Drivers)
p4 labels -m 5 //Drivers/…
list latest 5 labels of a path
p4 changes -m 1 //Drivers/…
list  the latest change list
p4 user jason
list user jason’s information
p4 client
show current client
p4 opened
list opened files (that are in the pending change lists)
p4 sync
get files to the workspace

p4 sync file#rev
p4 sync @label
p4 sync //depot/proj/...@rev
p4 sync @2011/06/24
p4 sync file#none           # delete from workspace
p4 unshelve -s changelist [ file_pattern … ]
unshelve a file/change list

perforce file name format

file#n              the n-th revision of file
file#m,n            revision range m,n
file#none           nonexistent revision (delete from workspace)
file#0
file#head           head (latest) revision
file#have           the revision on the current client
file@=n             change number
file@n
file@label          file in label
file@clientname     revision of file last taken into client workspace
file@datespec       datespec    yyyy/mm/dd([ :]hh:mm:ss)?
file@now