File Coverage

blib/lib/Time/Limit.pm
Criterion Covered Total %
statement 17 43 39.5
branch 0 18 0.0
condition 0 5 0.0
subroutine 6 7 85.7
pod n/a
total 23 73 31.5


line stmt bran cond sub pod time code
1             package Time::Limit;
2              
3 1     1   133532 use 5.006;
  1         4  
  1         36  
4 1     1   5 use strict;
  1         1  
  1         36  
5 1     1   5 use warnings;
  1         5  
  1         49  
6              
7             BEGIN {
8 1     1   2 $Time::Limit::AUTHORITY = 'cpan:TOBYINK';
9 1         31 $Time::Limit::VERSION = '0.002';
10             }
11              
12 1     1   10 use Carp qw( carp );
  1         2  
  1         71  
13 1     1   53039 use Time::HiRes qw( time usleep );
  1         2090  
  1         5  
14              
15             sub import
16             {
17 0     0     shift;
18            
19 0           my %opts;
20 0   0       while (@_ and $_[0] =~ /^-(.+)$/) {
21 0           shift;
22 0           $opts{ $1 }++;
23             }
24            
25 0           my $start = time;
26 0   0       my $limit = $_[0] || 10;
27 0           my $parent = $$;
28            
29 0 0         if ( !!! fork )
30             {
31 0           my $finish = $start + $limit;
32 0           while ( 1 )
33             {
34 0           usleep 1;
35            
36             # Long running parent process
37 0 0         if ( time > $finish )
    0          
38             {
39 0 0         carp("Process $parent timed out!") unless $opts{quiet};
40            
41 0           my $counter = 2_000_000;
42            
43             # While we can still reach the parent process
44 0           while ( kill(0, $parent) )
45             {
46             # Send it a signal to end
47 0 0         my $signal = ($counter > 1_000_000) ? 'TERM' : 'KILL';
48 0 0         $signal = -$signal if $opts{group};
49 0 0         carp("Sending $signal to $parent") unless $opts{quiet};
50 0           kill($signal, $parent);
51            
52             # Sleep for progressively less time between kill signals
53 0           usleep $counter;
54 0           $counter -= 250_000;
55 0 0         $counter = 250_000 if $counter < 250_000;
56             }
57            
58 0           exit(252);
59             }
60            
61             # Parent process seems to have ended by itself
62             elsif ( not kill(0, $parent) )
63             {
64 0 0         carp("Process $parent did not time out") if $opts{verbose};
65             # Nothing more to do
66 0           exit;
67             }
68             }
69             }
70             }
71              
72             1;
73              
74             __END__