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('connll', "Timer created ($notimers)");
  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         for (@timerchain) {
  45                 if ($now >= $_->{t}) {
  46                         &{$_->{proc}}();
  47                         $_->{t} = $now + $_->{interval} if exists $_->{interval};
  48                 }
  49         }
  50 }
  51
  52 sub DESTROY
  53 {
  54         dbg('connll', "Timer destroyed ($notimers)");
  55         $notimers--;
  56 }
  57 1;