#!/bin/perl -w
# $Id: plum 85 2003-03-27 13:15:34Z tach $
# copyright (c)1997-1999 Yoshinori Hasegawa <hasegawa@madoka.org>

package plum;

$NAME = 'plum';
$VERSION = '2.33';

$NIL = $;;
$NOTRAILING = &'list('004', '215', '221', '324', '341', '367', 'mode');

$ALIAS = '*.jp';

$TIMEOUT = 120;
$READSIZE = 1024;
$IRCPORT = 6667;

$SOCKADDR = 'S n N x8';

$PROTO = (getprotobyname('tcp'))[2];

if ($] < 5) {
  foreach $inc (@INC) {
    if (-r "$inc/sys/socket.ph") {
      eval 'require "sys/socket.ph"';
      $SOCKET = "$inc/sys/socket.ph" unless $@;
      last;
    }
    if (-r "$inc/socket.ph") {
      eval 'require "socket.ph"';
      $SOCKET = "$inc/socket.ph" unless $@;
      last;
    }
  }
} else {
  eval 'use Socket';
  $SOCKET = 'Socket.pm' unless $@;
}
$SOCKET = '' unless $SOCKET;

$AF_INET = eval '&AF_INET' || 2;
$PF_INET = eval '&PF_INET' || 2;
$SOCK_STREAM = eval '&SOCK_STREAM' || 1;
$SOMAXCONN = eval '&SOMAXCONN' || 16;
$INADDR_ANY = eval '&INADDR_ANY' || "\0\0\0\0";
$SOL_SOCKET = eval '&SOL_SOCKET';
$SO_REUSEADDR = eval '&SO_REUSEADDR';

$KANJI = &'add($KANJI, 'euc') if "\241\241\242\242" !~ /\241\242/;
$KANJI = &'add($KANJI, 'sjis') if "\201\201\202\202" !~ /\201\202/;

$SIG{'HUP'} = 'IGNORE' if &'exist(&'list(keys(%SIG)), 'HUP');
$SIG{'PIPE'} = 'IGNORE' if &'exist(&'list(keys(%SIG)), 'PIPE');

if ($0 =~ /^(.*)[\\\/][^\\\/]*$/) {
  unshift(@INC, "$1/module");
} else {
  unshift(@INC, './module');
}

select((select(STDOUT), $| = 1)[0]);
select((select(STDERR), $| = 1)[0]);

$'rin = '';
$'win = '';
$'rout = '';
$'wout = '';

$'kanjilist = $KANJI;
$'kanjilist = '' unless $'kanjilist;

$handle = 0;

srand();

&'load('', "$NAME.conf") if -r "$NAME.conf";
foreach $user (@ARGV) {
  &'load($user, "$NAME-$user.conf") if -r "$NAME-$user.conf";
}

exit unless @'username;

print $NAME, ' ', $VERSION, "\n";

&main;

sub main {
  local($access, $i, $time, $nfound, $timeleft);
  $access = '';
  for (;;) {
    for ($i = 0; $i < @'username; $i++) {
      &open_event($i, 'main_loop', $i);
    }
    foreach $cno (&'array($'clientlist)) {
      &c_read($cno) if vec($'rout, $cno, 1);
      &c_write($cno) if vec($'wout, $cno, 1);
    }
    foreach $sno (&'array($'serverlist)) {
      &s_read($sno) if vec($'rout, $sno, 1);
      &s_write($sno) if vec($'wout, $sno, 1);
    }
    foreach $lno (&'array($'listenlist)) {
      &c_accept($lno) if vec($'rout, $lno, 1);
    }
    $time = time();
    for ($i = 0; $i < length($access) * 8; $i++) {
      $'access[$i] = $time if vec($access, $i, 1);
    }
    ($nfound, $timeleft) = select($'rout = $'rin, $'wout = $'win, undef, $TIMEOUT);
    $access = $'rout;
  }
}

sub c_read {
  local($clientno) = @_;
  local($next, $rest, $tmp);
  $tmp = '';
  if (sysread($'socket[$clientno], $tmp, $READSIZE)) {
    $rbuf[$clientno] .= $tmp;
    while ((($next, $rest) = split(/[\r\n]+/, $rbuf[$clientno], 2)) == 2) {
      $rbuf[$clientno] = $rest;
      next unless $next;
      if ($'avail[$clientno]) {
        $next = &read_event($'userno[$clientno], 'client_read', $clientno, $next);
        next unless $next;
      }
      &c_scan($clientno, $next);
    }
  } else {
    &'c_close($clientno);
  }
}

sub c_scan {
  local($clientno, $line) = @_;
  local($prefix, $cmd, @params, $sub);
  ($prefix, $cmd, @params) = &'parse($line);
  if ($'avail[$clientno]) {
    ($prefix, $cmd, @params) = &scan_event($'userno[$clientno], "cs_\L$cmd\E", $clientno, $prefix, $cmd, @params);
    return unless $cmd;
    return unless $'server[$clientno];
    &'s_print($'server[$clientno], $prefix, $cmd, @params);
  } else {
    $sub = "cn_\L$cmd\E";
    &$sub($clientno, $prefix, $cmd, @params) if defined(&$sub);
  }
}

sub 'c_print {
  local($clientno, $prefix, $cmd, @params) = @_;
  if ($'avail[$clientno]) {
    ($prefix, $cmd, @params) = &print_event($'userno[$clientno], "cp_\L$cmd\E", $clientno, $prefix, $cmd, @params);
    return unless $cmd;
  }
  $wbuf{$clientno} = '' unless defined($wbuf{$clientno});
  $wbuf{$clientno} .= &'build($prefix, $cmd, @params) . $NIL;
  vec($'win, $clientno, 1) = 1;
}

sub c_write {
  local($clientno) = @_;
  local($socket, $next, $rest);
  $socket = $'socket[$clientno];
  while ($wbuf{$clientno}) {
    ($next, $rest) = split(/$NIL/, $wbuf{$clientno}, 2);
    $wbuf{$clientno} = $rest || '';
    next unless $next;
    if ($'avail[$clientno]) {
      $next = &write_event($'userno[$clientno], 'client_write', $clientno, $next);
      next unless $next;
    }
    print $socket $next, "\r\n" if fileno($socket);
  }
  vec($'win, $clientno, 1) = 0;
}

sub 'c_flush {
  local($clientno) = @_;
  while (vec($'win, $clientno, 1)) {
    &c_write($clientno);
  }
}

sub s_read {
  local($serverno) = @_;
  local($next, $rest, $tmp);
  $tmp = '';
  if (sysread($'socket[$serverno], $tmp, $READSIZE)) {
    $rbuf[$serverno] .= $tmp;
    while ((($next, $rest) = split(/[\r\n]+/, $rbuf[$serverno], 2)) == 2) {
      $rbuf[$serverno] = $rest;
      next unless $next;
      if ($'avail[$serverno]) {
        $next = &read_event($'userno[$serverno], 'server_read', $serverno, $next);
        next unless $next;
      }
      &s_scan($serverno, $next);
    }
  } else {
    &'s_close($serverno);
  }
}

sub s_scan {
  local($serverno, $line) = @_;
  local($prefix, $cmd, @params, $sub);
  ($prefix, $cmd, @params) = &'parse($line);
  if ($'avail[$serverno]) {
    ($prefix, $cmd, @params) = &scan_event($'userno[$serverno], "ss_\L$cmd\E", $serverno, $prefix, $cmd, @params);
    return unless $cmd;
    foreach $cno (&'array($'clientlist)) {
      next unless $'avail[$cno];
      next unless $'server[$cno] == $serverno;
      &'c_print($cno, $prefix, $cmd, @params);
    }
  } else {
    $sub = "sn_\L$cmd\E";
    &$sub($serverno, $prefix, $cmd, @params) if defined(&$sub);
  }
}

sub 's_print {
  local($serverno, $prefix, $cmd, @params) = @_;
  local($key);
  if ($'avail[$serverno]) {
    ($prefix, $cmd, @params) = &print_event($'userno[$serverno], "sp_\L$cmd\E", $serverno, $prefix, $cmd, @params);
    return unless $cmd;
  }
  $key = "$serverno$;\L$cmd\E";
  $wbuf{$key} = '' unless defined($wbuf{$key});
  $wbuf{$key} .= &'build($prefix, $cmd, @params) . $NIL;
  $sequence[$serverno] = &'add($sequence[$serverno], "\L$cmd\E");
  vec($'win, $serverno, 1) = 1;
}

sub s_write {
  local($serverno) = @_;
  local($socket, $next, $rest, $time, @array, $cmd);
  $socket = $'socket[$serverno];
  $time = time();
  $timer[$serverno] = $time if ($timer[$serverno] || 0) < $time;
  @array = &'array($sequence[$serverno]);
  while (@array) {
    if ($timer[$serverno] > $time + 10) {
      $sequence[$serverno] = &'list(@array);
      return;
    } else {
      $cmd = shift(@array);
      ($next, $rest) = split(/$NIL/, $wbuf{$serverno, $cmd}, 2);
      $wbuf{$serverno, $cmd} = $rest || '';
      push(@array, $cmd) if $rest;
      next unless $next;
      if ($'avail[$serverno]) {
        $next = &write_event($'userno[$serverno], 'server_write', $serverno, $next);
        next unless $next;
      }
      print $socket $next, "\r\n" if fileno($socket);
      $timer[$serverno] += 2;
    }
  }
  $sequence[$serverno] = '';
  vec($'win, $serverno, 1) = 0;
}  

sub 's_flush {
  local($serverno) = @_;
  while (vec($'win, $serverno, 1)) {
    &s_write($serverno);
  }
}

sub 'parse {
  local($line) = @_;
  local($arg, $rest, @params);
  @params = ();
  $line =~ s/^\s*//;
  if ($line =~ /^\:(.*)$/) {
    ($arg, $rest) = (split(/\s+/, $1, 2), '');
  } else {
    ($arg, $rest) = ('', $line);
  }
  while ($line) {
    push(@params, $arg);
    if ($rest =~ /^\:(.*)$/) {
      push(@params, $1);
      last;
    }
    $line = $rest;
    ($arg, $rest) = (split(/\s+/, $line, 2), '');
  }
  return @params;
}

sub 'build {
  local($prefix, $cmd, @params) = @_;
  local($trailing);
  return '' unless $cmd;
  if (@params) {
    $trailing = pop(@params) || '';
    if (&'exist($NOTRAILING, "\L$cmd\E")) {
      push(@params, $trailing . ' ');
    } else {
      push(@params, ':' . $trailing);
    }
  } else {
    @params = ();
  }
  unshift(@params, $cmd);
  unshift(@params, ':' . $prefix) if $prefix;
  return join(' ', @params);
}

sub 'user {
  local($no) = @_;
  local($userno, $host);
  $userno = $'userno[$no];
  if (defined($userno) && $address[$userno]) {
    return "$'nick[$no]\!$address[$userno]";
  } elsif ($no && $'socket[$no] && fileno($'socket[$no])) {
    $host = (&'peername($no))[2] || join('.', unpack('C4', pack('N', (&'peername($no))[1])));
  } else {
    $host = 'unknown';
  }
  return "$'nick[$no]!$'user[$no]\@$host";
}

sub 'prefix {
  local($prefix) = @_;
  local($idx, $rest, $nick, $user, $host);
  if (wantarray) {
    if (($idx = index($prefix, '@')) != -1) {
      $host = substr($prefix, $idx + 1);
      $rest = substr($prefix, 0, $idx);
    } else {
      $host = '';
      $rest = $prefix;
    }
    if (($idx = index($rest, '!')) != -1) {
      $nick = substr($rest, 0, $idx);
      $user = substr($rest, $idx + 1);
    } else {
      $nick = $rest;
      $user = '';
    }
    return ($nick, $user, $host);
  } else {
    if (($idx = index($prefix, '!')) != -1) {
      return substr($prefix, 0, $idx);
    } else {
      return $prefix;
    }
  }
}

sub 'regex {
  local($mask) = @_;
  $mask =~ s/(\W)/\\$1/g;
  $mask =~ s/\\\?/\./g;
  $mask =~ s/\\\*/\.\*/g;
  return "\^$mask\$";
}

sub 'load {
  local($user, $file) = @_;
  local($userno, $newlist, $no, $var, $line, $name, $arg, @key, $label, $sub, $oldlist);
  @'username = () unless @'username;
  open(FILE, $file) || return;
  if (!&'exist(&'list(@'username), $user)) {
    push(@'username, $user);
  }
  for ($userno = 0; $userno < @'username; $userno++) {
    last if $user eq $'username[$userno];
  }
  foreach $key (keys(%property)) {
    ($no, $var) = split(/$;/, $key, 2);
    next unless $no == $userno;
    delete $property{$key};
  }
  $'filename[$userno] = $file;
  $newlist = &'list('plum');
  while (defined($line = <FILE>)) {
    $line =~ s/^\s+//;
    next if $line =~ /^[\#\;]/;
    $line =~ tr/\r\n//d;
    next unless $line;
    $line =~ s/\s+$//;
    if ($line =~ /^\+\s*(\S+)\s+(\S+)/) {
      $name = $1;
      $label = $2;
      &'import($userno, $name);
      $newlist = &'add($newlist, $'package{$name});
      $'labellist{$userno, $'package{$name}} = &'list(split(/\,/, $label));
    } elsif ($line =~ /^\+\s*(\S+)/) {
      $name = $1;
      &'import($userno, $name);
      $newlist = &'add($newlist, $'package{$name});
      $'labellist{$userno, $'package{$name}} = '';
    } elsif ($line =~ /^\-\s*(\S+)/) {
      $name = $1;
      if ($'package{$name}) {
        $newlist = &'remove($newlist, $'package{$name});
        $'labellist{$userno, $'package{$name}} = '';
      }
    } elsif ($line =~ /^\=\s*(\S+)/) {
      $name = $1;
      &'import($userno, $name);
      if (&'exist($'modulelist[$userno], $'package{$name})) {
        $newlist = &'add($newlist, $'package{$name});
      }
    } elsif ((($var, $arg) = split(/\s*\:\s*/, $line, 2)) == 2) {
      $arg = &kanji_jis($userno, $arg);
      @key = split(/\./, $var);
      $property{$userno, @key} = &'add($property{$userno, @key}, $arg);
    }
  }
  close(FILE);
  foreach $module (&'array($newlist)) {
    if (!&'exist($'modulelist[$userno], $module)) {
      $sub = $module . '\'module_enable';
      &$sub($userno) if defined(&$sub);
    }
  }
  $oldlist = $'modulelist[$userno];
  $'modulelist[$userno] = $newlist;
  foreach $module (&'array($oldlist)) {
    if (!&'exist($'modulelist[$userno], $module)) {
      $sub = $module . '\'module_disable';
      &$sub($userno) if defined(&$sub);
    }
  }
}

