test/bin/bomb.pl

   1 #!/usr/bin/perl
   2 # Copyright (c) 2014 IndexData ApS. http://indexdata.com
   3 #
   4 # bomb.pl - wrapper to stop a process after N seconds
   5 #
   6
   7 use Getopt::Long;
   8
   9 use strict;
  10 use warnings;
  11
  12 my $debug = 0;
  13 my $help;
  14 my $timeout = 100;
  15
  16 binmode \*STDOUT, ":utf8";
  17 binmode \*STDERR, ":utf8";
  18
  19 # timeout handler
  20 sub set_alarm {
  21     my $time = shift;
  22     my $message = shift || "";
  23
  24     $time = 100 if !defined $time;
  25
  26     $SIG{ALRM} = sub {
  27
  28         warn "Time out alarm $time\n";
  29
  30         # sends a hang-up signal to all processes in the current process group
  31         local $SIG{HUP} = "IGNORE";
  32         kill 1, -$$;
  33         sleep 0.2;
  34
  35         local $SIG{TERM} = "IGNORE";
  36         kill 15, -$$;
  37         sleep 0.2;
  38         kill 15, -$$;
  39
  40         warn "Send a hang-up to all childs.\n";
  41     };
  42
  43     warn "set alarm time to: $time seconds $message\n" if $debug >= 1;
  44     alarm($time);
  45 }
  46
  47 sub usage () {
  48     <<EOF;
  49 usage: $0 [ options ] command args ....
  50
  51 --debug=0..3    debug option, default: $debug
  52 --timeout=1..N  timeout in seconds, default: $timeout
  53 EOF
  54 }
  55
  56 GetOptions(
  57     "help"      => \$help,
  58     "debug=i"   => \$debug,
  59     "timeout=f" => \$timeout,
  60 ) or die usage;
  61
  62 my @system = @ARGV;
  63
  64 die usage if $help;
  65 die usage if !@system;
  66
  67 set_alarm( $timeout, join( " ", @system ) );
  68
  69 system(@system) == 0
  70   or die "@system failed with exit code: $?\n";
  71
  72 exit(0);