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 sub new
  20 {
  21     my ($pkg, $time, $proc, $recur) = @_;
  22         my $obj = ref($pkg);
  23         my $class = $obj || $pkg;
  24         my $self = bless { t=>$time + time, proc=>$proc }, $class;
  25         $self->{interval} = $time if $recur;
  26         push @timerchain, $self;
  27         $notimers++;
  28         dbg("Timer created ($notimers)") if isdbg('connll');
  29         return $self;
  30 }
  31
  32 sub del
  33 {
  34         my $self = shift;
  35         delete $self->{proc};
  36         @timerchain = grep {$_ != $self} @timerchain;
  37 }
  38
  39 sub handler
  40 {
  41         my $now = time;
  42
  43         # handle things on the timer chain
  44         my $t;
  45         foreach $t (@timerchain) {
  46                 if ($now >= $t->{t}) {
  47                         &{$t->{proc}}();
  48                         $t->{t} = $now + $t->{interval} if exists $t->{interval};
  49                 }
  50         }
  51 }
  52
  53 sub DESTROY
  54 {
  55         dbg("timer destroyed ($Timer::notimers)") if isdbg('connll');
  56         $Timer::notimers--;
  57 }
  58 1;