sub kanji_jis {
  local($userno, $line) = @_;
  local($code);
  $code = '';
  foreach $kanji (&'property($userno, 'kanji')) {
    $code = &'add($code, split(/\,/, "\L$kanji\E"));
  }
  foreach $code (&'array($code)) {
    if ($code eq 'euc') {
      $line = &'euc_jis($line);
    } elsif ($code eq 'jis') {
      $line = &'jis_jis($line);
    } elsif ($code eq 'sjis') {
      $line = &'sjis_jis($line);
    }
  }
  return $line;
}

sub 'import {
  local($userno, $name) = @_;
  local($file, $pkg);
  foreach $dir (&'property($userno, 'directory'), @INC) {
    $file = &'expand("$dir/$name");
    next unless -f $file;
    $_ = $'package{$name} || 'plum';
    require $file;
    $pkg = $_;
    $'package{$name} = $pkg;
    $'directory{$pkg} = $dir;
    $'filename{$pkg} = $name;
    return;
  }
  $file = &'expand($name);
  $_ = $'package{$name} || 'plum';
  require $file;
  $pkg = $_;
  $'package{$name} = $pkg;
  $'directory{$pkg} = '';
  $'filename{$pkg} = $name;
}

sub 'property {
  local($userno, $name) = @_;
  local(@pkg, $list);
  @pkg = split(/\_/, (caller())[0]);
  if ($label) {
    $list = $property{$userno, @pkg, $label, $name} || $property{$userno, @pkg, $name};
  } else {
    $list = $property{$userno, @pkg, $name};
  }
  if (defined($list)) {
    if (wantarray) {
      return &'array($list);
    } else {
      return (&'array($list))[0];
    }
  } else {
    if (wantarray) {
      return ();
    } else {
      return undef;
    }
  }
}

sub 'expand {
  local($name) = @_;
  local($user, $rest, $home);
  if ($name =~ /^\~([^\/]*)\/(.*)$/) {
    ($user, $rest) = ($1, $2);
    if ($user) {
      $home = eval '(getpwnam($user))[7]' || '.';
    } else {
      $home = $ENV{'HOME'} || eval '(getpwuid($<))[7]' || '.';
    }
    return "$home/$rest";
  } else {
    return $name;
  }
}

sub 'timelocal {
  local(@local) = @_;
  local($now, @base, $year, $day, $time);
  $now = time();
  @base = localtime($now);
  $day = ($local[5] - $base[5]) * 365;
  $year = $local[5] + 1900;
  $day += int($year / 4) - int($year / 100) + int($year / 400) + &days($local[3], $local[4], $local[5]);
  $year = $base[5] + 1900;
  $day -= int($year / 4) - int($year / 100) + int($year / 400) + &days($base[3], $base[4], $base[5]);
  $time = $now + $day * 86400 + ($local[2] - $base[2]) * 3600 + ($local[1] - $base[1]) * 60 + $local[0] - $base[0];
  return $time;
}

sub days {
  local(@time) = @_;
  local($day, $year);
  $day = (0, 31, 59, 90, 120, 151, 181, 212, 243, 273, 304, 334)[$time[1]];
  $day += $time[0] - 1;
  $year = $time[2] + 1900;
  if ($time[1] < 2 && $year % 4 == 0 && ($year % 100 != 0 || $year % 400 == 0)) {
    $day -= 1;
  }
  return $day;
}

sub 'date {
  local($format, $time) = @_;
  local(@time, $char, $str, $i, $number);
  $time = time() unless $time;
  @time = localtime($time);
  $str = '';
  for ($i = 0; $i < length($format); $i++) {
    $char = substr($format, $i, 1);
    if ($char eq '%') {
      $i++;
      if ($i < length($format)) {
        $char = substr($format, $i, 1);
        if ($char eq '+' || $char eq '-') {
          $i++;
          $number = $char;
          while ($i < length($format)) {
            $char = substr($format, $i, 1);
            last if index('0123456789.', $char) == -1;
            $number .= $char;
            $i++;
          }
        } else {
          $number = 0;
        }
        if ($char eq '%') {
          $str .= $char;
        } elsif ($char eq 'a') {
          $str .= ('Sun', 'Mon', 'Tue', 'Wed', 'Thu', 'Fri', 'Sat')[$time[6]];
        } elsif ($char eq 'b') {
          $str .= ('Jan', 'Feb', 'Mar', 'Apr', 'May', 'Jun', 'Jul', 'Aug', 'Sep', 'Oct', 'Nov', 'Dec')[$time[4]];
        } elsif ($char eq 'd') {
          $str .= sprintf('%02d', $time[3]);
        } elsif ($char eq 'H') {
          $str .= sprintf('%02d', $time[2]);
        } elsif ($char eq 'I') {
          $str .= sprintf('%02d', $time[2] % 12 + 1);
        } elsif ($char eq 'j') {
          $str .= sprintf('%3d', $time[7]);
        } elsif ($char eq 'k') {
          $str .= sprintf('%2d', $time[2]);
        } elsif ($char eq 'l') {
          $str .= sprintf('%2d', $time[2] % 12 + 1);
        } elsif ($char eq 'M') {
          $str .= sprintf('%02d', $time[1]);
        } elsif ($char eq 'm') {
          $str .= sprintf('%02d', $time[4] + 1);
        } elsif ($char eq 'O') {
          @time = localtime($time + $number * 3600);
        } elsif ($char eq 'o') {
          @time = localtime($time + $number);
        } elsif ($char eq 'p') {
          if ($time[2] < 12) {
            $str .= 'AM';
          } else {
            $str .= 'PM';
          }
        } elsif ($char eq 'S') {
          $str .= sprintf('%02d', $time[0]);
        } elsif ($char eq 'w') {
          $str .= sprintf('%d', $time[6]);
        } elsif ($char eq 'Y') {
          $str .= sprintf('%d', $time[5] + 1900);
        } elsif ($char eq 'y') {
          $str .= sprintf('%02d', $time[5] % 100);
        }
      } else {
        $str .= $char;
      }
    } else {
      $str .= $char;
    }
  }
  return $str;
}

