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

package Time::Limit;

use 5.006;
use strict;
use warnings;

BEGIN {
	$Time::Limit::AUTHORITY = 'cpan:TOBYINK';
	$Time::Limit::VERSION   = '0.002';
}

use Carp qw( carp );
use Time::HiRes qw( time usleep );

sub import
{
	shift;

	my %opts;
	while (@_ and $_[0] =~ /^-(.+)$/) {
		shift;
		$opts{ $1 }++;
	}

	my $start  = time;
	my $limit  = $_[0] || 10;
	my $parent = $$;

	if ( !!! fork )
	{
		my $finish = $start + $limit;
		while ( 1 )
		{
			usleep 1;

			# Long running parent process
			if ( time > $finish )
			{
				carp("Process $parent timed out!") unless $opts{quiet};

				my $counter = 2_000_000;

				# While we can still reach the parent process
				while ( kill(0, $parent) )
				{
					# Send it a signal to end
					my $signal = ($counter > 1_000_000) ? 'TERM' : 'KILL';
					$signal = -$signal if $opts{group};
					carp("Sending $signal to $parent") unless $opts{quiet};
					kill($signal, $parent);

					# Sleep for progressively less time between kill signals
					usleep $counter;
					$counter -= 250_000;
					$counter = 250_000 if $counter < 250_000;
				}

				exit(252);
			}

			# Parent process seems to have ended by itself
			elsif ( not kill(0, $parent) )
			{
				carp("Process $parent did not time out") if $opts{verbose};
				# Nothing more to do
				exit;
			}
		}
	}
}

1;

__END__