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