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