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