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;