File Coverage

blib/lib/Schedule/Easing.pm

Criterion	Covered	Total	%
statement	73	81	90.1
branch	22	30	73.3
condition	6	10	60.0
subroutine	10	10	100.0
pod	0	4	0.0
total	111	135	82.2

package Schedule::Easing;

use strict;
use warnings;

our $VERSION='0.1.4';

use Carp qw/carp confess/;

use Schedule::Easing::Block;
use Schedule::Easing::MD5;
use Schedule::Easing::Numeric;

sub new {
	my ($ref,%opt)=@_;
	my $class=ref($ref)||$ref;
	my %self=(
		schedule   =>$opt{schedule}//[],
		warnExpired=>$opt{warnExpired}//0,
	);
	return bless(\%self,$class)->init();
}

my %builder=(
	'block'  =>'Schedule::Easing::Block',
	'md5'    =>'Schedule::Easing::MD5',
	'numeric'=>'Schedule::Easing::Numeric',
);

sub init {
	my ($self)=@_;
	if(ref($$self{schedule}) ne 'ARRAY') { confess('Schedule must be an array') }
	foreach my $ease (@{$$self{schedule}}) {
		if(ref($ease) ne 'HASH') { confess('Schedule entry must be a hash') }
		if(my $builder=$builder{$$ease{type}}) {
			$ease=$builder->new(%$ease,_warnExpired=>$$self{warnExpired});
			if($$ease{_err}) { $$self{_err}=1 }
		}
		else { confess("Unsupported entry type $$ease{type}") }
	}
	return $self;
}

sub matches {
	my ($self,%opt)=@_;
	$opt{ts}//=time();
	my @res;
	foreach my $event (@{$opt{events}}) {
		my $message;
		my $eref=ref($event);
		if(!$eref)              { $message=$event }
		elsif($eref eq 'HASH')  { $message=$$event{message} } # UNTESTED
		elsif($eref eq 'ARRAY') { $message=$$event[0] }       # UNTESTED
		else                    { carp("Invalid event structure ($eref)"); next }
		my $includes=1;
		foreach my $ease (@{$$self{schedule}}) {
			if(my %data=$ease->matches($message)) {
				$includes=$ease->includes($opt{ts},message=>$message,%data);
				last;
			}
		}
		if($includes) { push @res,$event }
	}
	return @res;
}

sub schedule {
	my ($self,%opt)=@_;
	my @res;
	foreach my $event (@{$opt{events}}) {
		my $message;
		my $eref=ref($event);
		if(!$eref)              { $message=$event }
		elsif($eref eq 'HASH')  { $message=$$event{message} } # UNTESTED
		elsif($eref eq 'ARRAY') { $message=$$event[0] }       # UNTESTED
		else                    { carp("Invalid event structure ($eref)"); next }
		my $scheduled=0;
		foreach my $ease (@{$$self{schedule}}) {
			if(my %data=$ease->matches($message)) {
				$scheduled=$ease->schedule(message=>$message,%data);
				if(defined($scheduled)) {
					my $intsched=int($scheduled);
					if($scheduled>$intsched) { $scheduled=1+$intsched }
				}
				last;
			}
		}
		push @res,[$scheduled,$event];
	}
	return @res;
}

1;

__END__