3
0
mirror of https://github.com/pragma-/pbot.git synced 2024-12-23 11:12:42 +01:00
pbot/PBot/Timer.pm

206 lines
4.4 KiB
Perl

# File: Timer.pm
# Author: pragma_
#
# Purpose: Provides functionality to register and execute one or more subroutines every X seconds.
#
# Caveats: Uses ALARM signal and all its issues.
package PBot::Timer;
use warnings;
use strict;
use vars qw($VERSION);
$VERSION = '1.0.0';
use Carp ();
our $min_timeout = 10;
our $max_seconds = 1000000;
our $seconds = 0;
our @timer_funcs;
$SIG{ALRM} = sub {
$seconds += $min_timeout;
alarm $min_timeout;
# print "ALARM! $seconds $min_timeout\n";
# call timer func subroutines
foreach my $func (@timer_funcs) { &$func; }
# prevent $seconds over-flow
$seconds -= $max_seconds if $seconds > $max_seconds;
};
sub new {
if(ref($_[1]) eq 'HASH') {
Carp::croak("Options to Timer should be key/value pairs, not hash reference");
}
my ($class, %conf) = @_;
my $timeout = delete $conf{timeout};
$timeout = 10 unless defined $timeout;
my $name = delete $conf{name};
$name = "Unnamed $timeout Second Timer" unless defined $name;
my $self = {
handlers => [],
name => $name,
timeout => $timeout,
enabled => 0,
};
bless $self, $class;
$min_timeout = $timeout if $timeout < $min_timeout;
# alarm signal handler (poor-man's timer)
$self->{timer_func} = sub { on_tick_handler($self) };
return $self;
}
sub start {
my $self = shift;
# print "Starting Timer $self->{name} $self->{timeout} $self->{enabled}\n";
$self->{enabled} = 1;
push @timer_funcs, $self->{timer_func};
alarm $min_timeout;
}
sub stop {
my $self = shift;
# print "Stopping timer $self->{name}\n";
$self->{enabled} = 0;
@timer_funcs = grep { $_ != $self->{timer_func} } @timer_funcs;
}
sub on_tick_handler {
my $self = shift;
my $elapsed = 0;
# print "-----\n";
# print "on tick handler for $self->{name}\n";
if($self->{enabled}) {
if($#{ $self->{handlers} } > -1) {
# call handlers supplied via register() if timeout for each has elapsed
foreach my $func (@{ $self->{handlers} }) {
if(defined $func->{last}) {
$func->{last} -= $max_seconds if $seconds < $func->{last}; # handle wrap-around of $seconds
if($seconds - $func->{last} >= $func->{timeout}) {
$func->{last} = $seconds;
$elapsed = 1;
}
} else {
$func->{last} = $seconds;
$elapsed = 1;
}
if($elapsed) {
&{ $func->{subref} }($self);
$elapsed = 0;
}
}
} else {
# call default overridable handler if timeout has elapsed
if(defined $self->{last}) {
# print "$self->{name} last = $self->{last}, seconds: $seconds, timeout: " . $self->timeout . " " . ($seconds - $self->{last}) . "\n";
$self->{last} -= $max_seconds if $seconds < $self->{last}; # handle wrap-around
if($seconds - $self->{last} >= $self->timeout) {
$elapsed = 1;
$self->{last} = $seconds;
}
} else {
# print "New addition for $self->{name}\n";
$elapsed = 1;
$self->{last} = $seconds;
}
if($elapsed) {
$self->on_tick();
$elapsed = 0;
}
}
}
# print "-----\n";
}
# overridable method, executed whenever timeout is triggered
sub on_tick {
my $self = shift;
print "Tick! $self->{name} $self->{timeout} $self->{last} $seconds\n";
}
sub register {
my $self = shift;
my ($ref, $timeout);
if(@_) {
($ref, $timeout) = @_;
} else {
Carp::croak("Must pass subroutine reference to register()");
}
# TODO: Check if subref already exists in handlers?
$timeout = 300 if not defined $timeout; # set default value of 5 minutes if not defined
my $h = { subref => $ref, timeout => $timeout };
push @{ $self->{handlers} }, $h;
# print "-- Registering timer $ref at $timeout seconds\n";
if($timeout < $min_timeout) {
$min_timeout = $timeout;
}
if($self->{enabled}) {
alarm $min_timeout;
}
}
sub unregister {
my $self = shift;
my $ref;
if(@_) {
$ref = shift;
} else {
Carp::croak("Must pass subroutine reference to unregister()");
}
# print "-- Removing timer $ref\n";
@{ $self->{handlers} } = grep { $_->{subref} != $ref } @{ $self->{handlers} };
}
sub max_seconds {
if(@_) { $max_seconds = shift; }
return $max_seconds;
}
sub timeout {
my $self = shift;
if(@_) { $self->{timeout} = shift; }
return $self->{timeout};
}
sub name {
my $self = shift;
if(@_) { $self->{name} = shift; }
return $self->{name};
}
1;