X-Git-Url: http://gb7djk.dxcluster.net/gitweb/gitweb.cgi?a=blobdiff_plain;f=perl%2FTimer.pm;h=fb429f643537d40cd204b367c93ed5f962cd74df;hb=refs%2Fheads%2Fnew-spawn;hp=8969756f550706bb942e7bc3e7c6f2bb93054841;hpb=586cbb347e7639f5575b48572e75140501a109c0;p=spider.git diff --git a/perl/Timer.pm b/perl/Timer.pm index 8969756f..fb429f64 100644 --- a/perl/Timer.pm +++ b/perl/Timer.pm @@ -3,16 +3,20 @@ # # 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 { @@ -22,28 +26,39 @@ sub new my $self = bless { t=>$time + time, proc=>$proc }, $class; $self->{interval} = $time if $recur; push @timerchain, $self; + $notimers++; + dbg("Timer created ($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; } 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("timer destroyed ($Timer::notimers)") if isdbg('connll'); + $Timer::notimers--; +} 1;