view release on metacpan or  search on metacpan

lib/Schedule/Activity/Annotation.pm  view on Meta::CPAN

package Schedule::Activity::Annotation;

use strict;
use warnings;
use Ref::Util qw/is_hashref is_regexpref is_ref/;
use Scalar::Util qw/looks_like_number/;

our $VERSION='0.3.0';

my %property=map {$_=>undef} qw/message nodes before between p limit attributes note/;

sub new {
	my ($ref,%opt)=@_;
	my $class=is_ref($ref)||$ref;
	return bless(\%opt,$class);
}

sub validate {
	my (%node)=@_;
	my @errors;
	foreach my $k (grep {!exists($property{$_})} keys(%node)) { push @errors,"Invalid key:  $k" }
	if(!defined($node{message}))    { push @errors,'Expected:  message' }
	if(!is_regexpref($node{nodes})) { push @errors,'Expected regexp:  nodes' }
	foreach my $k (grep {defined($node{$_})} qw/between p limit/) {
		if(!looks_like_number($node{$k})) { push @errors,"Invalid value:  $k" }
		elsif($node{$k}<0)                { push @errors,"Negative value:  $k" }
	}
	$node{before}//={};
	if(!is_hashref($node{before})) { push @errors,'Before invalid structure' }
	else { foreach my $k (grep {defined($node{before}{$_})} qw/min max/) {
		if(!looks_like_number($node{before}{$k})) { push @errors,"Invalid value:  before{$k}" }
		} }
	return @errors;
}

sub annotate {
	my ($self,@schedule)=@_;
	my %before=%{$$self{before}//{}};
	my %opt=(
		p        =>$$self{p}//1,
		beforemin=>$before{min}//$before{max}//1,
		beforemax=>$before{max}//$before{min}//1,
		between  =>$$self{between}//1,
	);
	my @matchidx=grep {rand()<=$opt{p}} grep {$schedule[$_][1]{keyname}=~$$self{nodes}} (0..$#schedule);
	if(!@matchidx) { return }
	my @notes;
	foreach my $i (@matchidx) {
		my @tmwindow=sort {$a<=>$b} ($schedule[$i][0]-$opt{beforemax},$schedule[$i][0]-$opt{beforemin});
		if($i>0)          { my $tm=$schedule[$i-1][0]+1; if($tmwindow[0]<=$tm) { $tmwindow[0]=$tm } }
		if($i<$#schedule) { my $tm=$schedule[$i+1][0]-1; if($tmwindow[1]>=$tm) { $tmwindow[1]=$tm } }
		if($tmwindow[1]>=$tmwindow[0]) { push @notes,[@tmwindow] }
	}
	if($$self{limit}) { while(1+$#notes>$$self{limit}) {
		my $idx=int(rand(1+$#notes)); splice(@notes,$idx,1) } }
	for(my $i=1;$i<=$#notes;$i++) {  ## no critic (CStyleForLoops)
		if($notes[$i][0]-$notes[$i-1][0]<$opt{between}) {
			if($notes[$i][1]-$notes[$i-1][0]<$opt{between}) { splice(@notes,$i,1); $i-- }
			else { $notes[$i][0]=$notes[$i-1][0]+$opt{between} }
		}
	}
	return map {[$$_[0], {map {$_=>$$self{$_}} grep {$$self{$_}} qw/message attributes/}]} @notes;
}

1;