sub 'format {
  local($text, %data) = @_;
  local($ret, $idx, $end, $ret, $str);
  $ret = '';
  while (($idx = index($text, '#(')) != -1) {
    $end = index($text, ')', $idx + 2);
    last if $end == -1;
    $ret .= substr($text, 0, $idx);
    foreach $item (split(/\|/, substr($text, $idx + 2, $end - $idx - 2))) {
      $str = &replace($item, %data);
      next unless defined($str);
      $ret .= $str;
      last;
    }
    $text = substr($text, $end + 1);
  }
  $ret .= $text;
  return $ret;
}

sub replace {
  local($item, %data) = @_;
  local($list, $text, @data);
  ($list, $text) = split(/\;/, $item, 2);
  if ($list) {
    foreach $key (split(/\,/, $list)) {
      if (!defined($data{$key})) {
        return undef;
      }
      push(@data, $data{$key});
    }
    if ($text) {
      return sprintf($text, @data);
    } else {
      return join('', @data);
    }
  } else {
    return $text;
  }
}

sub 'real {
  local($name) = @_;
  if ($name =~ /^\%(.*)$/) {
    return "\#$1\:$ALIAS";
  } else {
    return $name;
  }
}

sub 'alias {
  local($name) = @_;
  if ($name =~ /^\#(.*)\:(.*)$/ && "\L$2\E" eq "\L$ALIAS\E") {
    return '%' . $1;
  } else {
    return $name;
  }
}

sub 'channel {
  local($name) = @_;
  if ($name && $name =~ /^[\#\&\+\!]/) {
    return 1;
  } else {
    return 0;
  }
}

sub 'add {
  local($list, @items) = @_;
  $list = '' unless $list;
  foreach $item (@items) {
    next if &'exist($list, $item);
    $list .= $NIL . $item;
  }
  return $list;
}

sub 'remove {
  local($list, @items) = @_;
  local($idx);
  $list = '' unless $list;
  $list .= $NIL;
  foreach $item (@items) {
    $idx = index("\L$list\E", "$NIL\L$item\E$NIL");
    next if $idx == -1;
    substr($list, $idx, length("$NIL$item$NIL")) = $NIL;
  }
  return substr($list, 0, length($list) - 1);
}

sub 'change {
  local($list, @items) = @_;
  local($old, $new, $idx);
  return '' unless $list;
  $list .= $NIL;
  while (@items > 1) {
    $old = shift(@items);
    $new = shift(@items);
    $idx = index("\L$list\E", "$NIL\L$old\E$NIL");
    next if $idx == -1;
    substr($list, $idx, length("$NIL$old$NIL")) = "$NIL$new$NIL";
  }
  return substr($list, 0, length($list) - 1);
}

sub 'exist {
  local($list, @items) = @_;
  return 0 unless $list;
  $list .= $NIL;
  foreach $item (@items) {
    return 1 if index("\L$list\E", "$NIL\L$item\E$NIL") != -1;
  }
  return 0;
}

sub 'list {
  local(@array) = @_;
  return join($NIL, '', @array);
}

sub 'array {
  local($list) = @_;
  return () unless $list;
  $list = substr($list, 1);
  return split(/$NIL/, $list, -1);
}

sub 'euc_euc {
  local($euc) = @_;
  return $euc;
}

sub 'euc_jis {
  local($euc) = @_;
  local($jis, $kanji, $c, $n, $i);
  $kanji = 0;
  $jis = '';
  $euc = &'euc_euc($euc);
  for ($i = 0; $i < length($euc); $i++) {
    $c = substr($euc, $i, 1);
    $n = ord($c);
    if ($n >= 0241) {
      if ($kanji != 1) {
        $jis .= "\e\$B";
        $kanji = 1;
      }
      $jis .= pack('C', $n & 0177);
      $i++;
      $jis .= pack('C', ord(substr($euc, $i, 1)) & 0177);
    } elsif ($n == 0216) {
      if ($kanji != 2) {
        $jis .= "\e(I";
        $kanji = 2;
      }
      $i++;
      $jis .= pack('C', ord(substr($euc, $i, 1)) & 0177);
    } elsif ($n == 0217) {
      if ($kanji != 3) {
        $jis .= "\e\$(D";
        $kanji = 3;
      }
      $i++;
      $jis .= pack('C', ord(substr($euc, $i, 1)) & 0177);
      $i++;
      $jis .= pack('C', ord(substr($euc, $i, 1)) & 0177);
    } else {
      if ($kanji) {
        $jis .= "\e\(B";
        $kanji = 0;
      }
      $jis .= $c;
    }
  }
  $jis .= "\e\(B" if $kanji;
  return $jis;
}

sub 'euc_sjis {
  local($euc) = @_;
  local($sjis, $c, $n1, $n2, $i);
  $sjis = '';
  $euc = &'euc_euc($euc);
  for ($i = 0; $i < length($euc); $i++) {
    $c = substr($euc, $i, 1);
    $n1 = ord($c);
    if ($n1 >= 0241) {
      $i++;
      $n2 = ord(substr($euc, $i, 1));
      if (($n1 & 01) == 0) {
        $n2 -= 03;
      } else {
        $n2 -= 0141;
      }
      $n2++ if $n2 >= 0177;
      $n1 = ((($n1 - 0241) >> 1) + 0241) ^ 040;
      $sjis .= pack('CC', $n1, $n2);
    } elsif ($n1 == 0216) {
      $i++;
      $sjis .= substr($euc, $i, 1);
    } elsif ($n1 == 0217) {
      $i += 2;
      $sjis .= "\201\254";
    } else {
      $sjis .= $c;
    }
  }
  return $sjis;
}

sub 'jis_euc {
  local($jis) = @_;
  local($euc, $kanji, $i);
  $kanji = 0;
  $euc = '';
  $jis = &'jis_jis($jis);
  for ($i = 0; $i < length($jis); $i++) {
    if (substr($jis, $i, 3) eq "\e\(B") {
      $kanji = 0;
      $i += 2;
      next;
    } elsif (substr($jis, $i, 3) eq "\e\$B") {
      $kanji = 1;
      $i += 2;
      next;
    } elsif (substr($jis, $i, 3) eq "\e\(I") {
      $kanji = 2;
      $i += 2;
      next;
    } elsif (substr($jis, $i, 4) eq "\e\$(D") {
      $kanji = 3;
      $i += 3;
      next;
    }
    if ($kanji == 0) {
      $euc .= substr($jis, $i, 1);
    } elsif ($kanji == 1) {
      $euc .= pack('C', ord(substr($jis, $i, 1)) | 0200);
      $i++;
      $euc .= pack('C', ord(substr($jis, $i, 1)) | 0200);
    } elsif ($kanji == 2) {
      $euc .= "\216" . pack('C', ord(substr($jis, $i, 1)) | 0200);
    } elsif ($kanji == 3) {
      $euc .= "\217" . pack('C', ord(substr($jis, $i, 1)) | 0200);
      $i++;
      $euc .= pack('C', ord(substr($jis, $i, 1)) | 0200);
    }
  }
  return $euc;
}

sub 'jis_jis {
  local($jis) = @_;
  local($ret, $kanji, $last, $seq, $c, $i);
  $kanji = 0;
  $last = 0;
  $ret = '';
  for ($i = 0; $i < length($jis); $i++) {
    $c = substr($jis, $i, 1);
    $seq = substr($jis, $i, 3);
    if ($seq eq "\e\$\@" || $seq eq "\e\$B") {
      $ret .= "\e\$B";
      $kanji = 1;
      $i += 2;
      next;
    } elsif ($seq eq "\e(J" || $seq eq "\e(B") {
      $ret .= "\e(B";
      $kanji = 0;
      $i += 2;
      next;
    } elsif ($seq eq "\e(I") {
      $ret .= "\e(I";
      $kanji = 2;
      $i += 2;
      next;
    } elsif ($c eq "\cN") {
      if ($kanji != 2) {
        $last = $kanji;
        $ret .= "\e(I";
        $kanji = 2;
      }
      next;
    } elsif ($c eq "\cO") {
      if ($kanji != 2) {
        if ($last) {
          $ret .= "\e\$B";
        } else {
          $ret .= "\e(B";
        }
        $kanji = $last;
      }
      next;
    } elsif (substr($jis, $i, 6) eq "\e&\@\e\$B") {
      $ret .= "\e\$B";
      $kanji = 1;
      $i += 5;
      next;
    } elsif (substr($jis, $i, 4) eq "\e\$(D") {
      $ret .= "\e\$(D";
      $kanji = 3;
      $i += 3;
      next;
    }
    if ($kanji == 0) {
      $ret .= $c;
    } elsif ($kanji == 1) {
      $ret .= substr($jis, $i, 2);
      $i++;
    } elsif ($kanji == 2) {
      $ret .= $c;
    } elsif ($kanji == 3) {
      $ret .= substr($jis, $i, 2);
      $i++;
    }
  }
  $ret .= "\e(B" if $kanji;
  return $ret;
}

