home *** CD-ROM | disk | FTP | other *** search
/ ftp.madoka.org / 2014.12.ftp.madoka.org.tar / ftp.madoka.org / pub / plum / 2.x / plum2_11_1.lzh / plum next >
Text File  |  1997-12-13  |  49KB  |  1,763 lines
  1. #!/bin/perl -w
  2. # $Id: plum,v 2.20 1997/12/13 23:14:43 hasegawa Exp $
  3. # copyright (c)1997 pupu_j <hasegawa@agusa.nuie.nagoya-u.ac.jp>
  4.  
  5. package plum;
  6.  
  7. $NAME = 'plum';
  8. $VERSION = '2.11';
  9.  
  10. $ALIAS = '*.jp';
  11. $NOTRAILING = &'list('004', '215', '221', '324', '341', '367', 'mode');
  12.  
  13. $IRCPORT = 6667;
  14. $READSIZE = 1024;
  15. $TIMEOUT = 120;
  16. $SOCKADDR = 'S n a4 x8';
  17.  
  18. $PROTO = getprotobyname('tcp');
  19.  
  20. if ($] < 5) {
  21.   foreach $inc (@INC) {
  22.     if (-r "$inc/sys/socket.ph") {
  23.       eval { require 'sys/socket.ph' };
  24.       $SOCKET = "$inc/sys/socket.ph" unless $@;
  25.       last;
  26.     }
  27.     if (-r "$inc/socket.ph") {
  28.       eval { require 'socket.ph' };
  29.       $SOCKET = "$inc/socket.ph" unless $@;
  30.       last;
  31.     }
  32.   }
  33. } else {
  34.   eval 'use Socket';
  35.   $SOCKET = 'Socket.pm' unless $@;
  36. }
  37.  
  38. $AF_INET = eval { &AF_INET } || 2;
  39. $PF_INET = eval { &PF_INET } || 2;
  40. $SOCK_STREAM = eval { &SOCK_STREAM } || 1;
  41. $SOMAXCONN = eval { &SOMAXCONN } || 16;
  42. $INADDR_ANY = eval { &INADDR_ANY } || "\0\0\0\0";
  43. $SOL_SOCKET = eval { &SOL_SOCKET};
  44. $SO_REUSEADDR = eval { &SO_REUSEADDR };
  45.  
  46. $'rin = '';
  47. $'win = '';
  48.  
  49. $handle = 0;
  50.  
  51. if ($0 =~ /^(.*)[\\\/][^\\\/]*$/) {
  52.   unshift(@INC, "$1/module");
  53. } else {
  54.   unshift(@INC, './module');
  55. }
  56.  
  57. &'load('', "$NAME.conf") if -r "$NAME.conf";
  58. foreach $user (@ARGV) {
  59.   &'load($user, "$NAME-$user.conf") if -r "$NAME-$user.conf";
  60. }
  61.  
  62. exit unless scalar(@'username);
  63.  
  64. print "$NAME $VERSION\n";
  65.  
  66. &main;
  67.  
  68. sub main {
  69.   local($nfound, $timeleft, $sub, $label, $i);
  70.   for (;;) {
  71.     for ($i = 0; $i < scalar(@'username); $i++) {
  72.       foreach $module (&'array($'modulelist[$i])) {
  73.         $sub = "${module}\'main_loop";
  74.         next unless defined(&$sub);
  75.         if ($'labellist{$module}) {
  76.           foreach $label (&'array($'labellist{$module})) {
  77.             &$sub($i);
  78.           }
  79.         } else {
  80.           &$sub($i);
  81.         }
  82.       }
  83.     }
  84.     ($nfound, $timeleft) = select($'rout = $'rin, $'wout = $'win, undef, $TIMEOUT);
  85.     foreach $cno (&'array($'clientlist)) {
  86.       &c_read($cno) if vec($'rout, $cno, 1);
  87.       &c_write($cno) if vec($'wout, $cno, 1);
  88.     }
  89.     foreach $sno (&'array($'serverlist)) {
  90.       &s_read($sno) if vec($'rout, $sno, 1);
  91.       &s_write($sno) if vec($'wout, $sno, 1);
  92.     }
  93.     foreach $lno (&'array($'listenlist)) {
  94.       &c_accept($lno) if vec($'rout, $lno, 1);
  95.     }
  96.   }
  97. }
  98.  
  99. sub c_read {
  100.   local($clientno) = @_;
  101.   local($next, $rest, $tmp, $sub, $label);
  102.   $tmp = '';
  103.   if (sysread($'socket[$clientno], $tmp, $READSIZE)) {
  104.     $rbuf[$clientno] .= $tmp;
  105.     while ((($next, $rest) = split(/[\r\n]+/, $rbuf[$clientno], 2)) == 2) {
  106.       $rbuf[$clientno] = $rest;
  107.       next unless $next;
  108.       if ($'avail[$clientno]) {
  109.         foreach $module (&'array($'modulelist[$'userno[$clientno]])) {
  110.           $sub = "${module}\'client_read";
  111.           next unless defined(&$sub);
  112.           if ($'labellist{$module}) {
  113.             foreach $label (&'array($'labellist{$module})) {
  114.               $next = &$sub($clientno, $next);
  115.               last unless $next;
  116.             }
  117.           } else {
  118.             $next = &$sub($clientno, $next);
  119.             last unless $next;
  120.           }
  121.         }
  122.       }
  123.       next unless $next;
  124.       &c_scan($clientno, $next);
  125.     }
  126.     $rbuf[$clientno] = $next || '';
  127.   } else {
  128.     &'c_close($clientno);
  129.   }
  130. }
  131.  
  132. sub c_scan {
  133.   local($clientno, $line) = @_;
  134.   local($prefix, $cmd, @params, $sub, $label);
  135.   ($prefix, $cmd, @params) = &'parse($line);
  136.   return unless $cmd;
  137.   if ($'avail[$clientno]) {
  138.     foreach $module (&'array($'modulelist[$'userno[$clientno]])) {
  139.       $sub = "${module}\'cs_\L$cmd\E";
  140.       next unless defined(&$sub);
  141.       if ($'labellist{$module}) {
  142.         foreach $label (&'array($'labellist{$module})) {
  143.           ($prefix, $cmd, @params) = &$sub($clientno, $prefix, $cmd, @params);
  144.           last unless $cmd;
  145.         }
  146.       } else {
  147.         ($prefix, $cmd, @params) = &$sub($clientno, $prefix, $cmd, @params);
  148.       }
  149.       last unless $cmd;
  150.     }
  151.     return unless $cmd;
  152.     return unless $'server[$'userno[$clientno]];
  153.     return unless $'avail[$'server[$'userno[$clientno]]];
  154.     &'s_print($'server[$'userno[$clientno]], $prefix, $cmd, @params);
  155.   } else {
  156.     $sub = "cn_\L$cmd\E";
  157.     &$sub($clientno, $prefix, $cmd, @params) if defined(&$sub);
  158.   }
  159. }
  160.  
  161. sub c_write {
  162.   local($clientno) = @_;
  163.   local($socket, $next, $rest, $sub, $label);
  164.   $socket = $'socket[$clientno];
  165.   while ((($next, $rest) = split(/[\r\n]+/, $wbuf[$clientno], 2)) == 2) {
  166.     $wbuf[$clientno] = $rest;
  167.     next unless $next;
  168.     if ($'avail[$clientno]) {
  169.       foreach $module (&'array($'modulelist[$'userno[$clientno]])) {
  170.         $sub = "${module}\'client_write";
  171.         next unless defined(&$sub);
  172.         if ($'labellist{$module}) {
  173.           foreach $label (&'array($'labellist{$module})) {
  174.             $next = &$sub($clientno, $next);
  175.             last unless $next;
  176.           }
  177.         } else {
  178.           $next = &$sub($clientno, $next);
  179.         }
  180.         last unless $next;
  181.       }
  182.     }
  183.     next unless $next;
  184.     print $socket $next, "\r\n" if fileno($socket);
  185.   }
  186.   $wbuf[$clientno] = $next || '';
  187.   vec($'win, $clientno, 1) = 0;
  188. }
  189.  
  190. sub 'c_print {
  191.   local($clientno, $prefix, $cmd, @params) = @_;
  192.   local($sub, $label);
  193.   return unless $cmd;
  194.   return unless $clientno;
  195.   if ($'avail[$clientno]) {
  196.     foreach $module (&'array($'modulelist[$'userno[$clientno]])) {
  197.       $sub = "${module}\'cp_\L$cmd\E";
  198.       next unless defined(&$sub);
  199.       if ($'labellist{$module}) {
  200.         foreach $label (&'array($'labellist{$module})) {
  201.           ($prefix, $cmd, @params) = &$sub($clientno, $prefix, $cmd, @params);
  202.           last unless $cmd;
  203.         }
  204.       } else {
  205.         ($prefix, $cmd, @params) = &$sub($clientno, $prefix, $cmd, @params);
  206.       }
  207.       last unless $cmd;
  208.     }
  209.     return unless $cmd;
  210.   }
  211.   $wbuf[$clientno] .= &'build($prefix, $cmd, @params);
  212.   vec($'win, $clientno, 1) = 1;
  213. }
  214.  
  215. sub 'c_flush {
  216.   local($clientno) = @_;
  217.   while (vec($'win, $clientno, 1)) {
  218.     &c_write($clientno);
  219.   }
  220. }
  221.  
  222. sub s_read {
  223.   local($serverno) = @_;
  224.   local($userno, $next, $rest, $tmp, $sub, $label);
  225.   $userno = $'userno[$serverno];
  226.   $tmp = '';
  227.   if (sysread($'socket[$serverno], $tmp, $READSIZE)) {
  228.     $rbuf[$serverno] .= $tmp;
  229.     while ((($next, $rest) = split(/[\r\n]+/, $rbuf[$serverno], 2)) == 2) {
  230.       $rbuf[$serverno] = $rest;
  231.       next unless $next;
  232.       if ($'avail[$serverno]) {
  233.         foreach $module (&'array($'modulelist[$userno])) {
  234.           $sub = "${module}\'server_read";
  235.           next unless defined(&$sub);
  236.           if ($'labellist{$module}) {
  237.             foreach $label (&'array($'labellist{$module})) {
  238.               $next = &$sub($serverno, $next);
  239.               last unless $next;
  240.             }
  241.           } else {
  242.             $next = &$sub($serverno, $next);
  243.           }
  244.         last unless $next;
  245.         }
  246.       }
  247.       next unless $next;
  248.       &s_scan($serverno, $next);
  249.     }
  250.     $rbuf[$serverno] = $next || '';
  251.   } else {
  252.     &'s_close($userno);
  253.     &'s_connect($userno);
  254.   }
  255. }
  256.  
  257. sub s_scan {
  258.   local($serverno, $line) = @_;
  259.   local($prefix, $cmd, @params, $sub, $label);
  260.   ($prefix, $cmd, @params) = &'parse($line);
  261.   return unless $cmd;
  262.   if ($'avail[$serverno]) {
  263.     foreach $module (&'array($'modulelist[$'userno[$serverno]])) {
  264.       $sub = "${module}\'ss_\L$cmd\E";
  265.       next unless defined(&$sub);
  266.       if ($'labellist{$module}) {
  267.         foreach $label (&'array($'labellist{$module})) {
  268.           ($prefix, $cmd, @params) = &$sub($serverno, $prefix, $cmd, @params);
  269.           last unless $cmd;
  270.         }
  271.       } else {
  272.         ($prefix, $cmd, @params) = &$sub($serverno, $prefix, $cmd, @params);
  273.       }
  274.       last unless $cmd;
  275.     }
  276.     return unless $cmd;
  277.     foreach $cno (&'array($'clientlist)) {
  278.       next unless $'avail[$cno];
  279.       next unless $'userno[$cno] == $'userno[$serverno];
  280.       &'c_print($cno, $prefix, $cmd, @params);
  281.     }
  282.   } else {
  283.     $sub = "sn_\L$cmd\E";
  284.     &$sub($serverno, $prefix, $cmd, @params) if defined(&$sub);
  285.   }
  286. }
  287.  
  288. sub s_write {
  289.   local($serverno) = @_;
  290.   local($socket, $next, $rest, $sub, $label, $time);
  291.   $socket = $'socket[$serverno];
  292.   $time = time();
  293.   $timer[$serverno] = $time if ($timer[$serverno] || 0) < $time;
  294.   while ((($next, $rest) = split(/[\r\n]+/, $wbuf[$serverno], 2)) == 2) {
  295.     return if $timer[$serverno] > $time + 10;
  296.     $wbuf[$serverno] = $rest;
  297.     next unless $next;
  298.     if ($'avail[$serverno]) {
  299.       foreach $module (&'array($'modulelist[$'userno[$serverno]])) {
  300.         $sub = "${module}\'server_write";
  301.         next unless defined(&$sub);
  302.         if ($'labellist{$module}) {
  303.           foreach $label (&'array($'labellist{$module})) {
  304.             $next = &$sub($serverno, $next);
  305.             last unless $next;
  306.           }
  307.         } else {
  308.           $next = &$sub($serverno, $next);
  309.         }
  310.         last unless $next;
  311.       }
  312.     }
  313.     next unless $next;
  314.     print $socket $next, "\r\n" if fileno($socket);
  315.     $timer[$serverno] += 2;
  316.   }
  317.   $wbuf[$serverno] = $next || '';
  318.   vec($'win, $serverno, 1) = 0;
  319. }
  320.  
  321. sub 's_print {
  322.   local($serverno, $prefix, $cmd, @params) = @_;
  323.   local($sub, $label);
  324.   return unless $cmd;
  325.   return unless $serverno;
  326.   foreach $module (&'array($'modulelist[$'userno[$serverno]])) {
  327.     $sub = "${module}\'sp_\L$cmd\E";
  328.     next unless defined(&$sub);
  329.     if ($'labellist{$module}) {
  330.       foreach $label (&'array($'labellist{$module})) {
  331.         ($prefix, $cmd, @params) = &$sub($serverno, $prefix, $cmd, @params);
  332.         last unless $cmd;
  333.       }
  334.     } else {
  335.       ($prefix, $cmd, @params) = &$sub($serverno, $prefix, $cmd, @params);
  336.     }
  337.     last unless $cmd;
  338.   }
  339.   return unless $cmd;
  340.   $wbuf[$serverno] .= &'build($prefix, $cmd, @params);
  341.   vec($'win, $serverno, 1) = 1;
  342. }
  343.  
  344. sub 's_flush {
  345.   local($serverno) = @_;
  346.   while (vec($'win, $serverno, 1)) {
  347.     &s_write($serverno);
  348.   }
  349. }
  350.  
  351. sub 'parse {
  352.   local($line) = @_;
  353.   local($arg, $rest, @params);
  354.   @params = ();
  355.   $line =~ s/^\s*//;
  356.   if ($line =~ /^\:(.*)$/) {
  357.     ($arg, $rest) = split(/\s+/, $1, 2);
  358.   } else {
  359.     ($arg, $rest) = ('', $line);
  360.   }
  361.   while ($line) {
  362.     push(@params, $arg);
  363.     if ($rest =~ /^\:(.*)$/) {
  364.       push(@params, $1);
  365.       last;
  366.     }
  367.     $line = $rest;
  368.     ($arg, $rest) = (split(/\s+/, $line, 2), '');
  369.   }
  370.   return @params;
  371. }
  372.  
  373. sub 'build {
  374.   local($prefix, $cmd, @params) = @_;
  375.   local($trailing);
  376.   return '' unless $cmd;
  377.   if (@params) {
  378.     $trailing = pop(@params) || '';
  379.     if (&'exist($NOTRAILING, "\L$cmd\E")) {
  380.       push(@params, "$trailing ");
  381.     } else {
  382.       push(@params, ":$trailing");
  383.     }
  384.   } else {
  385.     @params = ();
  386.   }
  387.   unshift(@params, $cmd);
  388.   unshift(@params, ":$prefix") if $prefix;
  389.   return join(' ', @params) . "\r\n";
  390. }
  391.  
  392. sub 'user {
  393.   local($no) = @_;
  394.   local($addr, $host);
  395.   if (fileno($'socket[$no])) {
  396.     $addr = (unpack($SOCKADDR, getsockname($'socket[$no])))[2];
  397.     $host = (gethostbyaddr($addr, $AF_INET))[0] || join('.', unpack('C4', $addr));
  398.   } else {
  399.     $host = 'unknown';
  400.   }
  401.   return "$'nick[$no]!$'user[$no]\@$host";
  402. }
  403.  
  404. sub 'prefix {
  405.   local($prefix) = @_;
  406.   $prefix =~ /([^\!\@]*)(\!([^\!\@]*))?(\@([^\!\@]*))?$/;
  407.   if (wantarray) {
  408.     return ($1 || '', $3 || '', $5 || '');
  409.   } else {
  410.     return $1;
  411.   }
  412. }
  413.  
  414. sub 'regex {
  415.   local($mask) = @_;
  416.   $mask =~ s/(\W)/\\$1/g;
  417.   $mask =~ s/\\\?/\./g;
  418.   $mask =~ s/\\\*/\.\*/g;
  419.   $mask =~ s/\\[\[\{]/\[\\\[\\\{\]/g;
  420.   $mask =~ s/\\[\]\}]/\[\\\]\\\}\]/g;
  421.   $mask =~ s/\\[\|\\]/\[\\\|\\\\\]/g;
  422.   return "\^$mask\$";
  423. }
  424.  
  425. sub 'load {
  426.   local($user, $file) = @_;
  427.   local($userno, @key, $no, $var, $line, $arg, $name, $label);
  428.   @'username = () unless @'username;
  429.   open(FILE, $file) || return;
  430.   if (!&'exist(&'list(@'username), $user)) {
  431.     push(@'username, $user);
  432.   }
  433.   for ($userno = 0; $userno < scalar(@'username); $userno++) {
  434.     last if $user eq $'username[$userno];
  435.   }
  436.   foreach $key (keys(%property)) {
  437.     ($no, $var) = split(/$;/, $key, 2);
  438.     next unless $no == $userno;
  439.     delete $property{$key};
  440.   }
  441.   $'filename{$user} = $file;
  442.   $'modulelist[$userno] = &'list('plum');
  443.   while (defined($line = <FILE>)) {
  444.     next if $line =~ /^\s*[\#\;]/;
  445.     $line =~ s/[\r\n]+//;
  446.     next unless $line;
  447.     foreach $kanji (&'property($userno, 'kanji')) {
  448.       foreach $code (split(/\,/, $kanji)) {
  449.         if ("\L$code\E" eq 'euc') {
  450.           $line = &'euc_jis($line);
  451.         } elsif ("\L$code\E" eq 'jis') {
  452.           $line = &'jis_jis($line);
  453.         } elsif ("\L$code\E" eq 'sjis') {
  454.           $line = &'sjis_jis($line);
  455.         }
  456.       }
  457.     }
  458.     if ($line =~ /^\s*\+\s*(\S+)\s+(\S+)/) {
  459.       $name = $1;
  460.       $label = $2;
  461.       &'import($name);
  462.       $'modulelist[$userno] = &'add($'modulelist[$userno], $'package{$name});
  463.       $'labellist{$'package{$name}} = &'list(split(/\,/, $label));
  464.     } elsif ($line =~ /^\s*\+\s*(\S+)/) {
  465.       $name = $1;
  466.       &'import($name);
  467.       $'modulelist[$userno] = &'add($'modulelist[$userno], $'package{$name});
  468.       $'labellist{$'package{$name}} = '';
  469.     } elsif ($line =~ /^\s*\-\s*(\S+)/) {
  470.       $name = $1;
  471.       if ($'package{$name}) {
  472.         $'modulelist[$userno] = &'remove($'modulelist[$userno], $'package{$name});
  473.         $'labellist{$'package{$name}} = '';
  474.       }
  475.     } elsif ($line =~ /^\s*\=\s*(\S+)/) {
  476.       $name = $1;
  477.       &'import($name);
  478.     } elsif ((($var, $arg) = split(/\s*\:\s*/, $line, 2)) == 2) {
  479.       @key = split(/\./, $var);
  480.       $property{$userno, @key} = &'add($property{$userno, @key}, $arg);
  481.     }
  482.   }
  483.   close(FILE);
  484. }
  485.  
  486. sub 'import {
  487.   local($name) = @_;
  488.   local($file);
  489.   $file = &'expand($name);
  490.   $_ = $'package{$name} || 'main';
  491.   require $file;
  492.   $'package{$name} = $_;
  493.   $'filename{$'package{$name}} = $name;
  494. }
  495.  
  496. sub 'property {
  497.   local($userno, $name) = @_;
  498.   local(@pkg, $list);
  499.   @pkg = split(/\_/, (caller())[0]);
  500.   if ($label) {
  501.     $list = $property{$userno, @pkg, $label, $name} || $property{$userno, @pkg, $name};
  502.   } else {
  503.     $list = $property{$userno, @pkg, $name};
  504.   }
  505.   if (defined($list)) {
  506.     if (wantarray) {
  507.       return &'array($list);
  508.     } else {
  509.       return (&'array($list))[0];
  510.     }
  511.   } else {
  512.     if (wantarray) {
  513.       return ();
  514.     } else {
  515.       return undef;
  516.     }
  517.   }
  518. }
  519.  
  520. sub 'expand {
  521.   local($name) = @_;
  522.   local($user, $rest, $home);
  523.   if ($name =~ /^\~([^\/]*)\/(.*)$/) {
  524.     ($user, $rest) = ($1, $2);
  525.     if ($user) {
  526.       $home = eval { (getpwnam($user))[7] } || '.';
  527.     } else {
  528.       $home = $ENV{'HOME'} || eval { (getpwuid($<))[7] } || '.';
  529.     }
  530.     return "$home/$rest";
  531.   } else {
  532.     return $name;
  533.   }
  534. }
  535.  
  536. sub 'date {
  537.   local($format) = @_;
  538.   local(@time, $tmp);
  539.   @time = localtime(time());
  540.   $tmp = sprintf('%02d', $time[3]);
  541.   $format =~ s/\%d/$tmp/g;
  542.   $tmp = sprintf('%02d', $time[2]);
  543.   $format =~ s/\%H/$tmp/g;
  544.   $tmp = sprintf('%02d', $time[2] % 12 + 1);
  545.   $format =~ s/\%I/$tmp/g;
  546.   $tmp = sprintf('%2d', $time[2]);
  547.   $format =~ s/\%k/$tmp/g;
  548.   $tmp = sprintf('%2d', $time[2] % 12 + 1);
  549.   $format =~ s/\%l/$tmp/g;
  550.   $tmp = sprintf('%03d', $time[7]);
  551.   $format =~ s/\%j/$tmp/g;
  552.   $tmp = sprintf('%02d', $time[4] + 1);
  553.   $format =~ s/\%m/$tmp/g;
  554.   $tmp = sprintf('%02d', $time[1]);
  555.   $format =~ s/\%M/$tmp/g;
  556.   $tmp = sprintf('%02d', $time[0]);
  557.   $format =~ s/\%S/$tmp/g;
  558.   $tmp = sprintf('%d', $time[6]);
  559.   $format =~ s/\%w/$tmp/g;
  560.   $tmp = sprintf('%02d', $time[5]);
  561.   $format =~ s/\%y/$tmp/g;
  562.   $tmp = sprintf('%d', $time[5] + 1900);
  563.   $format =~ s/\%Y/$tmp/g;
  564.   return $format;
  565. }
  566.  
  567. sub 'real {
  568.   local($name) = @_;
  569.   if ($name =~ /^\%(.*)$/) {
  570.     return "\#$1\:$ALIAS";
  571.   } else {
  572.     return $name;
  573.   }
  574. }
  575.  
  576. sub 'alias {
  577.   local($name) = @_;
  578.   if ($name =~ /^\#(.*)\:(.*)$/ && "\L$2\E" eq "\L$ALIAS\E") {
  579.     return "\%$1";
  580.   } else {
  581.     return $name;
  582.   }
  583. }
  584.  
  585. sub 'add {
  586.   local($list, @items) = @_;
  587.   $list = $; unless $list;
  588.   foreach $item (@items) {
  589.     next if &'exist($list, $item);
  590.     $list = "${list}${item}$;";
  591.   }
  592.   return $list;
  593. }
  594.  
  595. sub 'remove {
  596.   local($list, @items) = @_;
  597.   local($idx);
  598.   $list = $; unless $list;
  599.   foreach $item (@items) {
  600.     $idx = index("\L$list\E", "\L$;$item$;\E");
  601.     next if $idx == -1;
  602.     substr($list, $idx, length("$;$item$;")) = $;;
  603.   }
  604.   return $list;
  605. }
  606.  
  607. sub 'change {
  608.   local($list, @items) = @_;
  609.   local($old, $new, $idx, $i);
  610.   $list = $; unless $list;
  611.   for ($i = 0; $i < scalar(@items) / 2; $i++) {
  612.     ($old, $new) = @items[$i * 2, $i * 2 + 1];
  613.     next if ($idx = index("\L$list\E", "\L$;$old$;\E")) == -1;
  614.     substr($list, $idx, length("$;$old$;")) = "$;$new$;";
  615.   }
  616.   return $list;
  617. }
  618.  
  619. sub 'exist {
  620.   local($list, @items) = @_;
  621.   return 0 unless $list;
  622.   foreach $item (@items) {
  623.     return 1 if index("\L$list\E", "\L$;$item$;\E") != -1;
  624.   }
  625.   return 0;
  626. }
  627.  
  628. sub 'list {
  629.   local(@array) = @_;
  630.   local($list);
  631.   if (@array) {
  632.     $list = $; . join($;, @array) . $;;
  633.   } else {
  634.     $list = $;
  635.   }
  636.   return $list;
  637. }
  638.  
  639. sub 'array {
  640.   local($list) = @_;
  641.   $list = $; unless $list;
  642.   return () if $list eq $;;
  643.   $list = substr($list, 1, length($list) - 2);
  644.   return split(/$;/, $list);
  645. }
  646.  
  647. sub 'euc_jis {
  648.   local($euc) = @_;
  649.   local($jis, $kanji, $c, $n, $i);
  650.   $kanji = 0;
  651.   $jis = '';
  652.   for ($i = 0; $i < length($euc); $i++) {
  653.     $c = substr($euc, $i, 1);
  654.     $n = unpack('C', $c);
  655.     if ($n >= 0xa1) {
  656.       if ($kanji != 1) {
  657.         $jis .= "\e\$B";
  658.         $kanji = 1;
  659.       }
  660.       $jis .= pack('C', $n & 0x7f);
  661.       $i++;
  662.       $jis .= pack('C', unpack('C', substr($euc, $i, 1)) & 0x7f);
  663.     } elsif ($n == 0x8e) {
  664.       if ($kanji != 2) {
  665.         $jis .= "\e(I";
  666.         $kanji = 2;
  667.       }
  668.       $i++;
  669.       $jis .= pack('C', unpack('C', substr($euc, $i, 1)) & 0x7f);
  670.     } else {
  671.       if ($kanji != 0) {
  672.         $jis .= "\e\(B";
  673.         $kanji = 0;
  674.       }
  675.       $jis .= $c;
  676.     }
  677.   }
  678.   $jis .= "\e\(B" if $kanji != 0;
  679.   return $jis;
  680. }
  681.  
  682. sub 'euc_sjis {
  683.   local($euc) = @_;
  684.   local($sjis, $c, $n1, $n2, $i);
  685.   $sjis = '';
  686.   for ($i = 0; $i < length($euc); $i++) {
  687.     $c = substr($euc, $i, 1);
  688.     $n1 = unpack('C', $c);
  689.     if ($n1 >= 0xa1) {
  690.       $i++;
  691.       $n2 = unpack('C', substr($euc, $i, 1));
  692.       if (($n1 & 0x01) == 0) {
  693.         $n2 -= 0x03;
  694.       } else {
  695.         $n2 -= 0x61;
  696.       }
  697.       $n2++ if $n2 >= 0x7f;
  698.       $n1 = ($n1 - 0xa1 >> 1) + 0x81;
  699.       $sjis .= pack('CC', $n1, $n2);
  700.     } elsif ($n1 == 0x8e) {
  701.       $i++;
  702.       $sjis .= substr($euc, $i, 1);
  703.     } else {
  704.       $sjis .= $c;
  705.     }
  706.   }
  707.   return $sjis;
  708. }
  709.  
  710. sub 'jis_euc {
  711.   local($jis) = @_;
  712.   local($euc, $kanji, $i);
  713.   $jis = &'jis_jis($jis);
  714.   $kanji = 0;
  715.   $euc = '';
  716.   for ($i = 0; $i < length($jis); $i++) {
  717.     if (substr($jis, $i, 3) eq "\e\(B") {
  718.       $kanji = 0;
  719.       $i += 2;
  720.       next;
  721.     } elsif (substr($jis, $i, 3) eq "\e\$B") {
  722.       $kanji = 1;
  723.       $i += 2;
  724.       next;
  725.     } elsif (substr($jis, $i, 3) eq "\e\(I") {
  726.       $kanji = 2;
  727.       $i += 2;
  728.       next;
  729.     }
  730.     if ($kanji == 0) {
  731.       $euc .= substr($jis, $i, 1);
  732.     } elsif ($kanji == 1) {
  733.       $euc .= pack('C', unpack('C', substr($jis, $i, 1)) | 0x80);
  734.       $i++;
  735.       $euc .= pack('C', unpack('C', substr($jis, $i, 1)) | 0x80);
  736.     } else {
  737.       $euc .= "\x8e" . pack('C', unpack('C', substr($jis, $i, 1)) | 0x80);
  738.     }
  739.   }
  740.   return $euc;
  741. }
  742.  
  743. sub 'jis_jis {
  744.   local($jis) = @_;
  745.   $jis =~ s/\e\$\@/\e\$B/g;
  746.   $jis =~ s/\e\(J/\e\(B/g;
  747.   $jis =~ s/\cN/\e\(I/g;
  748.   $jis =~ s/\cO/\e\(B/g;
  749.   return $jis;
  750. }
  751.  
  752. sub 'jis_sjis {
  753.   local($jis) = @_;
  754.   local($sjis, $kanji, $n1, $n2, $i);
  755.   $jis = &'jis_jis($jis);
  756.   $kanji = 0;
  757.   $sjis = '';
  758.   for ($i = 0; $i < length($jis); $i++) {
  759.     if (substr($jis, $i, 3) eq "\e\(B") {
  760.       $kanji = 0;
  761.       $i += 2;
  762.       next;
  763.     } elsif (substr($jis, $i, 3) eq "\e\$B") {
  764.       $kanji = 1;
  765.       $i += 2;
  766.       next;
  767.     } elsif (substr($jis, $i, 3) eq "\e\(I") {
  768.       $kanji = 2;
  769.       $i += 2;
  770.       next;
  771.     }
  772.     if ($kanji == 0) {
  773.       $sjis .= substr($jis, $i, 1);
  774.     } elsif ($kanji == 1) {
  775.       $n1 = unpack('C', substr($jis, $i, 1));
  776.       $i++;
  777.       $n2 = unpack('C', substr($jis, $i, 1));
  778.       if (($n1 & 0x01) == 0) {
  779.         $n2 += 0x7d;
  780.       } else {
  781.         $n2 += 0x1f;
  782.       }
  783.       $n2++ if $n2 >= 0x7f;
  784.       $n1 = ($n1 - 0x21 >> 1) + 0x81;
  785.       $sjis .= pack('CC', $n1, $n2);
  786.     } else {
  787.       $sjis .= pack('C', unpack('C', substr($jis, $i, 1)) | 0x80);
  788.     }
  789.   }
  790.   return $sjis;
  791. }
  792.  
  793. sub 'sjis_euc {
  794.   local($sjis) = @_;
  795.   local($euc, $c, $n1, $n2, $i);
  796.   $euc = '';
  797.   for ($i = 0; $i < length($sjis); $i++) {
  798.     $c = substr($sjis, $i, 1);
  799.     $n1 = unpack('C', $c);
  800.     if ($n1 >= 0xa0 && $n1 <= 0xdf) {
  801.       $euc .= "\x8e$c";
  802.     } elsif ($n1 >= 0x81) {
  803.       $i++;
  804.       $n2 = unpack('C', substr($sjis, $i, 1));
  805.       $n2-- if $n2 > 0x7f;
  806.       if ($n2 >= 0x9e) {
  807.         $n1 = (($n1 - 0x81) << 1) + 0xa2;
  808.         $n2 += 0x03;
  809.       } else {
  810.         $n1 = (($n1 - 0x81) << 1) + 0xa1;
  811.         $n2 += 0x61
  812.       }
  813.       $euc .= pack('CC', $n1, $n2);
  814.     } else {
  815.       $euc .= $c;
  816.     }
  817.   }
  818.   return $euc;
  819. }
  820.  
  821. sub 'sjis_jis {
  822.   local($sjis) = @_;
  823.   local($jis, $kanji, $c, $n1, $n2, $i);
  824.   $kanji = 0;
  825.   $jis = '';
  826.   for ($i = 0; $i < length($sjis); $i++) {
  827.     $c = substr($sjis, $i, 1);
  828.     $n1 = unpack('C', $c);
  829.     if ($n1 >= 0xa0 && $n1 <= 0xdf) {
  830.       if ($kanji != 2) {
  831.         $jis .= "\e(I";
  832.         $kanji = 2;
  833.       }
  834.       $jis .= pack('C', $n1 & 0x7f);
  835.     } elsif ($n1 >= 0x81) {
  836.       if ($kanji != 1) {
  837.         $jis .= "\e\$B";
  838.         $kanji = 1;
  839.       }
  840.       $i++;
  841.       $n2 = unpack('C', substr($sjis, $i, 1));
  842.       $n2-- if $n2 > 0x7f;
  843.       if ($n2 >= 0x9e) {
  844.         $n1 = (($n1 - 0x81) << 1) + 0x22;
  845.         $n2 -= 0x7d;
  846.       } else {
  847.         $n1 = (($n1 - 0x81) << 1) + 0x21;
  848.         $n2 -= 0x1f;
  849.       }
  850.       $jis .= pack('CC', $n1, $n2);
  851.     } else {
  852.       if ($kanji != 0) {
  853.         $jis .= "\e\(B";
  854.         $kanji = 0;
  855.       }
  856.       $jis .= $c;
  857.     }
  858.   }
  859.   $jis .= "\e\(B" if $kanji != 0;
  860.   return $jis;
  861. }
  862.  
  863. sub 'connect {
  864.   local($host, $port) = @_;
  865.   local($serverno, $socket, $addr);
  866.   if ($host =~ /(\d+)\.(\d+)\.(\d+)\.(\d+)/) {
  867.     $addr = pack('C4', $1, $2, $3, $4);
  868.   } elsif ($host =~ /^\d+$/) {
  869.     $addr = pack('N', $host);
  870.   } else {
  871.     $addr = (gethostbyname($host))[4];
  872.   }
  873.   return 0 unless defined($addr);
  874.   $socket = '\'S' . ++$handle;
  875.   socket($socket, $PF_INET, $SOCK_STREAM, $PROTO) || return 0;
  876.   connect($socket, pack($SOCKADDR, $AF_INET, $port, $addr)) || return 0;
  877.   $serverno = fileno($socket);
  878.   vec($'rin, $serverno, 1) = 1;
  879.   $'socket[$serverno] = $socket;
  880.   select((select($socket), $| = 1)[0]);
  881.   $rbuf[$serverno] = '';
  882.   $wbuf[$serverno] = '';
  883.   return $serverno;
  884. }
  885.  
  886. sub 'listen {
  887.   local($port, $count) = @_;
  888.   local($listenno, $socket);
  889.   $socket = '\'L' . ++$handle;
  890.   socket($socket, $PF_INET, $SOCK_STREAM, $PROTO) || return 0;
  891.   setsockopt($socket, $SOL_SOCKET, $SO_REUSEADDR, pack('l', 1)) if defined($SOL_SOCKET) && defined($SO_REUSEADDR);
  892.   bind($socket, pack($SOCKADDR, $AF_INET, $port, $INADDR_ANY)) || return 0;
  893.   listen($socket, $count || $SOMAXCONN) || return 0;
  894.   $listenno = fileno($socket);
  895.   vec($'rin, $listenno, 1) = 1;
  896.   $'socket[$listenno] = $socket;
  897.   select((select($socket), $| = 1)[0]);
  898.   return $listenno;
  899. }
  900.  
  901. sub 'accept {
  902.   local($listenno) = @_;
  903.   local($clientno, $socket);
  904.   $socket = '\'C' . ++$handle;
  905.   accept($socket, $'socket[$listenno]) || return 0;
  906.   $clientno = fileno($socket);
  907.   vec($'rin, $clientno, 1) = 1;
  908.   $'socket[$clientno] = $socket;
  909.   select((select($socket), $| = 1)[0]);
  910.   $rbuf[$clientno] = '';
  911.   $wbuf[$clientno] = '';
  912.   return $clientno;
  913. }
  914.  
  915. sub 'close {
  916.   local($no) = @_;
  917.   close($'socket[$no]);
  918.   vec($'rin, $no, 1) = 0;
  919. }
  920.  
  921. sub 's_connect {
  922.   local($userno) = @_;
  923.   local($server, $host, $name, $port, $pass, $serverno);
  924.   return if $'server[$userno];
  925.   foreach $server (&'property($userno, 'server')) {
  926.     next if &'exist($errorlist[$userno], $server);
  927.     ($host, $pass) = (split(/\s+/, $server), '');
  928.     ($name, $port) = (split(/\:/, $host), '');
  929.     $serverno = &'connect($name, $port || $IRCPORT);
  930.     next unless $serverno;
  931.     $'serverlist = &'add($'serverlist, $serverno);
  932.     $'avail[$serverno] = 0;
  933.     $'userno[$serverno] = $userno;
  934.     $'server[$userno] = $serverno;
  935.     $pass[$serverno] = $pass;
  936.     $serverhost[$serverno] = $server;
  937.     &s_init($serverno);
  938.     last;
  939.   }
  940.   $'servername[$userno] = $NAME;
  941.   $errorlist[$userno] = $; unless $host;
  942. }
  943.  
  944. sub 's_close {
  945.   local($userno) = @_;
  946.   local($serverno, $sub, $label);
  947.   $serverno = $'server[$userno];
  948.   &'s_flush($serverno);
  949.   &'close($serverno);
  950.   foreach $module (reverse(&'array($'modulelist[$userno]))) {
  951.     $sub = "${module}\'server_close";
  952.     next unless defined(&$sub);
  953.     if ($'labellist{$module}) {
  954.       foreach $label (&'array($'labellist{$module})) {
  955.        &$sub($serverno);
  956.       }
  957.     } else {
  958.       &$sub($serverno);
  959.     }
  960.   }
  961.   $'serverlist = &'remove($'serverlist, $serverno);
  962.   $'avail[$serverno] = 0;
  963.   $'userno[$serverno] = undef;
  964.   $'server[$userno] = undef;
  965.   $'servername[$userno] = $NAME;
  966. }
  967.  
  968. sub c_listen {
  969.   local($userno) = @_;
  970.   local($listenno, $host, $pass, $name, $port);
  971.   foreach $client (&'property($userno, 'client')) {
  972.     ($host, $pass) = (split(/\s+/, $client), '');
  973.     ($name, $port) = (split(/\:/, $host), $IRCPORT);
  974.     next if &'exist($portlist, $port || $IRCPORT);
  975.     $listenno = &'listen($port || $IRCPORT, $SOMAXCONN);
  976.     next unless $listenno;
  977.     $'listenlist = &'add($'listenlist, $listenno);
  978.     $portlist = &'add($portlist, $port || $IRCPORT);
  979.   }
  980. }
  981.  
  982. sub c_accept {
  983.   local($listenno) = @_;
  984.   local($clientno, $addr, $name, $port, $host, $pass, $regex, $i);
  985.   $clientno = &'accept($listenno);
  986.   return unless $clientno;
  987.   ($port, $addr) = (unpack($SOCKADDR, getpeername($'socket[$clientno])))[1, 2];
  988.   $name = (gethostbyaddr($addr, $AF_INET))[0];
  989.   for ($i = 0; $i < scalar(@'username); $i++) {
  990.     foreach $client (&'property($i, 'client')) {
  991.       ($host, $pass) = (split(/\s+/, $client), '');
  992.       next unless $port == (split(/\:/, $host))[1] || $IRCPORT;
  993.       $regex = &'regex((split(/\:/, $host))[0]);
  994.       next unless $name =~ /$regex/i;
  995.       $'clientlist = &'add($'clientlist, $clientno);
  996.       $'avail[$clientno] = 0;
  997.       $'nick[$clientno] = '';
  998.       $'user[$clientno] = '';
  999.       $pass[$clientno] = '';
  1000.       return;
  1001.     }
  1002.   }
  1003.   &'close($clientno);
  1004. }
  1005.  
  1006. sub 'c_close {
  1007.   local($clientno) = @_;
  1008.   local($sub, $label);
  1009.   &'c_flush($clientno);
  1010.   &'close($clientno);
  1011.   $'clientlist = &'remove($'clientlist, $clientno);
  1012.   if ($'avail[$clientno]) {
  1013.     foreach $module (reverse(&'array($'modulelist[$'userno[$clientno]]))) {
  1014.       $sub = "${module}\'client_close";
  1015.       next unless defined(&$sub);
  1016.       if ($'labellist{$module}) {
  1017.         foreach $label (&'array($'labellist{$module})) {
  1018.           &$sub($clientno);
  1019.         }
  1020.       } else {
  1021.         &$sub($clientno);
  1022.       }
  1023.     }
  1024.     $'avail[$clientno] = 0;
  1025.   }
  1026.   $'userno[$clientno] = undef;
  1027. }
  1028.  
  1029. sub s_init {
  1030.   local($serverno) = @_;
  1031.   local($userno, $nick, $user, $name);
  1032.   $userno = $'userno[$serverno];
  1033.   &'s_print($serverno, '', 'PASS', $pass[$serverno]) if $pass[$serverno];
  1034.   $nick = $'nickname[$userno] || &'property($userno, 'nick') || getlogin() || eval { (getpwuid($<))[0] } || "$NAME-user";
  1035.   &'s_print($serverno, '', 'NICK', (split(/\,/, $nick))[0]);
  1036.   $user = &'property($userno, 'user') || getlogin() || eval { (getpwuid($<))[0] } || "$NAME-user";
  1037.   $name = &'property($userno, 'name');
  1038.   $name = eval { ((split(/\,/, (getpwuid($<))[6]))[0]) } || $user unless defined($name);
  1039.   &'s_print($serverno, '', 'USER', $user, '*', '*', $name);
  1040. }
  1041.  
  1042. sub c_init {
  1043.   local($clientno) = @_;
  1044.   local($addr, $name, $port, $host, $pass, $regex, $sub, $label, $i);
  1045.   ($port, $addr) = (unpack($SOCKADDR, getpeername($'socket[$clientno])))[1, 2];
  1046.   $name = (gethostbyaddr($addr, $AF_INET))[0];
  1047.   for ($i = 0; $i < scalar(@'username); $i++) {
  1048.     foreach $client (&'property($i, 'client')) {
  1049.       ($host, $pass) = (split(/\s+/, $client), '');
  1050.       next unless $port == (split(/\:/, $host))[1] || $IRCPORT;
  1051.       $regex = &'regex((split(/\:/, $host))[0]);
  1052.       next unless $name =~ /$regex/i;
  1053.       next if $pass && $pass ne $pass[$clientno];
  1054.       $'userno[$clientno] = $i;
  1055.       $'avail[$clientno] = 1;
  1056.       &'c_print($clientno, $'servername[$'userno[$clientno]], '001', $'nick[$clientno], 'Welcome to the Internet Relay Network ' . &'user($clientno));
  1057.       foreach $module (&'array($'modulelist[$'userno[$clientno]])) {
  1058.         $sub = "${module}\'client_open";
  1059.         next unless defined(&$sub);
  1060.         if ($'labellist{$module}) {
  1061.           foreach $label (&'array($'labellist{$module})) {
  1062.             &$sub($clientno);
  1063.           }
  1064.         } else {
  1065.           &$sub($clientno);
  1066.         }
  1067.       }
  1068.       return;
  1069.     }
  1070.   }
  1071.   &'c_print($clientno, $NAME, '464', $'nick[$clientno], 'Password incorrect');
  1072.   &'c_print($clientno, '', 'ERROR', 'Closing Link: ' . &'user($clientno) . " (Bad Password)");
  1073.   &'c_close($clientno);
  1074. }
  1075.  
  1076. sub cn_nick {
  1077.   local($clientno, $prefix, $cmd, $nick) = @_;
  1078.   $'nick[$clientno] = $nick;
  1079.   &c_init($clientno) if $'user[$clientno];
  1080. }
  1081.  
  1082. sub cn_pass {
  1083.   local($clientno, $prefix, $cmd, $pass) = @_;
  1084.   $pass[$clientno] = $pass;
  1085. }
  1086.  
  1087. sub cn_ping {
  1088.   local($clientno, $prefix, $cmd, @params) = @_;
  1089.   &'c_print($clientno, &'user($clientno), '451', 'PING', 'You have not registered');
  1090. }
  1091.  
  1092. sub cn_quit {
  1093.   local($clientno, $prefix, $cmd, $msg) = @_;
  1094.   $msg = 'I Quit' unless $msg;
  1095.   &'c_print($clientno, '', 'ERROR', 'Closing Link: ' . &'user($clientno) . " ($msg)");
  1096.   &'c_close($clientno);
  1097. }
  1098.  
  1099. sub cn_user {
  1100.   local($clientno, $prefix, $cmd, @params) = @_;
  1101.   if (defined(@params) && scalar(@params) >= 4) {
  1102.     $'user[$clientno] = $params[0];
  1103.     &c_init($clientno) if $'nick[$clientno];
  1104.   } else {
  1105.     &'c_print($clientno, $NAME, '461', 'Not enough parameters');
  1106.   }
  1107. }
  1108.  
  1109. sub sn_error {
  1110.   local($serverno, $prefix, $cmd, @params) = @_;
  1111.   $errorlist[$'userno[$serverno]] = &'add($errorlist[$'userno[$serverno]], $serverhost[$serverno]);
  1112. }
  1113.  
  1114. sub sn_ping {
  1115.   local($serverno, $prefix, $cmd, @params) = @_;
  1116.   &'s_print($serverno, '', 'PONG', @params);
  1117. }
  1118.  
  1119. sub sn_001 {
  1120.   local($serverno, $prefix, $cmd, $nick, $msg) = @_;
  1121.   local($userno, $sub, $label);
  1122.   $userno = $'userno[$serverno];
  1123.   $'avail[$serverno] = 1;
  1124.   $'nick[$serverno] = $nick;
  1125.   $'nickname[$userno] = $nick;
  1126.   $'servername[$userno] = $prefix;
  1127.   $errorlist[$userno] = $;;
  1128.   foreach $module (&'array($'modulelist[$userno])) {
  1129.     $sub = "${module}\'server_open";
  1130.     next unless defined(&$sub);
  1131.     if ($'labellist{$module}) {
  1132.       foreach $label (&'array($'labellist{$module})) {
  1133.         &$sub($serverno);
  1134.       }
  1135.     } else {
  1136.       &$sub($serverno);
  1137.     }
  1138.   }
  1139. }
  1140.  
  1141. sub sn_433 {
  1142.   local($serverno, $prefix, $cmd, $nick, $newnick, $msg) = @_;
  1143.   &anothernick($serverno, $newnick);
  1144. }
  1145.  
  1146. sub sn_437 {
  1147.   local($serverno, $prefix, $cmd, $nick, $newnick, $msg) = @_;
  1148.   &anothernick($serverno, $newnick);
  1149. }
  1150.  
  1151. sub sn_451 {
  1152.   local($serverno, $prefix, $cmd, @params) = @_;
  1153. }
  1154.  
  1155. sub anothernick {
  1156.   local($serverno, $newnick) = @_;
  1157.   local(@nickentry, $list, $user);
  1158.   foreach $nick (&'property($'userno[$serverno], 'nick')) {
  1159.     $list = &'add($list, split(/\,/, $nick));
  1160.   }
  1161.   $list = &'add($list, getlogin() || eval { (getpwuid($<))[0] });
  1162.   $user = substr(getlogin() || eval { (getpwuid($<))[0] } || "$NAME-user", 0, 8);
  1163.   $list = &'add($list, "${user}_", "_${user}", "${user}-", "-${user}");
  1164.   if (&'exist($list, $newnick)) {
  1165.     @nickentry = &'array($list);
  1166.     while ($nickentry[0] ne $newnick) {
  1167.       push(@nickentry, shift(@nickentry));
  1168.     }
  1169.     push(@nickentry, shift(@nickentry));
  1170.   }
  1171.   &'s_print($serverno, '', 'NICK', $nickentry[0]);
  1172. }
  1173.  
  1174. sub main_loop {
  1175.   local($userno) = @_;
  1176.   &'s_connect($userno);
  1177.   &c_listen($userno);
  1178. }
  1179.  
  1180. sub client_open {
  1181.   local($clientno) = @_;
  1182.   local($userno, $serverno);
  1183.   $userno = $'userno[$clientno];
  1184.   $serverno = $'server[$userno];
  1185.   &'c_print($clientno, &'user($clientno), 'NICK', $'nick[$serverno]) if ($serverno && $'avail[$serverno] && $'nick[$clientno] ne $'nick[$serverno]);
  1186.   &'c_print($clientno, $'servername[$userno], '002', $'nick[$clientno], &'array($msg002[$userno])) if $msg002[$userno];
  1187.   &'c_print($clientno, $'servername[$userno], '003', $'nick[$clientno], &'array($msg003[$userno])) if $msg003[$userno];
  1188.   &'c_print($clientno, $'servername[$userno], '004', $'nick[$clientno], &'array($msg004[$userno])) if $msg004[$userno];
  1189.   foreach $chan (&'array($'channellist[$userno])) {
  1190.     &'c_print($clientno, &'user($clientno), 'JOIN', $chan);
  1191.     &'c_print($clientno, $'servername[$userno], '332', $'nick[$clientno], $chan, $'topic{$userno, $chan}) if $'topic{$userno, $chan};
  1192.     &'c_print($clientno, $'servername[$userno], '353', $'nick[$clientno], '=', $chan, join(' ', reverse(&'array($'nameslist{$userno, $chan}))));
  1193.     &'c_print($clientno, $'servername[$userno], '366', $'nick[$clientno], $chan, 'End of /NAMES list.');
  1194.   }
  1195. }
  1196.  
  1197. sub server_open {
  1198.   local($serverno) = @_;
  1199.   $'channellist[$'userno[$serverno]] = $;;
  1200.   foreach $cno (&'array($'clientlist)) {
  1201.     next unless $'avail[$cno];
  1202.     next unless $'userno[$cno] == $'userno[$serverno];
  1203.     next unless $'nick[$cno] ne $'nick[$serverno];
  1204.     &'c_print($cno, &'user($cno), 'NICK', $'nick[$serverno]);
  1205.   }
  1206. }
  1207.  
  1208. sub server_close {
  1209.   local($serverno) = @_;
  1210.   local($userno);
  1211.   $userno = $'userno[$serverno];
  1212.   foreach $cno (&'array($'clientlist)) {
  1213.     next unless $'avail[$cno];
  1214.     next unless $'userno[$cno] == $userno;
  1215.     &'c_print($cno, $'servername[$userno], 'ERROR', $'nick[$cno], "Closing Link: $'servername[$userno]");
  1216.   }
  1217.   $msg002[$userno] = '';
  1218.   $msg003[$userno] = '';
  1219.   $msg004[$userno] = '';
  1220. }
  1221.  
  1222. sub cs_exit {
  1223.   local($clientno, $prefix, $cmd, $msg) = @_;
  1224.   foreach $sno (&'array($'serverlist)) {
  1225.     &'s_print($sno, '', 'QUIT', $msg || $NAME);
  1226.   }
  1227.   $msg = 'I Quit' unless $msg;
  1228.   foreach $cno (&'array($'clientlist)) {
  1229.     &'c_print($cno, '', 'ERROR', 'Closing Link: ' . &'user($cno) . " ($msg)");
  1230.     &'c_close($cno);
  1231.   }
  1232.   foreach $lno (&'array($'listenlist)) {
  1233.     &'close($lno);
  1234.   }
  1235.   exit(0);
  1236. }
  1237.  
  1238. sub cs_quit {
  1239.   local($clientno, $prefix, $cmd, $msg) = @_;
  1240.   $msg = 'I Quit' unless $msg;
  1241.   &'c_print($clientno, '', 'ERROR', 'Closing Link: ' . &'user($clientno) . " ($msg)");
  1242.   &'c_close($clientno);
  1243.   return ();
  1244. }
  1245.  
  1246. sub cp_nick {
  1247.   local($clientno, $prefix, $cmd, $newnick) = @_;
  1248.   $'nick[$clientno] = $newnick if &'prefix($prefix) eq $'nick[$clientno];
  1249.   return ($prefix, $cmd, $newnick);
  1250. }
  1251.  
  1252. sub ss_join {
  1253.   local($serverno, $prefix, $cmd, $chan) = @_;
  1254.   local($userno, $nick, $name, $mode);
  1255.   $userno = $'userno[$serverno];
  1256.   $nick = &'prefix($prefix);
  1257.   ($name, $mode) = (split(/\cG/, $chan), '');
  1258.   if ($nick eq $'nick[$serverno]) {
  1259.     $'channellist[$userno] = &'add($'channellist[$userno], $name);
  1260.     $'nameslist{$userno, $name} = $;
  1261.   } else {
  1262.     if (index($mode, 'o') != -1) {
  1263.       $'nameslist{$userno, $name} = &'add($'nameslist{$userno, $name}, "\@$nick");
  1264.     } elsif (index($mode, 'v') != -1) {
  1265.       $'nameslist{$userno, $name} = &'add($'nameslist{$userno, $name}, "\+$nick");
  1266.     } else {
  1267.       $'nameslist{$userno, $name} = &'add($'nameslist{$userno, $name}, $nick);
  1268.     }
  1269.   }
  1270.   return ($prefix, $cmd, $chan);
  1271. }
  1272.  
  1273. sub ss_kick {
  1274.   local($serverno, $prefix, $cmd, $chan, $who, $msg) = @_;
  1275.   local($userno);
  1276.   $userno = $'userno[$serverno];
  1277.   if ($who eq $'nick[$serverno]) {
  1278.     $'channellist[$userno] = &'remove($'channellist[$userno], $chan);
  1279.     delete $'nameslist{$userno, $chan};
  1280.   } else {
  1281.     $'nameslist{$userno, $chan} = &'remove($'nameslist{$userno, $chan}, $who, "+$who", "\@$who");
  1282.   }
  1283.   return ($prefix, $cmd, $chan, $who, $msg);
  1284. }
  1285.  
  1286. sub ss_mode {
  1287.   local($serverno, $prefix, $cmd, @params) = @_;
  1288.   local($chan, $mode, @modes, $userno, $flag, $name);
  1289.   ($chan, $mode, @modes) = @params;
  1290.   $userno = $'userno[$serverno];
  1291.   foreach $char (split(//, $mode)) {
  1292.     if ($char eq '+' || $char eq '-') {
  1293.       $flag = $char;
  1294.     } elsif ($char eq 'b') {
  1295.       shift(@modes);
  1296.     } elsif ($char eq 'k') {
  1297.       if ($flag eq '+') {
  1298.         $'channelmode{$userno, $chan, $char} = shift(@modes);
  1299.       } else {
  1300.         shift(@modes);
  1301.         delete $'channelmode{$userno, $chan, $char};
  1302.       }
  1303.     } elsif ($char eq 'l') {
  1304.       if ($flag eq '+') {
  1305.         $'channelmode{$userno, $chan, $char} = shift(@modes);
  1306.       } else {
  1307.         delete $'channelmode{$userno, $chan, $char};
  1308.       }
  1309.     } elsif ($char eq 'o') {
  1310.       $name = shift(@modes);
  1311.       if ($flag eq '+') {
  1312.         $'nameslist{$userno, $chan} = &'change($'nameslist{$userno, $chan}, $name, "\@$name", "+$name", "\@$name");
  1313.       } elsif ($flag eq '-') {
  1314.         $'nameslist{$userno, $chan} = &'change($'nameslist{$userno, $chan}, "\@$name", $name);
  1315.       }
  1316.     } elsif ($char eq 'v') {
  1317.       $name = shift(@modes);
  1318.       if ($flag eq '+') {
  1319.         $'nameslist{$userno, $chan} = &'change($'nameslist{$userno, $chan}, $name, "+$name");
  1320.       } elsif ($flag eq '-') {
  1321.         $'nameslist{$userno, $chan} = &'change($'nameslist{$userno, $chan}, "+$name", $name);
  1322.       }
  1323.     } else {
  1324.       if ($flag eq '+') {
  1325.         $'channelmode{$userno, $chan, $char} = 1;
  1326.       } else {
  1327.         delete $'channelmode{$userno, $chan, $char};
  1328.       }        
  1329.     }
  1330.   }
  1331.   return ($prefix, $cmd, @params);
  1332. }
  1333.  
  1334. sub ss_nick {
  1335.   local($serverno, $prefix, $cmd, $newnick) = @_;
  1336.   local($userno, $nick);
  1337.   $userno = $'userno[$serverno];
  1338.   $nick = &'prefix($prefix);
  1339.   if ($nick eq $'nick[$serverno]) {
  1340.     $'nick[$serverno] = $newnick;
  1341.     $'nickname[$userno] = $newnick;
  1342.   }
  1343.   foreach $chan (&'array($'channellist[$userno])) {
  1344.     $'nameslist{$userno, $chan} = &'change($'nameslist{$userno, $chan}, $nick, $newnick, "+$nick", "+$newnick", "\@$nick", "\@$newnick");
  1345.   }
  1346.   return ($prefix, $cmd, $newnick);
  1347. }
  1348.  
  1349. sub ss_part {
  1350.   local($serverno, $prefix, $cmd, $chan, $msg) = @_;
  1351.   local($userno, $nick);
  1352.   $userno = $'userno[$serverno];
  1353.   $nick = &'prefix($prefix);
  1354.   if ($nick eq $'nick[$serverno]) {
  1355.     $'channellist[$userno] = &'remove($'channellist[$userno], $chan);
  1356.     delete $'nameslist{$userno, $chan};
  1357.   } else {
  1358.     $'nameslist{$userno, $chan} = &'remove($'nameslist{$userno, $chan}, $nick, "+$nick", "\@$nick");
  1359.   }
  1360.   return ($prefix, $cmd, $chan, $msg);
  1361. }
  1362.  
  1363. sub ss_ping {
  1364.   local($serverno, $prefix, $cmd, @params) = @_;
  1365.   &'s_print($serverno, '', 'PONG', @params);
  1366.   return ($prefix, $cmd, @params);
  1367. }
  1368.  
  1369. sub ss_quit {
  1370.   local($serverno, $prefix, $cmd, $msg) = @_;
  1371.   local($userno, $nick);
  1372.   $userno = $'userno[$serverno];
  1373.   $nick = &'prefix($prefix);
  1374.   foreach $chan (&'array($'channellist[$userno])) {
  1375.     $'nameslist{$userno, $chan} = &'remove($'nameslist{$userno, $chan}, $nick, "+$nick", "\@$nick");
  1376.   }
  1377.   return ($prefix, $cmd, $msg);
  1378. }
  1379.  
  1380. sub ss_topic {
  1381.   local($serverno, $prefix, $cmd, $chan, $topic) = @_;
  1382.   $'topic{$'userno[$serverno], $chan} = $topic;
  1383.   return ($prefix, $cmd, $chan, $topic);
  1384. }
  1385.  
  1386. sub ss_002 {
  1387.   local($serverno, $prefix, $cmd, $nick, @params) = @_;
  1388.   $msg002[$'userno[$serverno]] = &'list(@params);
  1389.   return ($prefix, $cmd, $nick, $msg);
  1390. }
  1391.  
  1392. sub ss_003 {
  1393.   local($serverno, $prefix, $cmd, $nick, @params) = @_;
  1394.   $msg003[$'userno[$serverno]] = &'list(@params);
  1395.   return ($prefix, $cmd, $nick, $msg);
  1396. }
  1397.  
  1398. sub ss_004 {
  1399.   local($serverno, $prefix, $cmd, $nick, @params) = @_;
  1400.   $msg004[$'userno[$serverno]] = &'list(@params);
  1401.   return ($prefix, $cmd, $nick, $msg);
  1402. }
  1403.  
  1404. sub ss_332 {
  1405.   local($serverno, $prefix, $cmd, $nick, $chan, $topic) = @_;
  1406.   $'topic{$'userno[$serverno], $chan} = $topic;
  1407.   return ($prefix, $cmd, $nick, $chan, $topic);
  1408. }
  1409.  
  1410. sub ss_353 {
  1411.   local($serverno, $prefix, $cmd, @params) = @_;
  1412.   local($userno);
  1413.   $userno = $'userno[$serverno];
  1414.   $'nameslist{$userno, $params[2]} = &'add($'nameslist{$userno, $params[2]}, reverse(split(/\s+/, $params[3])));
  1415.   return ($prefix, $cmd, @params);
  1416. }
  1417.  
  1418. sub cs_privmsg {
  1419.   local($clientno, $prefix, $cmd, $chan, $msg) = @_;
  1420.   local($tmp, $ctmp, $rest, $ctcp, $list);
  1421.   return () unless $msg;
  1422.   $tmp = $ctmp = '';
  1423.   $rest = $msg;
  1424.   while ($rest =~ /^(.*)\cA([^\cA]*)\cA(.*)$/) {
  1425.     $tmp .= $1;
  1426.     $ctmp .= $1;
  1427.     $ctcp = $2;
  1428.     $rest = $3;
  1429.     $tmp .= &cpc_scan($clientno, $prefix, $ctcp) unless &'exist($list, $ctcp);
  1430.     $list = &'add($list, $ctcp);
  1431.   }
  1432.   $tmp .= $rest || '';
  1433.   $ctmp .= $rest || '';
  1434.   return () unless $tmp;
  1435.   foreach $cno (&'array($'clientlist)) {
  1436.     next unless $clientno != $cno;
  1437.     next unless $'avail[$cno];
  1438.     next unless $'userno[$clientno] == $'userno[$cno];
  1439.     &'c_print($cno, &'user($cno), $cmd, $chan, $ctmp);
  1440.   }
  1441.   return ($prefix, $cmd, $chan, $tmp);
  1442. }
  1443.  
  1444. sub cp_privmsg {
  1445.   local($clientno, $prefix, $cmd, $chan, $msg) = @_;
  1446.   local($tmp, $rest, $ctcp, $list);
  1447.   return () unless $msg;
  1448.   $tmp = '';
  1449.   $rest = $msg;
  1450.   while ($rest =~ /^(.*)\cA([^\cA]*)\cA(.*)$/) {
  1451.     $tmp .= $1;
  1452.     $ctcp = $2;
  1453.     $rest = $3;
  1454.     $tmp .= &cpc_print($clientno, $prefix, $ctcp) unless &'exist($list, $ctcp);
  1455.     $list = &'add($list, $ctcp);
  1456.   }
  1457.   $tmp .= $rest || '';
  1458.   return () unless $tmp;
  1459.   return ($prefix, $cmd, $chan, $tmp);
  1460. }
  1461.  
  1462. sub ss_privmsg {
  1463.   local($serverno, $prefix, $cmd, $chan, $msg) = @_;
  1464.   local($tmp, $rest, $ctcp, $list);
  1465.   return () unless $msg;
  1466.   $tmp = '';
  1467.   $rest = $msg;
  1468.   while ($rest =~ /^(.*)\cA([^\cA]*)\cA(.*)$/) {
  1469.     $tmp .= $1;
  1470.     $ctcp = $2;
  1471.     $rest = $3;
  1472.     $tmp .= &cps_scan($serverno, $prefix, $ctcp) unless &'exist($list, $ctcp);
  1473.     $list = &'add($list, $ctcp);
  1474.   }
  1475.   $tmp .= $rest || '';
  1476.   return () unless $tmp;
  1477.   return ($prefix, $cmd, $chan, $tmp);
  1478. }
  1479.  
  1480. sub sp_privmsg {
  1481.   local($serverno, $prefix, $cmd, $chan, $msg) = @_;
  1482.   local($tmp, $rest, $ctcp, $list);
  1483.   return () unless $msg;
  1484.   $tmp = '';
  1485.   $rest = $msg;
  1486.   while ($rest =~ /^(.*)\cA([^\cA]*)\cA(.*)$/) {
  1487.     $tmp .= $1;
  1488.     $ctcp = $2;
  1489.     $rest = $3;
  1490.     $tmp .= &cps_print($serverno, $prefix, $ctcp) unless &'exist($list, $ctcp);
  1491.     $list = &'add($list, $ctcp);
  1492.   }
  1493.   $tmp .= $rest || '';
  1494.   return () unless $tmp;
  1495.   return ($prefix, $cmd, $chan, $tmp);
  1496. }
  1497.  
  1498. sub cpc_scan {
  1499.   local($clientno, $prefix, $ctcp) = @_;
  1500.   local($cmd, $msg, $sub, $label);
  1501.   ($cmd, $msg) = (split(/\s+/, $ctcp, 2), '');
  1502.   return '' unless $cmd;
  1503.   foreach $module (&'array($'modulelist[$'userno[$clientno]])) {
  1504.     $sub = "${module}\'cpcs_\L$cmd\E";
  1505.     next unless defined(&$sub);
  1506.     if ($'labellist{$module}) {
  1507.       foreach $label (&'array($'labellist{$module})) {
  1508.         ($prefix, $cmd, $msg) = &$sub($clientno, $prefix, $cmd, $msg);
  1509.         last unless $cmd;
  1510.       }
  1511.     } else {
  1512.       ($prefix, $cmd, $msg) = &$sub($clientno, $prefix, $cmd, $msg);
  1513.     }
  1514.     last unless $cmd;
  1515.   }
  1516.   return '' unless $cmd;
  1517.   return "\cA$cmd $msg\cA";
  1518. }
  1519.  
  1520. sub cpc_print {
  1521.   local($clientno, $prefix, $ctcp) = @_;
  1522.   local($cmd, $msg, $sub, $label);
  1523.   ($cmd, $msg) = (split(/\s+/, $ctcp, 2), '');
  1524.   return '' unless $cmd;
  1525.   foreach $module (&'array($'modulelist[$'userno[$clientno]])) {
  1526.     $sub = "${module}\'cpcp_\L$cmd\E";
  1527.     next unless defined(&$sub);
  1528.     if ($'labellist{$module}) {
  1529.       foreach $label (&'array($'labellist{$module})) {
  1530.         ($prefix, $cmd, $msg) = &$sub($clientno, $prefix, $cmd, $msg);
  1531.         last unless $cmd;
  1532.       }
  1533.     } else {
  1534.       ($prefix, $cmd, $msg) = &$sub($clientno, $prefix, $cmd, $msg);
  1535.     }
  1536.     last unless $cmd;
  1537.   }
  1538.   return '' unless $cmd;
  1539.   return "\cA$cmd $msg\cA";
  1540. }
  1541.  
  1542. sub cps_scan {
  1543.   local($serverno, $prefix, $ctcp) = @_;
  1544.   local($cmd, $msg, $sub, $label);
  1545.   ($cmd, $msg) = (split(/\s+/, $ctcp, 2), '');
  1546.   return '' unless $cmd;
  1547.   foreach $module (&'array($'modulelist[$'userno[$serverno]])) {
  1548.     $sub = "${module}\'cpss_\L$cmd\E";
  1549.     next unless defined(&$sub);
  1550.     if ($'labellist{$module}) {
  1551.       foreach $label (&'array($'labellist{$module})) {
  1552.         ($prefix, $cmd, $msg) = &$sub($serverno, $prefix, $cmd, $msg);
  1553.         last unless $cmd;
  1554.       }
  1555.     } else {
  1556.       ($prefix, $cmd, $msg) = &$sub($serverno, $prefix, $cmd, $msg);
  1557.     }
  1558.     last unless $cmd;
  1559.   }
  1560.   return '' unless $cmd;
  1561.   return "\cA$cmd $msg\cA";
  1562. }
  1563.  
  1564. sub cps_print {
  1565.   local($serverno, $prefix, $ctcp) = @_;
  1566.   local($cmd, $msg, $sub, $label);
  1567.   ($cmd, $msg) = (split(/\s+/, $ctcp, 2), '');
  1568.   return '' unless $cmd;
  1569.   foreach $module (&'array($'modulelist[$'userno[$serverno]])) {
  1570.     $sub = "${module}\'cpsp_\L$cmd\E";
  1571.     next unless defined(&$sub);
  1572.     if ($'labellist{$module}) {
  1573.       foreach $label (&'array($'labellist{$module})) {
  1574.         ($prefix, $cmd, $msg) = &$sub($serverno, $prefix, $cmd, $msg);
  1575.         last unless $cmd;
  1576.       }
  1577.     } else {
  1578.       ($prefix, $cmd, $msg) = &$sub($serverno, $prefix, $cmd, $msg);
  1579.     }
  1580.     last unless $cmd;
  1581.   }
  1582.   return '' unless $cmd;
  1583.   return "\cA$cmd $msg\cA";
  1584. }
  1585.  
  1586. sub cs_notice {
  1587.   local($clientno, $prefix, $cmd, $chan, $msg) = @_;
  1588.   local($tmp, $ctmp, $rest, $ctcp, $list);
  1589.   return () unless $msg;
  1590.   $tmp = $ctmp = '';
  1591.   $rest = $msg;
  1592.   while ($rest =~ /^(.*)\cA([^\cA]*)\cA(.*)$/) {
  1593.     $tmp .= $1;
  1594.     $ctmp .= $1;
  1595.     $ctcp = $2;
  1596.     $rest = $3;
  1597.     $tmp .= &cnc_scan($clientno, $prefix, $ctcp) unless &'exist($list, $ctcp);
  1598.     $list = &'add($list, $ctcp);
  1599.   }
  1600.   $tmp .= $rest || '';
  1601.   $ctmp .= $rest || '';
  1602.   return () unless $tmp;
  1603.   foreach $cno (&'array($'clientlist)) {
  1604.     next unless $clientno != $cno;
  1605.     next unless $'avail[$cno];
  1606.     next unless $'userno[$clientno] == $'userno[$cno];
  1607.     &'c_print($cno, &'user($cno), $cmd, $chan, $ctmp);
  1608.   }
  1609.   return ($prefix, $cmd, $chan, $tmp);
  1610. }
  1611.  
  1612. sub cp_notice {
  1613.   local($clientno, $prefix, $cmd, $chan, $msg) = @_;
  1614.   local($tmp, $rest, $ctcp, $list);
  1615.   return () unless $msg;
  1616.   $tmp = '';
  1617.   $rest = $msg;
  1618.   while ($rest =~ /^(.*)\cA([^\cA]*)\cA(.*)$/) {
  1619.     $tmp .= $1;
  1620.     $ctcp = $2;
  1621.     $rest = $3;
  1622.     $tmp .= &cnc_print($clientno, $prefix, $ctcp) unless &'exist($list, $ctcp);
  1623.     $list = &'add($list, $ctcp);
  1624.   }
  1625.   $tmp .= $rest || '';
  1626.   return () unless $tmp;
  1627.   return ($prefix, $cmd, $chan, $tmp);
  1628. }
  1629.  
  1630. sub ss_notice {
  1631.   local($serverno, $prefix, $cmd, $chan, $msg) = @_;
  1632.   local($tmp, $rest, $ctcp, $list);
  1633.   return () unless $msg;
  1634.   $tmp = '';
  1635.   $rest = $msg;
  1636.   while ($rest =~ /^(.*)\cA([^\cA]*)\cA(.*)$/) {
  1637.     $tmp .= $1;
  1638.     $ctcp = $2;
  1639.     $rest = $3;
  1640.     $tmp .= &cns_scan($serverno, $prefix, $ctcp) unless &'exist($list, $ctcp);
  1641.     $list = &'add($list, $ctcp);
  1642.   }
  1643.   $tmp .= $rest || '';
  1644.   return () unless $tmp;
  1645.   return ($prefix, $cmd, $chan, $tmp);
  1646. }
  1647.  
  1648. sub sp_notice {
  1649.   local($serverno, $prefix, $cmd, $chan, $msg) = @_;
  1650.   local($tmp, $rest, $ctcp, $list);
  1651.   return () unless $msg;
  1652.   $tmp = '';
  1653.   $rest = $msg;
  1654.   while ($rest =~ /^(.*)\cA([^\cA]*)\cA(.*)$/) {
  1655.     $tmp .= $1;
  1656.     $ctcp = $2;
  1657.     $rest = $3;
  1658.     $tmp .= &cns_print($serverno, $prefix, $ctcp) unless &'exist($list, $ctcp);
  1659.     $list = &'add($list, $ctcp);
  1660.   }
  1661.   $tmp .= $rest || '';
  1662.   return () unless $tmp;
  1663.   return ($prefix, $cmd, $chan, $tmp);
  1664. }
  1665.  
  1666. sub cnc_scan {
  1667.   local($clientno, $prefix, $ctcp) = @_;
  1668.   local($cmd, $msg, $sub, $label);
  1669.   ($cmd, $msg) = (split(/\s+/, $ctcp, 2), '');
  1670.   return '' unless $cmd;
  1671.   foreach $module (&'array($'modulelist[$'userno[$clientno]])) {
  1672.     $sub = "${module}\'cncs_\L$cmd\E";
  1673.     next unless defined(&$sub);
  1674.     if ($'labellist{$module}) {
  1675.       foreach $label (&'array($'labellist{$module})) {
  1676.         ($prefix, $cmd, $msg) = &$sub($clientno, $prefix, $cmd, $msg);
  1677.         last unless $cmd;
  1678.       }
  1679.     } else {
  1680.       ($prefix, $cmd, $msg) = &$sub($clientno, $prefix, $cmd, $msg);
  1681.     }
  1682.     last unless $cmd;
  1683.   }
  1684.   return '' unless $cmd;
  1685.   return "\cA$cmd $msg\cA";
  1686. }
  1687.  
  1688. sub cnc_print {
  1689.   local($clientno, $prefix, $ctcp) = @_;
  1690.   local($cmd, $msg, $sub, $label);
  1691.   ($cmd, $msg) = (split(/\s+/, $ctcp, 2), '');
  1692.   return '' unless $cmd;
  1693.   foreach $module (&'array($'modulelist[$'userno[$clientno]])) {
  1694.     $sub = "${module}\'cncp_\L$cmd\E";
  1695.     next unless defined(&$sub);
  1696.     if ($'labellist{$module}) {
  1697.       foreach $label (&'array($'labellist{$module})) {
  1698.         ($prefix, $cmd, $msg) = &$sub($clientno, $prefix, $cmd, $msg);
  1699.         last unless $cmd;
  1700.       }
  1701.     } else {
  1702.       ($prefix, $cmd, $msg) = &$sub($clientno, $prefix, $cmd, $msg);
  1703.     }
  1704.     last unless $cmd;
  1705.   }
  1706.   return '' unless $cmd;
  1707.   return "\cA$cmd $msg\cA";
  1708. }
  1709.  
  1710. sub cns_scan {
  1711.   local($serverno, $prefix, $ctcp) = @_;
  1712.   local($cmd, $msg, $sub, $label);
  1713.   ($cmd, $msg) = (split(/\s+/, $ctcp, 2), '');
  1714.   return '' unless $cmd;
  1715.   foreach $module (&'array($'modulelist[$'userno[$serverno]])) {
  1716.     $sub = "${module}\'cnss_\L$cmd\E";
  1717.     next unless defined(&$sub);
  1718.     if ($'labellist{$module}) {
  1719.       foreach $label (&'array($'labellist{$module})) {
  1720.         ($prefix, $cmd, $msg) = &$sub($serverno, $prefix, $cmd, $msg);
  1721.         last unless $cmd;
  1722.       }
  1723.     } else {
  1724.       ($prefix, $cmd, $msg) = &$sub($serverno, $prefix, $cmd, $msg);
  1725.     }
  1726.     last unless $cmd;
  1727.   }
  1728.   return '' unless $cmd;
  1729.   return "\cA$cmd $msg\cA";
  1730. }
  1731.  
  1732. sub cns_print {
  1733.   local($serverno, $prefix, $ctcp) = @_;
  1734.   local($cmd, $msg, $sub, $label);
  1735.   ($cmd, $msg) = (split(/\s+/, $ctcp, 2), '');
  1736.   return '' unless $cmd;
  1737.   foreach $module (&'array($'modulelist[$'userno[$serverno]])) {
  1738.     $sub = "${module}\'cnsp_\L$cmd\E";
  1739.     next unless defined(&$sub);
  1740.     if ($'labellist{$module}) {
  1741.       foreach $label (&'array($'labellist{$module})) {
  1742.         ($prefix, $cmd, $msg) = &$sub($serverno, $prefix, $cmd, $msg);
  1743.         last unless $cmd;
  1744.       }
  1745.     } else {
  1746.       ($prefix, $cmd, $msg) = &$sub($serverno, $prefix, $cmd, $msg);
  1747.     }
  1748.     last unless $cmd;
  1749.   }
  1750.   return '' unless $cmd;
  1751.   return "\cA$cmd $msg\cA";
  1752. }
  1753.  
  1754. __END__
  1755. <DL>
  1756. <DT> plum.kanji* ({euc|jis|sjis})
  1757. <DT> plum.nick* ($B%K%C%/%M!<%`(B)
  1758. <DT> plum.user $B%f!<%6%M!<%`(B
  1759. <DT> plum.name $B<BL>(B
  1760. <DT> plum.server* $B%5!<%PL>(B[:$B%]!<%HHV9f(B] [$B%Q%9%o!<%I(B]
  1761. <DT> plum.client* $B%/%i%$%"%s%H%^%9%/(B[:$B%]!<%HHV9f(B] [$B%Q%9%o!<%I(B]
  1762. </DL>
  1763.