view timers.pl @ 74:a2fd98163675 default tip

Removing debug
author Dominic Cleal <dominic@computerkb.co.uk>
date Thu, 11 Feb 2010 00:26:16 +0000
parents 2f9832b6dede
children
line wrap: on
line source

#!/usr/bin/perl

=pod

Braindead timers thing.

Copyright ©2000 Andy Smith <andy+timers.pl@strugglers.net>

Artistic license as perl.

$Id: timers.pl 776 2008-11-03 18:20:04Z andy $

=cut

use warnings;
use strict;

my $genid = 0;
my @timers_once;
my @timers_repeat;

sub add_one_shot_timer {
	my ($offset, $coderef) = @_;

	my $one_shot = {};

	$one_shot->{id} = $genid++;
	$one_shot->{stamp} = time();
	$one_shot->{offset} = $offset;
	$one_shot->{coderef} = $coderef;

	push(@timers_once, $one_shot);
	return $one_shot->{id};
}

sub del_one_shot_timer {
	my ($timer_id) = shift;

	@timers_once = grep { $_->{id} ne $timer_id } @timers_once;
}


sub add_repeat_timer {
	my ($every, $coderef) = @_;

	my $repeat = {};

	$repeat->{id} = $genid++;
	$repeat->{last} = time();
	$repeat->{every} = $every;
	$repeat->{coderef} = $coderef;

	push(@timers_repeat, $repeat);
	return $repeat->{id};
}

sub del_repeat_timer {
	my ($timer_id) = shift;

	@timers_repeat = grep { $_->{id} ne $timer_id } @timers_repeat;
}

sub get_one_shot_timer {
	my ($id) = shift;

	return grep { $_->{id} eq $id } @timers_once;
}

sub get_repeat_timer {
	my ($id) = shift;

	return grep { $_->{id} eq $id } @timers_repeat;
}

sub do_timers_once {
	my ($self) = shift;
	my ($timer_id, $timer);

	return unless @timers_once;

	my $now = time();

	for ($timer_id = 0; $timer_id <= $#timers_once; $timer_id++) {
		$timer = $timers_once[$timer_id];

		if ($now >= $timer->{stamp} + $timer->{offset}) {
			&{ $timer->{coderef} }($timer->{id}, $self);
			splice(@timers_once, $timer_id, 1);
			$timer_id--;
		}
	}
}

sub do_timers_repeat {
	my ($self) = shift;

	my ($timer_id, $timer);

	return unless @timers_repeat;

	my $now = time();

	for ($timer_id = 0; $timer_id <= $#timers_repeat; $timer_id++) {
		$timer = $timers_repeat[$timer_id];

		if ($now >= $timer->{last} + $timer->{every}) {
			&{ $timer->{coderef} }($timer->{id}, $self);
			$timer->{last} = $now;
		}
	}
}

1;