sub 'jis_sjis {
  local($jis) = @_;
  local($sjis, $kanji, $n1, $n2, $i);
  $kanji = 0;
  $sjis = '';
  $jis = &'jis_jis($jis);
  for ($i = 0; $i < length($jis); $i++) {
    if (substr($jis, $i, 3) eq "\e\(B") {
      $kanji = 0;
      $i += 2;
      next;
    } elsif (substr($jis, $i, 3) eq "\e\$B") {
      $kanji = 1;
      $i += 2;
      next;
    } elsif (substr($jis, $i, 3) eq "\e\(I") {
      $kanji = 2;
      $i += 2;
      next;
    } elsif (substr($jis, $i, 4) eq "\e\$(D") {
      $kanji = 3;
      $i += 3;
      next;
    }
    if ($kanji == 0) {
      $sjis .= substr($jis, $i, 1);
    } elsif ($kanji == 1) {
      $n1 = ord(substr($jis, $i, 1));
      $i++;
      $n2 = ord(substr($jis, $i, 1));
      if (($n1 & 01) == 0) {
        $n2 += 0175;
      } else {
        $n2 += 037;
      }
      $n2++ if $n2 >= 0177;
      $n1 = ((($n1 - 041) >> 1) + 0241) ^ 040;
      $sjis .= pack('CC', $n1, $n2);
    } elsif ($kanji == 2) {
      $sjis .= pack('C', ord(substr($jis, $i, 1)) | 0200);
    } elsif ($kanji == 3) {
      $i++;
      $sjis .= "\201\254";
    }
  }
  return $sjis;
}

sub 'sjis_euc {
  local($sjis) = @_;
  local($euc, $c, $n1, $n2, $i);
  $euc = '';
  $sjis = &'sjis_sjis($sjis);
  for ($i = 0; $i < length($sjis); $i++) {
    $c = substr($sjis, $i, 1);
    $n1 = ord($c);
    if ($n1 >= 0240 && $n1 <= 0337) {
      $euc .= "\216$c";
    } elsif ($n1 >= 0201) {
      $i++;
      $n2 = ord(substr($sjis, $i, 1));
      $n2-- if $n2 > 0177;
      if ($n2 >= 0236) {
        $n1 = ((($n1 ^ 040) - 0241) << 1) + 0242;
        $n2 += 03;
      } else {
        $n1 = ((($n1 ^ 040) - 0241) << 1) + 0241;
        $n2 += 0141;
      }
      $euc .= pack('CC', $n1, $n2);
    } else {
      $euc .= $c;
    }
  }
  return $euc;
}

sub 'sjis_jis {
  local($sjis) = @_;
  local($jis, $kanji, $c, $n1, $n2, $i);
  $kanji = 0;
  $jis = '';
  $sjis = &'sjis_sjis($sjis);
  for ($i = 0; $i < length($sjis); $i++) {
    $c = substr($sjis, $i, 1);
    $n1 = ord($c);
    if ($n1 >= 0240 && $n1 <= 0337) {
      if ($kanji != 2) {
        $jis .= "\e(I";
        $kanji = 2;
      }
      $jis .= pack('C', $n1 & 0177);
    } elsif ($n1 >= 0201) {
      if ($kanji != 1) {
        $jis .= "\e\$B";
        $kanji = 1;
      }
      $i++;
      $n2 = ord(substr($sjis, $i, 1));
      $n2-- if $n2 > 0177;
      if ($n2 >= 0236) {
        $n1 = ((($n1 ^ 040) - 0241) << 1) + 042;
        $n2 -= 0175;
      } else {
        $n1 = ((($n1 ^ 040) - 0241) << 1) + 041;
        $n2 -= 037;
      }
      $jis .= pack('CC', $n1, $n2);
    } else {
      if ($kanji) {
        $jis .= "\e\(B";
        $kanji = 0;
      }
      $jis .= $c;
    }
  }
  $jis .= "\e\(B" if $kanji;
  return $jis;
}

sub 'sjis_sjis {
  local($sjis) = @_;
  return $sjis;
}

sub 'connect {
  local($host, $port) = @_;
  local($serverno, $socket, $ip, @addr, $name);
  if ($host =~ /^\d+$/) {
    $ip = $host;
  } elsif ($host =~ /^[\d\.]+$/) {
    @addr = split(/\./, $host);
    $ip = unpack('N', pack('C4', @addr, 0, 0, 0));
  } else {
    $ip = unpack('N', (gethostbyname($host))[4] || "\0\0\0\0");
  }
  return 0 unless $ip;
  $socket = '\'S' . ++$handle;
  socket($socket, $PF_INET, $SOCK_STREAM, $PROTO) || return 0;
  $name = pack($SOCKADDR, $AF_INET, $port, $ip);
  connect($socket, $name) || return 0;
  binmode($socket);
  $serverno = fileno($socket);
  vec($'rin, $serverno, 1) = 1;
  $'socket[$serverno] = $socket;
  select((select($socket), $| = 1)[0]);
  $'access[$serverno] = time();
  return $serverno;
}

sub 'listen {
  local($port, $count) = @_;
  local($listenno, $socket, $name);
  $socket = '\'L' . ++$handle;
  socket($socket, $PF_INET, $SOCK_STREAM, $PROTO) || return 0;
  if (defined($SOL_SOCKET) && defined($SO_REUSEADDR)) {
    setsockopt($socket, $SOL_SOCKET, $SO_REUSEADDR, pack('l', 1));
  }
  $name = pack($SOCKADDR, $AF_INET, $port, unpack('N', $INADDR_ANY));
  if (!bind($socket, $name)) {
    close($socket);
    return 0;
  }
  listen($socket, $count || $SOMAXCONN) || return 0;
  $listenno = fileno($socket);
  vec($'rin, $listenno, 1) = 1;
  $'socket[$listenno] = $socket;
  select((select($socket), $| = 1)[0]);
  $'access[$listenno] = time();
  return $listenno;
}

