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 use vars qw($VERSION $BRANCH);
  20 $VERSION = sprintf( "%d.%03d", q$Revision$ =~ /(\d+)\.(\d+)/ );
  21 $BRANCH = sprintf( "%d.%03d", q$Revision$ =~ /\d+\.\d+\.(\d+)\.(\d+)/ ) || 0;
  22 $main::build += $VERSION;
  23 $main::branch += $BRANCH;
  24
  25 sub new
  26 {
  27     my ($pkg, $time, $proc, $recur) = @_;
  28         my $obj = ref($pkg);
  29         my $class = $obj || $pkg;
  30         my $self = bless { t=>$time + time, proc=>$proc }, $class;
  31         $self->{interval} = $time if $recur;
  32         push @timerchain, $self;
  33         $notimers++;
  34         dbg("Timer created ($notimers)") if isdbg('connll');
  35         return $self;
  36 }
  37
  38 sub del
  39 {
  40         my $self = shift;
  41         delete $self->{proc};
  42         @timerchain = grep {$_ != $self} @timerchain;
  43 }
  44
  45 sub handler
  46 {
  47         my $now = time;
  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
  59 sub DESTROY
  60 {
  61         dbg("timer destroyed ($Timer::notimers)") if isdbg('connll');
  62         $Timer::notimers--;
  63 }
  64 1;