File Coverage

blib/lib/Net/Peep/Scheduler.pm

Criterion	Covered	Total	%
statement	74	82	90.2
branch	12	18	66.6
condition	4	11	36.3
subroutine	16	18	88.8
pod	0	9	0.0
total	106	138	76.8

package Net::Peep::Scheduler;

require 5.00503;
use strict;
# use warnings; # commented out for 5.005 compatibility
use Carp;
use Data::Dumper;
use Time::HiRes qw{ tv_interval gettimeofday alarm };
use Net::Peep::Log;

require Exporter;

use vars qw{ @ISA %EXPORT_TAGS @EXPORT_OK @EXPORT $VERSION };

@ISA = qw(Exporter);
%EXPORT_TAGS = ( 'all' => [ qw( ) ] );
@EXPORT_OK = ( @{ $EXPORT_TAGS{'all'} } );
@EXPORT = qw( );
$VERSION = do { my @r = (q$Revision: 1.2 $ =~ /\d+/g); sprintf "%d."."%02d" x $#r, @r };

# structure of an event
# $entry = {
#  'application' => The application name
#  'schedule_time' => the time for wakeup
#  'type' => the type of event
#  'data' => the data to pass to the handler
#  'handler' => the handler to invoke
# }

# The scheduled event queue
use vars qw( @scheduler_queue );

sub new {

	my $self = shift;
	my $class = ref($self) || $self;
	my $this = { };
	bless $this, $class;

	# Init the scheduler
	$this->logger()->debug(8, "Registering scheduler and scheduling alarm ...");
	$SIG{'ALRM'} = sub { $this->schedulerWakeUp };

	return $this;

} #end sub new

# returns a logging object
sub logger {

	my $self = shift;
	unless ( exists $self->{'__LOGGER'} ) { $self->{'__LOGGER'} = new Net::Peep::Log }
	return $self->{'__LOGGER'};

} #end sub logger

sub schedulerAddEvent {

	my ($self, $app, $sleepsec, $sleepusec, $type, $handler, $data, $repeated) = @_;

	# Do some sanity checking
	confess "Error: No application name given to scheduler when adding event." unless $app;
	confess "Error: Wakeup given to scheduler is in the past." unless $sleepsec > 0.0 || $sleepusec > 0.0;
	confess "Error: No scheduled event type given to scheduler when adding event." unless $type;
	confess "Error: No handler given to scheduler when adding event." unless $handler;

	my ($s, $usec) = gettimeofday();

	my $entry = {
		'application' => $app,
		'sleepsec' => $sleepsec,
		'sleepusec' => $sleepusec,
		'schedule_time' => [ $s + $sleepsec, $usec + $sleepusec ],
		'type' => $type,
		'data' => $data,
		'handler' => $handler,
		'repeated' => $repeated,
	};

	# Add the entry into the scheduler queue and sort by time
	push @scheduler_queue, $entry;
	@scheduler_queue = sort {
		my ($asec, $ausec) = @{ $a->{'schedule_time'} };
		my ($bsec, $busec) = @{ $b->{'schedule_time'} };
		$asec + 0.000001 * $ausec  <=> $bsec + 0.000001 * $busec;
	} @scheduler_queue;

	# Now sleep for the new time
	$self->schedulerSleep;

} #end sub schedulerAddEvent

sub schedulerRemoveEventsForApp {

	# Removes all entries in the scheduler queue for an application

	my $self = shift;
	my $app = shift || die "Application name not found!";

	@scheduler_queue = grep ! $_->{'app'} eq $app, @scheduler_queue;


} # end sub schedulerRemoveEventsForApp

sub schedulerGetEvent {

	my $self = shift;
	return (shift @scheduler_queue);

} #end sub schedulerGetEvent

sub schedulerCalcSleepTime {

	my $self = shift;
	my $nextent = $scheduler_queue[0];

	# Check if we have an empty queue
	unless ( $nextent ) { return undef; }

	my $sleeptime = tv_interval ( [ gettimeofday() ], $nextent->{'schedule_time'} );
	return $sleeptime;

} #end sub schedulerCalcSleepTime

sub schedulerSleep {

	my ($self, $time) = @_;
	my $sleeptime = $time || $self->schedulerCalcSleepTime;

	# Check if there's no such sleep time at this moment
	unless ( $sleeptime ) { return undef; }

	$self->logger()->debug(8, "Scheduler will wake up in $sleeptime seconds.");
	alarm ( $sleeptime );
	return $sleeptime;

} #end sub schedulerSleep

sub schedulerExplicitWakeUp {

	my $self = shift;
	$self->logger()->debug(8, "Scheduler received explicit wake up...");
	$self->schedulerWakeUp;

} #end sub schedulerExplicitWakeUp

sub schedulerWakeUp {

	my $self = shift;
	$self->logger()->debug(8, "Scheduler woke up.");
	my $entry = $self->schedulerGetEvent;

# Doesn't apply because a schedulerExplicitWakeUp call would violate this and
# still be valid
#
#	# Check that the time has past
#	unless ( &Time::HiRes::tv_interval ( [ &Time::HiRes::gettimeofday() ], $entry->{'schedule_time'}) < 0.0 ) {
#		$self->logger()->debug(8, "Scheduled event was premature - returned error.");
#		return "Error: Scheduler woke up prematurely.";
#	}

	# Check if this is an internal housekeeping entry
	# Otherwise, pass control and data to the handler
	if ($entry->{'application'} eq '__SCHEDULER') {
		# internal processing - reserved for future use
		$self->logger()->debug(8, "Processing internal event...");
	}
	else {
		# Otherwise, call the handler with arguments of the type
		# of scheduled event and the data associated
		$self->logger()->debug(8, "Invoking event handler for ". $entry->{'application'}. " of type ". $entry->{'type'}. " ...");
		&{ $entry->{'handler'} } ( $entry->{'type'}, $entry->{'data'} );
		if ($entry->{'repeated'}) {

			# if it's a repeated event, it should
			# reschedule itself

			# note that repeated events don't happen
			# precisely every sleepsec + 0.000001 *
			# sleepusec because of a delay every cycle
			# imposed by the execution time of the handler

			$self->schedulerAddEvent(
				$entry->{'application'},
				$entry->{'sleepsec'},
				$entry->{'sleepusec'},
				$entry->{'type'},
				$entry->{'handler'},
				$entry->{'data'},
				$entry->{'repeated'}
			);
		}
	}

	# Reassign ourselves before we exit
	$SIG{'ALRM'} = sub { $self->schedulerWakeUp };
	$self->schedulerSleep;

} #end sub schedulerWakeUp

1;
__END__