]> www.dxcluster.org Git - spider.git/blob - perl/Timer.pm
fix erronoeus input filter cmd causing crashes
[spider.git] / perl / Timer.pm
1 #
2 # Polled Timer handling
3 #
4 # This uses callbacks. BE CAREFUL!!!!
5 #
6 #
7 #
8 # Copyright (c) 2001 Dirk Koopman G1TLH
9 #
10
11 package Timer;
12
13 use vars qw(@timerchain $notimers $lasttime);
14 use DXDebug;
15
16 @timerchain = ();
17 $notimers = 0;
18
19 $lasttime = 0;
20
21 sub new
22 {
23     my ($pkg, $time, $proc, $recur) = @_;
24         my $obj = ref($pkg);
25         my $class = $obj || $pkg;
26         my $self = bless { t=>$time + time, proc=>$proc }, $class;
27         $self->{interval} = $time if $recur;
28         push @timerchain, $self;
29         $notimers++;
30         dbg("Timer created ($notimers)") if isdbg('connll');
31         return $self;
32 }
33
34 sub del
35 {
36         my $self = shift;
37         delete $self->{proc};
38         @timerchain = grep {$_ != $self} @timerchain;
39 }
40
41 sub handler
42 {
43         my $now = time;
44
45         return unless $now != $lasttime;
46
47         # handle things on the timer chain
48         my $t;
49         foreach $t (@timerchain) {
50                 if ($now >= $t->{t}) {
51                         &{$t->{proc}}();
52                         $t->{t} = $now + $t->{interval} if exists $t->{interval};
53                 }
54         }
55
56         $lasttime = $now;
57 }
58
59 sub DESTROY
60 {
61         dbg("timer destroyed ($Timer::notimers)") if isdbg('connll');
62         $Timer::notimers--;
63 }
64 1;