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 + $main::systime, proc=>$proc }, $class;
  27         $self->{interval} = $time if $recur;
  28         push @timerchain, $self;
  29         $notimers = @timerchain;
  30         dbg("Timer created (notimers: $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         $notimers = @timerchain;
  40         dbg("Timer deleted (notimers: $notimers)") if isdbg('connll');
  41 }
  42
  43 sub handler
  44 {
  45         my $now = $main::systime;
  46
  47         return unless $now != $lasttime;
  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         $lasttime = $now;
  59 }
  60
  61 sub DESTROY
  62 {
  63         dbg("timer destroyed ($Timer::notimers)") if isdbg('connll');
  64 }
  65 1;