File Coverage

blib/lib/Schedule/ByClock.pm

Criterion	Covered	Total	%
statement	12	77	15.5
branch	0	32	0.0
condition	0	9	0.0
subroutine	4	13	30.7
pod	6	6	100.0
total	22	137	16.0

package Schedule::ByClock;
use strict;

use Time::localtime;
use Carp;

use vars qw($VERSION);

$VERSION='1.01';

########################################################
sub new {
my $class=shift;
my $self=[];

bless($self,$class);
$self->_init(@_);
}

########################################################
sub get_version {
$VERSION;
}

########################################################
sub get_control_list {
my $self=shift;
@$self;
}

########################################################
sub set_control_list {
my $self=shift;

@$self=();
foreach ($self->_check_params(@_)) {
   push(@$self,$_);
   }
@$self;
}

########################################################
sub get_control_on_second {
my $self=shift;
my($tm,$until);

$tm=localtime;

if(@_) {
   $until=$self->_find_next($tm->sec,$self->_check_params(@_));
   }
else {
   $until=$self->_find_next($tm->sec,@$self);
   }
return undef unless defined($until);

if($until>$tm->sec) {
   sleep($until-$tm->sec);
   }
elsif($until<$tm->sec) {
   sleep($until+60-$tm->sec);
   }
else {
   sleep(60);
   }

$until;
}

########################################################
sub get_control_on_minute {
my $self=shift;
my($tm,$until,$until_sec);

$tm=localtime;
if(@_) {
   $until=$self->_find_next($tm->min,$self->_check_params(@_));
   }
else {
   $until=$self->_find_next($tm->min,@$self);
   }
return undef unless defined($until);

# Syncronize on top of a minute.
if($tm->sec) {
   $until_sec=$self->get_control_on_second(0);
   }

# Which minute?
$tm=localtime;

# Wait until...
if($until>$tm->min) {
   sleep(($until-$tm->min)*60);
   }
elsif($until<$tm->min) {
   sleep(($until+60-$tm->min)*60);
   }
else {
   # On the minute.
   return $until if(defined($until_sec)); # We have slept for less than a minute.
   sleep(3600);                           # Wait for a full hour.
   }

$until;
}

########################################################
# 'Internal' subs. Don't call these, since they may,
# and will, change without notice.
########################################################
sub _init {
my $self=shift;

foreach ($self->_check_params(@_)) {
   push(@$self,$_);
   }
$self;
}

sub _check_params {
my $self=shift;
my @control;

foreach (@_) {
   if(m/\D/||$_<0||$_>59) {
      carp("Control value $_ out of bounds")
      }
   else {
      push(@control,$_);
      }
   }
@control;
}

sub _find_next {
my ($self,$now,@control)=(@_);
my ($low,$high,$next);

return undef unless @control;
$low=$high=$control[0];   # Must have an initial value.

# Find highest and lowest values in list.
foreach (@control) {
   if($_>$high) {
      $high=$_;
      }
   elsif($_<$low) {
      $low=$_;
      }
   }

if($now<$high) {
   # Search the closest that is higher than now.
   $next=$high;
   foreach (@control) { $next=$_ if($_>$now&&$_<$next); }
   }
else {
   # Grab low value.
   $next=$low;
   }

$next;
}

'Ymer';

__END__