tags/0.4.3.1-pre2/SrSv/Timer.pm

   1 #       This file is part of SurrealServices.
   2 #
   3 #       SurrealServices is free software; you can redistribute it and/or modify
   4 #       it under the terms of the GNU General Public License as published by
   5 #       the Free Software Foundation; either version 2 of the License, or
   6 #       (at your option) any later version.
   7 #
   8 #       SurrealServices is distributed in the hope that it will be useful,
   9 #       but WITHOUT ANY WARRANTY; without even the implied warranty of
  10 #       MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
  11 #       GNU General Public License for more details.
  12 #
  13 #       You should have received a copy of the GNU General Public License
  14 #       along with SurrealServices; if not, write to the Free Software
  15 #       Foundation, Inc., 59 Temple Place, Suite 330, Boston, MA  02111-1307  USA
  16
  17 package SrSv::Timer;
  18
  19 use strict;
  20
  21 use Exporter 'import';
  22 BEGIN { our @EXPORT_OK = qw(add_timer begin_timer stop_timer) }
  23
  24 use Event;
  25
  26 use SrSv::Debug;
  27 use SrSv::Process::InParent qw(_add_timer stop_timer);
  28 use SrSv::Message qw(message add_callback);
  29
  30 our @timers;
  31 our $timer_watcher;
  32
  33 add_callback({
  34         TRIGGER_COND => { CLASS => 'TIMER' },
  35         CALL => 'SrSv::Timer::call',
  36 });
  37
  38 if(DEBUG()) {
  39         add_timer('hello', 2, __PACKAGE__, 'SrSv::Timer::test');
  40         sub test { ircd::privmsg('ServServ', '#surrealchat', $_[0]) };
  41 }
  42
  43 sub add_timer($$$$) {
  44         my ($token, $delay, $owner, $callback) = @_;
  45
  46         if($callback !~ /::/) {
  47                 $callback = caller() . "::$callback";
  48         }
  49
  50         _add_timer($token, $delay, $owner, $callback);
  51 }
  52
  53 sub _add_timer {
  54         my ($token, $delay, $owner, $callback) = @_;
  55
  56         push @{ $timers[$delay] }, [$token, $owner, $callback];
  57 }
  58
  59 sub begin_timer {
  60         $timer_watcher = Event->timer(interval => 1, cb => \&trigger);
  61 }
  62
  63 sub stop_timer {
  64         $timer_watcher->cancel if $timer_watcher;
  65 }
  66
  67 sub trigger {
  68         my $timers = shift @timers;
  69
  70         foreach my $timer (@$timers) {
  71                 message({
  72                         CLASS => 'TIMER',
  73                         TOKEN => $timer->[0],
  74                         OWNER => $timer->[1],
  75                         REALCALL => $timer->[2],
  76                         CALL => 'SrSv::Timer::call'
  77                 });
  78         }
  79 }
  80
  81 sub call {
  82         no strict 'refs';
  83         my ($message, $callback) = @_;
  84
  85         &{$message->{REALCALL}}($message->{TOKEN});
  86 }
  87
  88 1;