File Coverage

blib/lib/Sub/Timebound.pm

Criterion	Covered	Total	%
statement	43	43	100.0
branch	6	6	100.0
condition			n/a
subroutine	6	6	100.0
pod	0	1	0.0
total	55	56	98.2

package Sub::Timebound;

use 5.008;
use strict;
use warnings;

require Exporter;
use AutoLoader qw(AUTOLOAD);

our @ISA = qw(Exporter);

# Items to export into callers namespace by default. Note: do not export
# names by default without a very good reason. Use EXPORT_OK instead.
# Do not simply export all your public functions/methods/constants.

# This allows declaration	use Sub::Timebound ':all';
# If you do not need this, moving things directly into @EXPORT or @EXPORT_OK
# will save memory.
our %EXPORT_TAGS = ( 'all' => [ qw(

) ] );

our @EXPORT_OK = ( @{ $EXPORT_TAGS{'all'} } );

our @EXPORT = qw(timeboundretry);

our $VERSION = '1.01';

# Preloaded methods go here.

sub timeboundretry
{
	# Allocated Time, Attempts, Wait Time between attempts, Coderef to execute, Params
	my $allocated = int(shift);
	my $attempts = int(shift);
	my $wait = int(shift);
	my $coderef = shift;
	my @params = @_;

	my $ret = {
		value => undef,
		status => 1, ### Assume Success
	};

	my $count = 1;

	my $ref_string = "Did not complete in allocated $allocated Seconds\n";

	AGAIN: {

	eval {
		local $SIG{'ALRM'} = sub { die $ref_string };
		alarm($allocated);
		$ret->{value} = $coderef->(@params);
		$ret->{status} = 1;	### We execute this means all is well
		alarm(0);		### Reset alarm signal upon success
	};

	alarm(0);	### Reset alarm signal

	if ($@) {
		$ret->{status} = 0; ### Inform the caller that function call did not succeed
		### Now all we know is that eval block failed.
		### We still should determine if it died due to timeout or the called function misbehaved
		print "ERROR $@\n";

		if ("$@" eq $ref_string) {
			print "... Error happened due to timeout\n";
		} else {
			print "... Error happened due to function misbehavior\n";
		}

		$count++;
		if ($count > $attempts) {
			print "Exceeded count limit ($attempts)....exiting\n";
			return $ret;
		} else {
			print "Retry after $wait seconds...\n";
			sleep $wait;
			goto AGAIN;
		}
	}

	}
	return $ret;
}

# Autoload methods go after =cut, and are processed by the autosplit program.

1;
__END__