branches/0.5.0/SrSv/IRCd/Event.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::IRCd::Event;
  18
  19 use strict;
  20
  21 use Exporter 'import';
  22 BEGIN { our @EXPORT_OK = qw(addhandler callfuncs) }
  23
  24 use SrSv::Debug;
  25
  26 use SrSv::Conf2Consts qw( main );
  27
  28 use SrSv::IRCd::Queue qw(ircd_enqueue);
  29 use SrSv::IRCd::State qw($ircline $ircline_real synced initial_synced);
  30
  31 use SrSv::Message qw(add_callback message);
  32
  33 # FIXME
  34 use constant {
  35         # Wait For
  36         WF_NONE => 0,
  37         WF_NICK => 1,
  38         WF_CHAN => 2,
  39         WF_ALL => 3,
  40 };
  41
  42 sub addhandler($$$$;$) {
  43         my ($type, $src, $dst, $cb, $po) = @_;
  44
  45         if($cb !~ /::/) {
  46                 $cb = caller() . "::$cb";
  47         }
  48
  49         print "Adding callback: $cb\n" if DEBUG;
  50
  51         my @cond = ( CLASS => 'IRCD', TYPE => $type );
  52         push @cond, ( SRC => $src ) if($src);
  53         push @cond, ( DST => $dst ) if($dst);
  54
  55         add_callback({
  56                 NAME => $cb,
  57                 TRIGGER_COND => { @cond },
  58                 CALL => 'SrSv::IRCd::Event::_realcall',
  59                 REALCALL => $cb,
  60                 PARENTONLY => $po,
  61         });
  62 }
  63
  64 our $last_highqueue = time();
  65 sub callfuncs {
  66         my ($args, $sync, $wf, $message);
  67
  68         if(@_ == 4) {
  69                 $args = $_[3];
  70                 $sync = 1;
  71                 $wf = WF_NONE;
  72         } else {
  73                 $args = $_[4];
  74                 $sync = 0;
  75                 $wf = $_[3];
  76         }
  77         $message = {
  78                 CLASS => 'IRCD',
  79                 TYPE => $_[0],
  80                 SYNC => $sync,
  81                 SRC => (defined($_[1]) ? $args->[$_[1]] : undef),
  82                 DST => (defined($_[2]) ? $args->[$_[2]] : undef),
  83                 WF => $wf,
  84                 IRCLINE => ($sync ? $ircline : $ircline_real),
  85                 ARGS => $args,
  86                 ON_FINISH => ($sync ? undef : 'SrSv::IRCd::Queue::finished'), # FIXME
  87                 SYNCED => [synced, initial_synced],
  88                 QUEUE_DEPTH => SrSv::IRCd::Queue::queue_size(),
  89         };
  90         if(initial_synced && ($message->{QUEUE_DEPTH} > main_conf_highqueue) && ($last_highqueue < time()-5)) {
  91                 ircd::privmsg_noloop(main_conf_local, main_conf_operchan, "HIGH TRAFFIC WARNING",
  92                         "Queue depth exceeded @{[main_conf_highqueue]}") if defined(main_conf_operchan);
  93                 ircd::privmsg_noloop(main_conf_local, main_conf_diag, "HIGH TRAFFIC WARNING",
  94                         "Queue depth exceeded @{[main_conf_highqueue]}");
  95                 $last_highqueue = time();
  96         }
  97
  98         if($sync) {
  99                 message($message);
 100         } else {
 101                 ircd_enqueue($message);
 102         }
 103 }
 104
 105 sub _realcall($$) {
 106         no strict 'refs';
 107
 108         my ($message, $callback) = @_;
 109
 110         print "Calling ", $callback->{REALCALL}, " ", join(',', @{$message->{ARGS}}), "\n" if DEBUG();
 111         local $ircline = $message->{IRCLINE};
 112
 113         local $SrSv::IRCd::State::synced = $message->{SYNCED}[0]; # XXX This is questionable.
 114         local $SrSv::IRCd::State::initial_synced = $message->{SYNCED}[1];
 115         local $SrSv::IRCd::State::queue_depth = $message->{QUEUE_DEPTH};
 116
 117         print "IRCLINE is $ircline  synced is $SrSv::IRCd::State::synced  initial_synced is $SrSv::IRCd::State::initial_synced\n" if DEBUG();
 118
 119         &{$callback->{REALCALL}}(@{$message->{ARGS}});
 120         ircd::flushmodes() unless $message->{SYNC}; # FIXME
 121         print "Finished with $ircline\n" if DEBUG();
 122 }
 123
 124 1;