branches/erry-devel/SrSv/IRCd/Queue.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::Queue;
  18
  19 # The purpose of this module is to make sure lines get processed in an
  20 # order that makes sense, e.g., a JOIN should not be processed before
  21 # the corresponding NICKCONN has been.
  22
  23 # FIXME: This may not be well optimized. It also can be fouled up by
  24 # conflicting messages with the same WF value, such as the same nick
  25 # disconnecting and connecting at once.
  26
  27 use strict;
  28
  29 use Exporter 'import';
  30 BEGIN { our @EXPORT_OK = qw(ircd_enqueue queue_size) }
  31
  32 use SrSv::Debug;
  33 use SrSv::Message qw(message);
  34
  35 our @queue = map [], 0..3; # 3 is the maximum WF value
  36
  37 sub ircd_enqueue($) {
  38         my ($message) = @_;
  39         my ($ircline, $wf) = @$message{'IRCLINE', 'WF'};
  40
  41         if($wf == 0) {
  42                 message($message);
  43                 return;
  44         }
  45
  46         push @{$queue[$wf]}, $message;
  47
  48         if(_is_runnable($message)) {
  49                 print "$message->{IRCLINE} is runnable immediately. (WF=$message->{WF})\n" if DEBUG;
  50                 message($message);
  51                 $message->{_Q_RUNNING} = 1;
  52         }
  53 }
  54
  55 sub queue_size() {
  56         my $r;
  57         foreach (@queue) { $r += @$_ }
  58         return $r;
  59 }
  60
  61 sub finished {
  62         my ($message) = @_;
  63         my ($ircline, $wf) = @$message{'IRCLINE', 'WF'};
  64
  65         print "Called finished() for $ircline\n" if DEBUG();
  66
  67         for(my $i; $i < @{$queue[$wf]}; $i++) {
  68                 if($queue[$wf][$i]{IRCLINE} == $ircline) {
  69                         splice(@{$queue[$wf]}, $i, 1);
  70                         last;
  71                 }
  72         }
  73
  74         if($message->{TYPE} eq 'SEOS') {
  75                 $message->{TYPE} = 'POSTSEOS';
  76                 message($message);
  77         }
  78
  79         _dequeue();
  80 }
  81
  82 sub _is_runnable($) {
  83         my ($message) = @_;
  84         my ($ircline, $wf) = @$message{'IRCLINE', 'WF'};
  85
  86         for(1..($wf-1)) {
  87                 if(defined($queue[$_][0]) and $queue[$_][0]{IRCLINE} < $ircline) {
  88                         print "Line $ircline must wait for $queue[$_][0]{IRCLINE}\n" if DEBUG;
  89                         return 0;
  90                 }
  91         }
  92
  93         return 1;
  94 }
  95
  96 sub _dequeue {
  97         foreach my $q (@queue) {
  98                 INNER: foreach my $message (@$q) {
  99                         next INNER if $message->{_Q_RUNNING};
 100
 101                         if(_is_runnable($message)) {
 102                                 print "$message->{IRCLINE} is now runnable\n" if DEBUG;
 103
 104                                 message($message);
 105                                 $message->{_Q_RUNNING} = 1;
 106                         }
 107                         else {
 108                                 last INNER;
 109                         }
 110                 }
 111         }
 112 }
 113
 114 1;