perl warnings
[mkws-moved-to-github.git] / 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 use POSIX ":sys_wait_h";
9 use BSD::Resource qw/setrlimit/;
10
11 use strict;
12 use warnings;
13
14 my $debug = 0;
15 my $help;
16 my $timeout = 100;
17 my $pid;
18
19 binmode \*STDOUT, ":utf8";
20 binmode \*STDERR, ":utf8";
21
22 sub usage () {
23     <<EOF;
24 usage: $0 [ options ] command args ....
25
26 --debug=0..3    debug option, default: $debug
27 --timeout=1..N  timeout in seconds, default: $timeout
28 EOF
29 }
30
31 GetOptions(
32     "help"      => \$help,
33     "debug=i"   => \$debug,
34     "timeout=f" => \$timeout,
35 ) or die usage;
36
37 my @system = @ARGV;
38
39 die usage if $help;
40 die usage if !@system;
41
42 # set CPU limit, in case the alarm handler will
43 # be ignored
44 setrlimit("RLIMIT_CPU", $timeout, 2*$timeout) or die "Cannot set CPU limit: $!\n";
45
46 #
47 # use fork/exec instead system()
48 #
49 $pid = fork();
50 die "fork() failed: $!" unless defined $pid;
51
52 # child
53 if ($pid) {
54     alarm($timeout);
55     exec(@system) or die "exec @system: $!\n";
56 }
57
58 # parent
59 else { }
60
61 1;