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);
  14
  15 @timerchain = ();
  16
  17 sub new
  18 {
  19     my ($pkg, $time, $proc, $recur) = @_;
  20         my $obj = ref($pkg);
  21         my $class = $obj || $pkg;
  22         my $self = bless { t=>$time + time, proc=>$proc }, $class;
  23         $self->{interval} = $time if $recur;
  24         push @timerchain, $self;
  25         return $self;
  26 }
  27
  28 sub del
  29 {
  30         my $self = shift;
  31         my $old = delete $self->{proc};
  32         @timerchain = grep {$_ != $self} @timerchain;
  33         return $old;
  34 }
  35
  36 sub handler
  37 {
  38         my $now = time;
  39
  40         # handle things on the timer chain
  41         for (@timerchain) {
  42                 if ($now >= $_->{t}) {
  43                         &{$_->{proc}}();
  44                         $_->{t} = $now + $_->{interval} if exists $_->{interval};
  45                 }
  46         }
  47 }
  48
  49 1;