X-Git-Url: http://dxcluster.net/gitweb/gitweb.cgi?a=blobdiff_plain;f=perl%2FTimer.pm;h=fb429f643537d40cd204b367c93ed5f962cd74df;hb=refs%2Fheads%2Fnewusers;hp=0c44278e05067723a8d0a5e25df430af2ada801c;hpb=2f1b948ea733e0ece1909a31987dc8f03044e851;p=spider.git diff --git a/perl/Timer.pm b/perl/Timer.pm index 0c44278e..fb429f64 100644 --- a/perl/Timer.pm +++ b/perl/Timer.pm @@ -3,19 +3,21 @@ # # This uses callbacks. BE CAREFUL!!!! # -# $Id$ +# # # Copyright (c) 2001 Dirk Koopman G1TLH # package Timer; -use vars qw(@timerchain $notimers); +use vars qw(@timerchain $notimers $lasttime); use DXDebug; @timerchain = (); $notimers = 0; +$lasttime = 0; + sub new { my ($pkg, $time, $proc, $recur) = @_; @@ -25,7 +27,7 @@ sub new $self->{interval} = $time if $recur; push @timerchain, $self; $notimers++; - dbg('connll', "Timer created ($notimers)"); + dbg("Timer created ($notimers)") if isdbg('connll'); return $self; } @@ -39,19 +41,24 @@ sub del sub handler { my $now = time; - + + 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('connll', "Timer destroyed ($notimers)"); - $notimers--; + dbg("timer destroyed ($Timer::notimers)") if isdbg('connll'); + $Timer::notimers--; } 1;