X-Git-Url: http://dxcluster.net/gitweb/gitweb.cgi?a=blobdiff_plain;f=perl%2FTimer.pm;h=e0f760b857a576708c60a01d9fe74a6a58b0a73f;hb=c83b1ca22765fc07e5adcdc8dac24cbd066c9b95;hp=8969756f550706bb942e7bc3e7c6f2bb93054841;hpb=586cbb347e7639f5575b48572e75140501a109c0;p=spider.git diff --git a/perl/Timer.pm b/perl/Timer.pm index 8969756f..e0f760b8 100644 --- a/perl/Timer.pm +++ b/perl/Timer.pm @@ -3,47 +3,63 @@ # # This uses callbacks. BE CAREFUL!!!! # -# $Id$ +# # # Copyright (c) 2001 Dirk Koopman G1TLH # package Timer; -use vars qw(@timerchain); +use vars qw(@timerchain $notimers $lasttime); +use DXDebug; @timerchain = (); +$notimers = 0; + +$lasttime = 0; sub new { my ($pkg, $time, $proc, $recur) = @_; my $obj = ref($pkg); my $class = $obj || $pkg; - my $self = bless { t=>$time + time, proc=>$proc }, $class; + my $self = bless { t=>$time + $main::systime, proc=>$proc }, $class; $self->{interval} = $time if $recur; push @timerchain, $self; + $notimers = @timerchain; + dbg("Timer created (notimers: $notimers)") if isdbg('connll'); return $self; } sub del { my $self = shift; - my $old = delete $self->{proc}; + delete $self->{proc}; @timerchain = grep {$_ != $self} @timerchain; - return $old; + $notimers = @timerchain; + dbg("Timer deleted (notimers: $notimers)") if isdbg('connll'); } sub handler { - my $now = time; - + my $now = $main::systime; + + return unless $now != $lasttime; + # handle things on the timer chain - for (@timerchain) { - if ($now >= $_->{t}) { - &{$_->{proc}}(); - $_->{t} = $now + $_->{interval} if exists $_->{interval}; + my $t; + foreach $t (@timerchain) { + if ($now >= $t->{t}) { + &{$t->{proc}}(); + $t->{t} = $now + $t->{interval} if exists $t->{interval}; } } + + $lasttime = $now; } +sub DESTROY +{ + dbg("timer destroyed ($Timer::notimers)") if isdbg('connll'); +} 1;