sub 'accept {
  local($listenno) = @_;
  local($clientno, $socket);
  $socket = '\'C' . ++$handle;
  accept($socket, $'socket[$listenno]) || return 0;
  binmode($socket);
  $clientno = fileno($socket);
  vec($'rin, $clientno, 1) = 1;
  $'socket[$clientno] = $socket;
  select((select($socket), $| = 1)[0]);
  $'access[$clientno] = time();
  return $clientno;
}

sub 'close {
  local($no) = @_;
  close($'socket[$no]);
  vec($'rin, $no, 1) = 0;
}

sub 'sockname {
  local($no) = @_;
  local($port, $ip, $host);
  ($port, $ip) = (unpack($SOCKADDR, getsockname($'socket[$no])))[1, 2];
  $host = (gethostbyaddr(pack('N', $ip), $AF_INET))[0];
  return ($port, $ip, $host);
}

sub 'peername {
  local($no) = @_;
  local($port, $ip, $host);
  ($port, $ip) = (unpack($SOCKADDR, getpeername($'socket[$no])))[1, 2];
  $host = (gethostbyaddr(pack('N', $ip), $AF_INET))[0];
  return ($port, $ip, $host);
}

sub 's_connect {
  local($userno) = @_;
  local($server, $host, $name, $list, $pass, $serverno, @port);
  foreach $server (&'property($userno, 'server')) {
    next if &'exist($errorlist[$userno], $server);
    ($host, $pass) = (split(/\s+/, $server), '');
    ($name, $list) = split(/\:/, $host);
    @port = split(/\,/, $list || '');
    $serverno = &'connect($name, $port[rand(@port)] || $IRCPORT);
    next unless $serverno;
    $'serverlist = &'add($'serverlist, $serverno);
    $'avail[$serverno] = 0;
    $'userno[$serverno] = $userno;
    $pass[$serverno] = $pass;
    $serverhost[$serverno] = $server;
    $rbuf[$serverno] = '';
    &s_init($serverno);
    last;
  }
  $errorlist[$userno] = '' unless $host;
}

sub 's_close {
  local($serverno) = @_;
  local($userno, $no, $cmd);
  $userno = $'userno[$serverno];
  $rbuf[$serverno] = '';
  $sequence[$serverno] = '';
  foreach $key (keys(%wbuf)) {
    ($no, $cmd) = split(/$;/, $key, 2);
    next unless $no == $serverno;
    delete $wbuf{$key};
  }
  $serverhost[$serverno] = '';
  &'close($serverno);
  $'serverlist = &'remove($'serverlist, $serverno);
  if ($'avail[$serverno]) {
    $'avail[$serverno] = 0;
    &close_event($userno, 'server_close', $serverno);
  }
}

sub c_listen {
  local($userno) = @_;
  local($listenno, $name, $port, $i, $uselist);
  foreach $port (&get_port($userno)) {
    $port = $IRCPORT unless $port;
    next if &'exist($portlist, $port);
    $listenno = &'listen($port, $SOMAXCONN);
    next unless $listenno;
    $'listenlist = &'add($'listenlist, $listenno);
    $portlist = &'add($portlist, $port);
  }
  for ($i = 0; $i < @'username; $i++) {
    foreach $port (&get_port($i)) {
      $uselist = &'add($uselist, $port || $IRCPORT);
    }
  }
  foreach $lno (&'array($'listenlist)) {
    $port = (&'sockname($lno))[0];
    next if &'exist($uselist, $port);
    &'close($lno);
    $'listenlist = &'remove($'listenlist, $lno);
    $portlist = &'remove($portlist, $port);
  }
}

sub c_accept {
  local($listenno) = @_;
  local($clientno, $port, $ip, $name, $host, $pass, $regex, $i);
  $clientno = &'accept($listenno);
  return unless $clientno;
  $port = (&'sockname($clientno))[0];
  $ip = join('.', unpack('C4', pack('N', (&'peername($clientno))[1])));
  $name = (&'peername($clientno))[2];
  for ($i = 0; $i < @'username; $i++) {
    foreach $client (&'property($i, 'client')) {
      ($host, $pass) = (split(/\s+/, $client), '');
      next unless $port == ((split(/\:/, $host))[1] || $IRCPORT);
      $regex = &'regex((split(/\:/, $host))[0]);
      next unless ($ip =~ /$regex/i || $name =~ /$regex/i);
      $'clientlist = &'add($'clientlist, $clientno);
      $'avail[$clientno] = 0;
      $'nick[$clientno] = '';
      $'user[$clientno] = '';
      $rbuf[$clientno] = '';
      $pass[$clientno] = '';
      return;
    }
  }
  &'close($clientno);
}

sub get_port {
  local($userno) = @_;
  local($host, $pass, $mask, $port, $list);
  $list = '';
  foreach $client (&'property($userno, 'client')) {
    ($host, $pass) = split(/\s+/, $client, 2);
    ($mask, $port) = split(/\:/, $host);
    $list = &'add($list, $port);
  }
  return &'array($list);
}

sub 'c_close {
  local($clientno) = @_;
  $rbuf[$clientno] = '';
  $sequence[$clientno] = '';
  delete $wbuf{$clientno};
  &'close($clientno);
  $'clientlist = &'remove($'clientlist, $clientno);
  if ($'avail[$clientno]) {
    $'avail[$clientno] = 0;
    &close_event($'userno[$clientno], 'client_close', $clientno);
  }
}

sub s_init {
  local($serverno) = @_;
  local($userno, $nick, $user, $name);
  $userno = $'userno[$serverno];
  &'s_print($serverno, '', 'PASS', $pass[$serverno]) if $pass[$serverno];
  $nick = $nickname[$userno] || &'property($userno, 'nick') || getlogin() || eval '(getpwuid($<))[0]' || "$NAME-user";
  &'s_print($serverno, '', 'NICK', (split(/\,/, $nick))[0]);
  $user = &'property($userno, 'user') || getlogin() || eval '(getpwuid($<))[0]' || "$NAME-user";
  $name = &'property($userno, 'name');
  $name = eval '((split(/\,/, (getpwuid($<))[6]))[0])' || $user unless defined($name);
  &'s_print($serverno, '', 'USER', $user, '*', '*', $name);
  $'user[$serverno] = $user;
}

sub c_init {
  local($clientno) = @_;
  local($port, $ip, $name, $host, $pass, $regex, $i);
  $port = (&'sockname($clientno))[0];
  $ip = join('.', unpack('C4', pack('N', (&'peername($clientno))[1])));
  $name = (&'peername($clientno))[2];
  for ($i = 0; $i < @'username; $i++) {
    foreach $client (&'property($i, 'client')) {
      ($host, $pass) = (split(/\s+/, $client), '');
      next unless $port == ((split(/\:/, $host))[1] || $IRCPORT);
      $regex = &'regex((split(/\:/, $host))[0]);
      next unless ($ip =~ /$regex/i || $name =~ /$regex/i);
      next if ($pass && $pass ne $pass[$clientno]);
      $'userno[$clientno] = $i;
      $'avail[$clientno] = 1;
      $'server[$clientno] = 0;
      $'servername[$clientno] = $NAME;
      foreach $sno (&'array($'serverlist)) {
        next unless $'avail[$sno];
        next unless $'userno[$sno] == $'userno[$clientno];
        $'server[$clientno] = $sno;
        $'servername[$clientno] = $'servername[$sno];
      }
      &open_event($'userno[$clientno], 'client_open', $clientno);
      return;
    }
  }
  &'c_print($clientno, $NAME, '464', $'nick[$clientno], 'Password incorrect');
  &'c_print($clientno, '', 'ERROR', 'Closing Link: ' . &'user($clientno) . ' (Bad Password)');
  &'c_flush($clientno);
  &'c_close($clientno);
}

sub cn_mode {
  local($clientno, $prefix, $cmd, @params) = @_;
  &'c_print($clientno, $NAME, '451', '*', 'You have not registered');
}

sub cn_nick {
  local($clientno, $prefix, $cmd, @params) = @_;
  $'nick[$clientno] = $params[0];
  &c_init($clientno) if $'user[$clientno];
}

sub cn_pass {
  local($clientno, $prefix, $cmd, @params) = @_;
  $pass[$clientno] = $params[0];
}

sub cn_ping {
  local($clientno, $prefix, $cmd, @params) = @_;
  &'c_print($clientno, $NAME, '451', '*', 'You have not registered');
}

sub cn_quit {
  local($clientno, $prefix, $cmd, @params) = @_;
  $params[0] = 'I Quit' unless $params[0];
  &'c_print($clientno, '', 'ERROR', 'Closing Link: ' . &'user($clientno) . " ($params[0])");
  &'c_flush($clientno);
  &'c_close($clientno);
}

sub cn_user {
  local($clientno, $prefix, $cmd, @params) = @_;
  if (defined(@params) && @params >= 4) {
    $'user[$clientno] = $params[0];
    &c_init($clientno) if $'nick[$clientno];
  } else {
    &'c_print($clientno, $NAME, '461', 'Not enough parameters');
  }
}

sub sn_error {
  local($serverno, $prefix, $cmd, @params) = @_;
  local($userno);
  $userno = $'userno[$serverno];
  $errorlist[$userno] = &'add($errorlist[$userno], $serverhost[$serverno]);
}

sub sn_ping {
  local($serverno, $prefix, $cmd, @params) = @_;
  &'s_print($serverno, '', 'PONG', @params);
}

sub sn_001 {
  local($serverno, $prefix, $cmd, @params) = @_;
  local($userno, @user);
  $userno = $'userno[$serverno];
  $'avail[$serverno] = 1;
  $'nick[$serverno] = $params[0];
  $'servername[$serverno] = $prefix;
  $nickname[$userno] = $params[0];
  $errorlist[$userno] = '';
  @user = &'prefix(substr($params[1], rindex($params[1], ' ') + 1));
  if ($user[1] && $user[2]) {
    $address[$userno] = "$user[1]\@$user[2]";
  }
  &open_event($userno, 'server_open', $serverno);
}

sub sn_432 {
  local($serverno, $prefix, $cmd, @params) = @_;
  &anothernick($serverno, $params[1]);
}

sub sn_433 {
  local($serverno, $prefix, $cmd, @params) = @_;
  &anothernick($serverno, $params[1]);
}

sub sn_437 {
  local($serverno, $prefix, $cmd, @params) = @_;
  &anothernick($serverno, $params[1]);
}

sub sn_451 {
  local($serverno, $prefix, $cmd, @params) = @_;
}

sub anothernick {
  local($serverno, $newnick) = @_;
  local(@nickentry, $list, $user);
  $list = '';
  foreach $nick (&'property($'userno[$serverno], 'nick')) {
    foreach $name (split(/\,/, $nick)) {
      $list = &'add($list, substr($name, 0, 9));
    }
  }
  $user = substr(getlogin() || eval '(getpwuid($<))[0]' || "$NAME-user", 0, 9);
  $list = &'add($list, $user);
  $user = substr($user, 0, 8);
  $list = &'add($list, "${user}_", "_${user}", "${user}-", "-${user}");
  @nickentry = &'array($list);
  if (&'exist($list, $newnick)) {
    while ($nickentry[0] ne $newnick) {
      push(@nickentry, shift(@nickentry));
    }
    push(@nickentry, shift(@nickentry));
  }
  &'s_print($serverno, '', 'NICK', $nickentry[0]);
}

sub main_loop {
  local($userno) = @_;
  &c_listen($userno);
  foreach $sno (&'array($'serverlist)) {
    return if $'userno[$sno] == $userno;
  }
  &'s_connect($userno);
}

sub client_open {
  local($clientno) = @_;
  local($sno);
  $sno = $'server[$clientno];
  &'c_print($clientno, $'servername[$clientno], '001', $'nick[$clientno], 'Welcome to the Internet Relay Network ' . &'user($clientno));
  if ($sno) {
    &'c_print($clientno, &'user($clientno), 'NICK', $'nick[$sno]) if ($'nick[$clientno] ne $'nick[$sno]);
    foreach $chan (&'array($'channellist[$sno])) {
      &'c_print($clientno, &'user($clientno), 'JOIN', $chan);
      &'c_print($clientno, $'servername[$clientno], '332', $'nick[$clientno], $chan, $'topic{$sno, $chan}) if $'topic{$sno, $chan};
      &'c_print($clientno, $'servername[$clientno], '353', $'nick[$clientno], '=', $chan, join(' ', reverse(&'array($'nameslist{$sno, $chan}))));
      &'c_print($clientno, $'servername[$clientno], '366', $'nick[$clientno], $chan, 'End of /NAMES list.');
    }
  }
}

sub client_close {
  local($clientno) = @_;
  &clear_variable($clientno);
}

sub server_open {
  local($serverno) = @_;
  foreach $cno (&'array($'clientlist)) {
    next unless $'avail[$cno];
    next if $'server[$cno];
    next unless $'userno[$cno] == $'userno[$serverno];
    $'server[$cno] = $serverno;
    next unless $'nick[$cno] ne $'nick[$serverno];
    &'c_print($cno, &'user($cno), 'NICK', $'nick[$serverno]);
  }
}

sub server_close {
  local($serverno) = @_;
  foreach $cno (&'array($'clientlist)) {
    next unless $'avail[$cno];
    next unless $'server[$cno] == $serverno;
    &'c_print($cno, '', 'NOTICE', $'nick[$cno], "*** Server $'servername[$serverno] closed the connection");
    foreach $chan (&'array($'channellist[$serverno])) {
      &'c_print($cno, &'user($cno), 'PART', $chan);
    }
    $'server[$cno] = 0;
  }
  &clear_variable($serverno);
}

sub clear_variable {
  local($num) = @_;
  local($no, $var);
  $'channellist[$num] = '';
  foreach $key (keys(%'nameslist)) {
    ($no, $var) = split(/$;/, $key, 2);
    next unless $no == $num;
    delete $'nameslist{$key};
  }
  foreach $key (keys(%'channelmode)) {
    ($no, $var) = split(/$;/, $key, 2);
    next unless $no == $num;
    delete $'channelmode{$key};
  }
  foreach $key (keys(%'usermode)) {
    ($no, $var) = split(/$;/, $key, 2);
    next unless $no == $num;
    delete $'usermode{$key};
  }
  foreach $key (keys(%'topic)) {
    ($no, $var) = split(/$;/, $key, 2);
    next unless $no == $num;
    delete $'topic{$key};
  }
}

sub cs_exit {
  local($clientno, $prefix, $cmd, @params) = @_;
  local($i, $list, $sub);
  foreach $sno (&'array($'serverlist)) {
    &'s_flush($sno);
    &'s_print($sno, '', 'QUIT', $params[0] || $NAME);
    &'s_flush($sno);
    &'s_close($sno);
  }
  $params[0] = 'I Quit' unless $params[0];
  foreach $cno (&'array($'clientlist)) {
    &'c_print($cno, '', 'ERROR', 'Closing Link: ' . &'user($cno) . " ($params[0])");
    &'c_flush($cno);
    &'c_close($cno);
  }
  foreach $lno (&'array($'listenlist)) {
    &'close($lno);
  }
  for ($i = 0; $i < @'username; $i++) {
    $list = $'modulelist[$i];
    $'modulelist[$i] = '';
    foreach $module (&'array($list)) {
      $sub = $module . '\'module_disable';
      &$sub($i) if defined(&$sub);
    }
  }
  exit(0);
}

sub cs_quit {
  local($clientno, $prefix, $cmd, @params) = @_;
  $params[0] = 'I Quit' unless $params[0];
  &'c_print($clientno, '', 'ERROR', 'Closing Link: ' . &'user($clientno) . " ($params[0])");
  &'c_flush($clientno);
  &'c_close($clientno);
  return ();
}

sub cp_join {
  local($clientno, $prefix, $cmd, $chan) = @_;
  local($userno, $nick, $name, $mode);
  $nick = &'prefix($prefix);
  ($name, $mode) = (split(/\cG/, $chan), '');
  if ($nick eq $'nick[$clientno]) {
    $'channellist[$clientno] = &'add($'channellist[$clientno], $name);
    $'nameslist{$clientno, $name} = '';
  } else {
    if (index($mode, 'o') != -1) {
      $'nameslist{$clientno, $name} = &'add($'nameslist{$clientno, $name}, "\@$nick");
    } elsif (index($mode, 'v') != -1) {
      $'nameslist{$clientno, $name} = &'add($'nameslist{$clientno, $name}, "+$nick");
    } else {
      $'nameslist{$clientno, $name} = &'add($'nameslist{$clientno, $name}, $nick);
    }
  }
  return ($prefix, $cmd, $chan);
}

sub ss_join {
  local($serverno, $prefix, $cmd, $chan) = @_;
  local($nick, $name, $mode);
  $nick = &'prefix($prefix);
  ($name, $mode) = (split(/\cG/, $chan), '');
  if ($nick eq $'nick[$serverno]) {
    $'channellist[$serverno] = &'add($'channellist[$serverno], $name);
    $'nameslist{$serverno, $name} = '';
  } else {
    if (index($mode, 'o') != -1) {
      $'nameslist{$serverno, $name} = &'add($'nameslist{$serverno, $name}, "\@$nick");
    } elsif (index($mode, 'v') != -1) {
      $'nameslist{$serverno, $name} = &'add($'nameslist{$serverno, $name}, "+$nick");
    } else {
      $'nameslist{$serverno, $name} = &'add($'nameslist{$serverno, $name}, $nick);
    }
  }
  return ($prefix, $cmd, $chan);
}

sub cp_kick {
  local($clientno, $prefix, $cmd, @params) = @_;
  if ($params[1] eq $'nick[$clientno]) {
    $'channellist[$clientno] = &'remove($'channellist[$clientno], $params[0]);
    delete $'nameslist{$clientno, $params[0]};
  } else {
    $'nameslist{$clientno, $params[0]} = &'remove($'nameslist{$clientno, $params[0]}, $params[1], "+$params[1]", "\@$params[1]");
  }
  return ($prefix, $cmd, @params);
}

sub ss_kick {
  local($serverno, $prefix, $cmd, @params) = @_;
  if ($params[1] eq $'nick[$serverno]) {
    $'channellist[$serverno] = &'remove($'channellist[$serverno], $params[0]);
    delete $'nameslist{$serverno, $params[0]};
  } else {
    $'nameslist{$serverno, $params[0]} = &'remove($'nameslist{$serverno, $params[0]}, $params[1], "+$params[1]", "\@$params[1]");
  }
  return ($prefix, $cmd, @params);
}

sub cp_mode {
  local($clientno, $prefix, $cmd, @params) = @_;
  local($chan, $mode, @modes, $char, $flag, $name, $i);
  ($chan, $mode, @modes) = @params;
  if (&'channel($chan)) {
    for ($i = 0; $i < length($mode); $i++) {
      $char = substr($mode, $i, 1);
      if ($char eq '+' || $char eq '-') {
        $flag = $char;
      } elsif ($char eq 'b') {
        shift(@modes);
      } elsif ($char eq 'e') {
        shift(@modes);
      } elsif ($char eq 'I') {
        shift(@modes);
      } elsif ($char eq 'k') {
        if ($flag eq '+') {
          $'channelmode{$clientno, $chan, $char} = shift(@modes);
        } else {
          shift(@modes);
          delete $'channelmode{$clientno, $chan, $char};
        }
      } elsif ($char eq 'l') {
        if ($flag eq '+') {
          $'channelmode{$clientno, $chan, $char} = shift(@modes);
        } else {
          delete $'channelmode{$clientno, $chan, $char};
        }
      } elsif ($char eq 'O') {
        shift(@modes);
      } elsif ($char eq 'o') {
        $name = shift(@modes);
        if ($flag eq '+') {
          $'nameslist{$clientno, $chan} = &'change($'nameslist{$clientno, $chan}, $name, "\@$name", "+$name", "\@$name");
        } elsif ($flag eq '-') {
          $'nameslist{$clientno, $chan} = &'change($'nameslist{$clientno, $chan}, "\@$name", $name);
        }
      } elsif ($char eq 'v') {
        $name = shift(@modes);
        if ($flag eq '+') {
          $'nameslist{$clientno, $chan} = &'change($'nameslist{$clientno, $chan}, $name, "+$name");
        } elsif ($flag eq '-') {
          $'nameslist{$clientno, $chan} = &'change($'nameslist{$clientno, $chan}, "+$name", $name);
        }
      } else {
        if ($flag eq '+') {
          $'channelmode{$clientno, $chan, $char} = 1;
        } else {
          delete $'channelmode{$clientno, $chan, $char};
        }        
      }
    }
  } else {
    for ($i = 0; $i < length($mode); $i++) {
      $char = substr($mode, $i, 1);
      if ($char eq '+' || $char eq '-') {
        $flag = $char;
      } else {
        if ($flag eq '+') {
          $'usermode{$serverno, $char} = 1;
        } else {
          delete $'usermode{$serverno, $char};
        }
      }
    }
  }
  return ($prefix, $cmd, @params);
}

sub ss_mode {
  local($serverno, $prefix, $cmd, @params) = @_;
  local($chan, $mode, @modes, $char, $flag, $name, $i);
  ($chan, $mode, @modes) = @params;
  if (&'channel($chan)) {
    for ($i = 0; $i < length($mode); $i++) {
      $char = substr($mode, $i, 1);
      if ($char eq '+' || $char eq '-') {
        $flag = $char;
      } elsif ($char eq 'b') {
        shift(@modes);
      } elsif ($char eq 'e') {
        shift(@modes);
      } elsif ($char eq 'I') {
        shift(@modes);
      } elsif ($char eq 'k') {
        if ($flag eq '+') {
          $'channelmode{$serverno, $chan, $char} = shift(@modes);
        } else {
          shift(@modes);
          delete $'channelmode{$serverno, $chan, $char};
        }
      } elsif ($char eq 'l') {
        if ($flag eq '+') {
          $'channelmode{$serverno, $chan, $char} = shift(@modes);
        } else {
          delete $'channelmode{$serverno, $chan, $char};
        }
      } elsif ($char eq 'O') {
        shift(@modes);
      } elsif ($char eq 'o') {
        $name = shift(@modes);
        if ($flag eq '+') {
          $'nameslist{$serverno, $chan} = &'change($'nameslist{$serverno, $chan}, $name, "\@$name", "+$name", "\@$name");
        } elsif ($flag eq '-') {
          $'nameslist{$serverno, $chan} = &'change($'nameslist{$serverno, $chan}, "\@$name", $name);
        }
      } elsif ($char eq 'v') {
        $name = shift(@modes);
        if ($flag eq '+') {
          $'nameslist{$serverno, $chan} = &'change($'nameslist{$serverno, $chan}, $name, "+$name");
        } elsif ($flag eq '-') {
          $'nameslist{$serverno, $chan} = &'change($'nameslist{$serverno, $chan}, "+$name", $name);
        }
      } else {
        if ($flag eq '+') {
          $'channelmode{$serverno, $chan, $char} = 1;
        } else {
          delete $'channelmode{$serverno, $chan, $char};
        }        
      }
    }
  } else {
    for ($i = 0; $i < length($mode); $i++) {
      $char = substr($mode, $i, 1);
      if ($char eq '+' || $char eq '-') {
        $flag = $char;
      } else {
        if ($flag eq '+') {
          $'usermode{$serverno, $char} = 1;
        } else {
          delete $'usermode{$serverno, $char};
        }
      }
    }
  }
  return ($prefix, $cmd, @params);
}

sub cp_nick {
  local($clientno, $prefix, $cmd, @params) = @_;
  local($nick);
  $nick = &'prefix($prefix);
  if ($nick eq $'nick[$clientno]) {
    $'nick[$clientno] = $params[0];
  }
  foreach $chan (&'array($'channellist[$clientno])) {
    $'nameslist{$clientno, $chan} = &'change($'nameslist{$clientno, $chan}, $nick, $params[0], "+$nick", "+$params[0]", "\@$nick", "\@$params[0]");
  }
  return ($prefix, $cmd, @params);
}

sub ss_nick {
  local($serverno, $prefix, $cmd, @params) = @_;
  local($userno, $nick);
  $userno = $'userno[$serverno];
  $nick = &'prefix($prefix);
  if ($nick eq $'nick[$serverno]) {
    $'nick[$serverno] = $params[0];
    $nickname[$userno] = $params[0];
  }
  foreach $chan (&'array($'channellist[$serverno])) {
    $'nameslist{$serverno, $chan} = &'change($'nameslist{$serverno, $chan}, $nick, $params[0], "+$nick", "+$params[0]", "\@$nick", "\@$params[0]");
  }
  return ($prefix, $cmd, @params);
}

sub cp_part {
  local($clientno, $prefix, $cmd, @params) = @_;
  local($nick);
  $nick = &'prefix($prefix);
  if ($nick eq $'nick[$clientno]) {
    $'channellist[$clientno] = &'remove($'channellist[$clientno], $params[0]);
    delete $'nameslist{$clientno, $params[0]};
  } else {
    $'nameslist{$clientno, $params[0]} = &'remove($'nameslist{$clientno, $params[0]}, $nick, "+$nick", "\@$nick");
  }
  return ($prefix, $cmd, @params);
}

sub ss_part {
  local($serverno, $prefix, $cmd, @params) = @_;
  local($nick);
  $nick = &'prefix($prefix);
  if ($nick eq $'nick[$serverno]) {
    $'channellist[$serverno] = &'remove($'channellist[$serverno], $params[0]);
    delete $'nameslist{$serverno, $params[0]};
  } else {
    $'nameslist{$serverno, $params[0]} = &'remove($'nameslist{$serverno, $params[0]}, $nick, "+$nick", "\@$nick");
  }
  return ($prefix, $cmd, @params);
}

sub ss_ping {
  local($serverno, $prefix, $cmd, @params) = @_;
  &'s_print($serverno, '', 'PONG', @params);
  return ($prefix, $cmd, @params);
}

sub cs_pong {
  local($clientno, $prefix, $cmd, @params) = @_;
  return ();
}

sub cp_quit {
  local($clientno, $prefix, $cmd, @params) = @_;
  local($nick);
  $nick = &'prefix($prefix);
  foreach $chan (&'array($'channellist[$clientno])) {
    $'nameslist{$clientno, $chan} = &'remove($'nameslist{$clientno, $chan}, $nick, "+$nick", "\@$nick");
  }
  return ($prefix, $cmd, @params);
}

sub ss_quit {
  local($serverno, $prefix, $cmd, @params) = @_;
  local($nick);
  $nick = &'prefix($prefix);
  foreach $chan (&'array($'channellist[$serverno])) {
    $'nameslist{$serverno, $chan} = &'remove($'nameslist{$serverno, $chan}, $nick, "+$nick", "\@$nick");
  }
  return ($prefix, $cmd, @params);
}

sub cp_topic {
  local($clientno, $prefix, $cmd, @params) = @_;
  $'topic{$clientno, $params[0]} = $params[1];
  return ($prefix, $cmd, @params);
}

sub ss_topic {
  local($serverno, $prefix, $cmd, @params) = @_;
  $'topic{$serverno, $params[0]} = $params[1];
  return ($prefix, $cmd, @params);
}

sub cp_324 {
  local($clientno, $prefix, $cmd, @params) = @_;
  local($nick, $chan, $mode, @modes, $char, $flag, $i);
  ($nick, $chan, $mode, @modes) = @params;
  for ($i = 0; $i < length($mode); $i++) {
    $char = substr($mode, $i, 1);
    if ($char eq '+' || $char eq '-') {
      $flag = $char;
    } elsif ($char eq 'k') {
      if ($flag eq '+') {
        $'channelmode{$clientno, $chan, $char} = shift(@modes);
      } else {
        shift(@modes);
        delete $'channelmode{$clientno, $chan, $char};
      }
    } elsif ($char eq 'l') {
      if ($flag eq '+') {
        $'channelmode{$clientno, $chan, $char} = shift(@modes);
      } else {
        delete $'channelmode{$clientno, $chan, $char};
      }
    } else {
      if ($flag eq '+') {
        $'channelmode{$clientno, $chan, $char} = 1;
      } else {
        delete $'channelmode{$clientno, $chan, $char};
      }        
    }
  }
  return ($prefix, $cmd, @params);
}

sub ss_324 {
  local($serverno, $prefix, $cmd, @params) = @_;
  local($nick, $chan, $mode, @modes, $char, $flag, $i);
  ($nick, $chan, $mode, @modes) = @params;
  for ($i = 0; $i < length($mode); $i++) {
    $char = substr($mode, $i, 1);
    if ($char eq '+' || $char eq '-') {
      $flag = $char;
    } elsif ($char eq 'k') {
      if ($flag eq '+') {
        $'channelmode{$serverno, $chan, $char} = shift(@modes);
      } else {
        shift(@modes);
        delete $'channelmode{$serverno, $chan, $char};
      }
    } elsif ($char eq 'l') {
      if ($flag eq '+') {
        $'channelmode{$serverno, $chan, $char} = shift(@modes);
      } else {
        delete $'channelmode{$serverno, $chan, $char};
      }
    } else {
      if ($flag eq '+') {
        $'channelmode{$serverno, $chan, $char} = 1;
      } else {
        delete $'channelmode{$serverno, $chan, $char};
      }        
    }
  }
  return ($prefix, $cmd, @params);
}

sub cp_332 {
  local($clientno, $prefix, $cmd, @params) = @_;
  if (&'exist($'channellist[$clientno], $params[1])) {
    $'topic{$clientno, $params[1]} = $params[2];
  }
  return ($prefix, $cmd, @params);
}

sub ss_332 {
  local($serverno, $prefix, $cmd, @params) = @_;
  if (&'exist($'channellist[$serverno], $params[1])) {
    $'topic{$serverno, $params[1]} = $params[2];
  }
  return ($prefix, $cmd, @params);
}

sub cp_353 {
  local($clientno, $prefix, $cmd, @params) = @_;
  local($key);
  $key = "$clientno$;$params[2]";
  if (&'exist($'channellist[$clientno], $params[2])) {
    $'nameslist{$key} = &'add($'nameslist{$key}, reverse(split(/\s+/, $params[3])));
    if ($params[1] eq '@') {
      $'channelmode{$key, 's'} = 1;
    } elsif ($params[1] eq '*') {
      $'channelmode{$key, 'p'} = 1;
    }
  }
  return ($prefix, $cmd, @params);
}

sub ss_353 {
  local($serverno, $prefix, $cmd, @params) = @_;
  local($key);
  $key = "$serverno$;$params[2]";
  if (&'exist($'channellist[$serverno], $params[2])) {
    $'nameslist{$key} = &'add($'nameslist{$key}, reverse(split(/\s+/, $params[3])));
    if ($params[1] eq '@') {
      $'channelmode{$key, 's'} = 1;
    } elsif ($params[1] eq '*') {
      $'channelmode{$key, 'p'} = 1;
    }
  }
  return ($prefix, $cmd, @params);
}

sub cs_privmsg {
  local($clientno, $prefix, $cmd, @params) = @_;
  local($tmp, $ctmp, $rest, $ctcp, $list);
  if ($params[1]) {
    $tmp = '';
    $ctmp = '';
    $rest = $params[1];
    while ($rest =~ /^([^\cA]*)\cA([^\cA]*)\cA(.*)$/) {
      $tmp .= $1;
      $ctmp .= $1;
      $ctcp = $2;
      $rest = $3;
      $tmp .= &ctcp_scan($clientno, 'cpcs', $prefix, $params[0], $ctcp) unless &'exist($list, $ctcp);
      $list = &'add($list, $ctcp);
    }
    $tmp .= $rest || '';
    $ctmp .= $rest || '';
    return () unless $tmp;
    $params[1] = $ctmp;
    foreach $cno (&'array($'clientlist)) {
      next unless $clientno != $cno;
      next unless $'avail[$cno];
      next unless $'server[$cno] == $'server[$clientno];
      &'c_print($cno, &'user($cno), $cmd, @params);
    }
    $params[1] = $tmp;
  }
  return ($prefix, $cmd, @params);
}

sub cp_privmsg {
  local($clientno, $prefix, $cmd, @params) = @_;
  local($tmp, $rest, $ctcp, $list);
  if ($params[1]) {
    $tmp = '';
    $rest = $params[1];
    while ($rest =~ /^([^\cA]*)\cA([^\cA]*)\cA(.*)$/) {
      $tmp .= $1;
      $ctcp = $2;
      $rest = $3;
      $tmp .= &ctcp_print($clientno, 'cpcp', $prefix, $params[0], $ctcp) unless &'exist($list, $ctcp);
      $list = &'add($list, $ctcp);
    }
    $tmp .= $rest || '';
    return () unless $tmp;
    $params[1] = $tmp;
  }
  return ($prefix, $cmd, @params);
}

sub ss_privmsg {
  local($serverno, $prefix, $cmd, @params) = @_;
  local($tmp, $rest, $ctcp, $list);
  if ($params[1]) {
    $tmp = '';
    $rest = $params[1];
    while ($rest =~ /^([^\cA]*)\cA([^\cA]*)\cA(.*)$/) {
      $tmp .= $1;
      $ctcp = $2;
      $rest = $3;
      $tmp .= &ctcp_scan($serverno, 'cpss', $prefix, $params[0], $ctcp) unless &'exist($list, $ctcp);
      $list = &'add($list, $ctcp);
    }
    $tmp .= $rest || '';
    return () unless $tmp;
    $params[1] = $tmp;
  }
  return ($prefix, $cmd, @params);
}

sub sp_privmsg {
  local($serverno, $prefix, $cmd, @params) = @_;
  local($tmp, $rest, $ctcp, $list);
  if ($params[1]) {
    $tmp = '';
    $rest = $params[1];
    while ($rest =~ /^([^\cA]*)\cA([^\cA]*)\cA(.*)$/) {
      $tmp .= $1;
      $ctcp = $2;
      $rest = $3;
      $tmp .= &ctcp_print($serverno, 'cpsp', $prefix, $params[0], $ctcp) unless &'exist($list, $ctcp);
      $list = &'add($list, $ctcp);
    }
    $tmp .= $rest || '';
    return () unless $tmp;
    $params[1] = $tmp;
  }
  return ($prefix, $cmd, @params);
}

sub cs_notice {
  local($clientno, $prefix, $cmd, @params) = @_;
  local($tmp, $ctmp, $rest, $ctcp, $list);
  if ($params[1]) {
    $tmp = '';
    $ctmp = '';
    $rest = $params[1];
    while ($rest =~ /^([^\cA]*)\cA([^\cA]*)\cA(.*)$/) {
      $tmp .= $1;
      $ctmp .= $1;
      $ctcp = $2;
      $rest = $3;
      $tmp .= &ctcp_scan($clientno, 'cncs', $prefix, $params[0], $ctcp) unless &'exist($list, $ctcp);
      $list = &'add($list, $ctcp);
    }
    $tmp .= $rest || '';
    $ctmp .= $rest || '';
    return () unless $tmp;
    foreach $cno (&'array($'clientlist)) {
      next unless $clientno != $cno;
      next unless $'avail[$cno];
      next unless $'server[$cno] == $'server[$clientno];
      &'c_print($cno, &'user($cno), $cmd, $params[0], $ctmp);
    }
  }
  return ($prefix, $cmd, @params);
}

sub cp_notice {
  local($clientno, $prefix, $cmd, @params) = @_;
  local($tmp, $rest, $ctcp, $list);
  if ($params[1]) {
    $tmp = '';
    $rest = $params[1];
    while ($rest =~ /^([^\cA]*)\cA([^\cA]*)\cA(.*)$/) {
      $tmp .= $1;
      $ctcp = $2;
      $rest = $3;
      $tmp .= &ctcp_print($clientno, 'cncp', $prefix, $params[0], $ctcp) unless &'exist($list, $ctcp);
      $list = &'add($list, $ctcp);
    }
    $tmp .= $rest || '';
    return () unless $tmp;
  }
  return ($prefix, $cmd, @params);
}

sub ss_notice {
  local($serverno, $prefix, $cmd, @params) = @_;
  local($tmp, $rest, $ctcp, $list);
  if ($params[1]) {
    $tmp = '';
    $rest = $params[1];
    while ($rest =~ /^([^\cA]*)\cA([^\cA]*)\cA(.*)$/) {
      $tmp .= $1;
      $ctcp = $2;
      $rest = $3;
      $tmp .= &ctcp_scan($serverno, 'cnss', $prefix, $params[0], $ctcp) unless &'exist($list, $ctcp);
      $list = &'add($list, $ctcp);
    }
    $tmp .= $rest || '';
    return () unless $tmp;
  }
  return ($prefix, $cmd, @params);
}

sub sp_notice {
  local($serverno, $prefix, $cmd, @params) = @_;
  local($tmp, $rest, $ctcp, $list);
  if ($params[1]) {
    $tmp = '';
    $rest = $params[1];
    while ($rest =~ /^([^\cA]*)\cA([^\cA]*)\cA(.*)$/) {
      $tmp .= $1;
      $ctcp = $2;
      $rest = $3;
      $tmp .= &ctcp_print($serverno, 'cnsp', $prefix, $params[0], $ctcp) unless &'exist($list, $ctcp);
      $list = &'add($list, $ctcp);
    }
    $tmp .= $rest || '';
    return () unless $tmp;
  }
  return ($prefix, $cmd, @params);
}

sub ctcp_scan {
  local($no, $event, $prefix, $chan, $ctcp) = @_;
  local($cmd, $param);
  ($cmd, $param) = split(/\s+/, $ctcp, 2);
  return '' unless $cmd;
  ($prefix, $cmd, $chan, $param) = &print_event($'userno[$no], "${event}\_\L$cmd\E", $no, $prefix, $cmd, $chan, $param);
  return '' unless $cmd;
  if ($param) {
    return "\cA$cmd $param\cA";
  } else {
    return "\cA$cmd\cA";
  }
}

sub ctcp_print {
  local($no, $event, $prefix, $chan, $ctcp) = @_;
  local($cmd, $param);
  ($cmd, $param) = split(/\s+/, $ctcp, 2);
  return '' unless $cmd;
  ($prefix, $cmd, $chan, $param) = &print_event($'userno[$no], "${event}\_\L$cmd\E", $no, $prefix, $cmd, $chan, $param);
  return '' unless $cmd;
  if ($param) {
    return "\cA$cmd $param\cA";
  } else {
    return "\cA$cmd\cA";
  }
}

sub scan_event {
  local($userno, $event, $no, $prefix, $cmd, @params) = @_;
  local($name, $sub, $label);
  $name = '\'' . $event;
  foreach $module (&'array($'modulelist[$userno])) {
    $sub = $module . $name;
    next unless defined(&$sub);
    if ($'labellist{$userno, $module}) {
      foreach $label (&'array($'labellist{$userno, $module})) {
        ($prefix, $cmd, @params) = &$sub($no, $prefix, $cmd, @params);
        return () unless $cmd;
      }
    } else {
      ($prefix, $cmd, @params) = &$sub($no, $prefix, $cmd, @params);
      return () unless $cmd;
    }
  }
  return ($prefix, $cmd, @params);
}

sub print_event {
  local($userno, $event, $no, $prefix, $cmd, @params) = @_;
  local($name, $sub, $label);
  $name = '\'' . $event;
  foreach $module (reverse(&'array($'modulelist[$userno]))) {
    $sub = $module . $name;
    next unless defined(&$sub);
    if ($'labellist{$userno, $module}) {
      foreach $label (&'array($'labellist{$userno, $module})) {
        ($prefix, $cmd, @params) = &$sub($no, $prefix, $cmd, @params);
        return () unless $cmd;
      }
    } else {
      ($prefix, $cmd, @params) = &$sub($no, $prefix, $cmd, @params);
      return () unless $cmd;
    }
  }
  return ($prefix, $cmd, @params);
}

sub read_event {
  local($userno, $event, $no, $msg) = @_;
  local($name, $sub, $label);
  $name = '\'' . $event;
  foreach $module (&'array($'modulelist[$userno])) {
    $sub = $module . $name;
    next unless defined(&$sub);
    if ($'labellist{$userno, $module}) {
      foreach $label (&'array($'labellist{$userno, $module})) {
        $msg = &$sub($no, $msg);
        return '' unless $msg;
      }
    } else {
      $msg = &$sub($no, $msg);
      return '' unless $msg;
    }
  }
  return $msg;
}

sub write_event {
  local($userno, $event, $no, $msg) = @_;
  local($name, $sub, $label);
  $name = '\'' . $event;
  foreach $module (reverse(&'array($'modulelist[$userno]))) {
    $sub = $module . $name;
    next unless defined(&$sub);
    if ($'labellist{$userno, $module}) {
      foreach $label (&'array($'labellist{$userno, $module})) {
        $msg = &$sub($no, $msg);
        return '' unless $msg;
      }
    } else {
      $msg = &$sub($no, $msg);
      return '' unless $msg;
    }
  }
  return $msg;
}

sub open_event {
  local($userno, $event, $no) = @_;
  local($name, $sub, $label);
  $name = '\'' . $event;
  foreach $module (&'array($'modulelist[$userno])) {
    $sub = $module . $name;
    next unless defined(&$sub);
    if ($'labellist{$userno, $module}) {
      foreach $label (&'array($'labellist{$userno, $module})) {
        &$sub($no);
      }
    } else {
      &$sub($no);
    }
  }
}

sub close_event {
  local($userno, $event, $no) = @_;
  local($name, $sub, $label);
  $name = '\'' . $event;
  foreach $module (reverse(&'array($'modulelist[$userno]))) {
    $sub = $module . $name;
    next unless defined(&$sub);
    if ($'labellist{$userno, $module}) {
      foreach $label (&'array($'labellist{$userno, $module})) {
        &$sub($no);
      }
    } else {
      &$sub($no);
    }
  }
}

__END__
<DL>
<DT>  plum.kanji* ({euc|jis|sjis})
</DT>
<DT>  plum.nick* ($B%K%C%/%M!<%`(B)
</DT>
<DT>  plum.user $B%f!<%6%M!<%`(B
</DT>
<DT>  plum.name $B<BL>(B
</DT>
<DT>  plum.server* $B%5!<%PL>(B[:($B%]!<%HHV9f(B)] [$B%Q%9%o!<%I(B]
</DT>
<DT>  plum.client* $B%/%i%$%"%s%H%^%9%/(B[:$B%]!<%HHV9f(B] [$B%Q%9%o!<%I(B]
</DT>
<DT>  plum.directory* $B%G%#%l%/%H%j(B
</DT>
</DL>
