home *** CD-ROM | disk | FTP | other *** search
/ ftp.madoka.org / 2014.12.ftp.madoka.org.tar / ftp.madoka.org / pub / plum / plum2_33_1.lzh / module / auto / package.plm < prev    next >
Text File  |  1999-03-24  |  29KB  |  954 lines
  1. <!DOCTYPE HTML PUBLIC "-//IETF//DTD HTML//EN"><!-- $_ if 0; # -*- perl -*-
  2. # $Id: package.plm,v 2.75 1999/02/10 06:57:52 hasegawa Exp $
  3. # copyright (c)1998-1999 Yoshinori Hasegawa <hasegawa@madoka.org>
  4.  
  5. package auto_package;
  6.  
  7. $SENDSIZE = 65536;
  8. $RECVSIZE = 65536;
  9. $DIRECTORY = '.';
  10. $CLIENTINFO = 'DCC';
  11. $TIMEOUT = 3600;
  12. $INTERVAL = 3600;
  13. $DATE = '%m/%d %H:%M';
  14. $FORMAT = '#(date) #(from.name|from.nick|from.nick.now) >> #(message)';
  15.  
  16. $_ = 'auto_package';
  17.  
  18. sub main_loop {
  19.   local($userno) = @_;
  20.   local($timeout);
  21.   $timeout = &'property($userno, 'timeout') || $TIMEOUT;
  22.   foreach $sno (&'array($dccserverlist)) {
  23.     next unless $'userno[$server[$sno]] == $userno;
  24.     if (vec($'rout, $sno, 1)) {
  25.       &dcc_server($sno);
  26.       vec($'rout, $sno, 1) = 0;
  27.     } elsif (time() - $'access[$sno] > $timeout) {
  28.       &'close($sno);
  29.       $dccserverlist = &'remove($dccserverlist, $sno);
  30.       &msg_send($sno, 'senderror');
  31.       unlink($name[$sno]);
  32.     }
  33.   }
  34.   foreach $cno (&'array($dccclientlist)) {
  35.     next unless $'userno[$server[$cno]] == $userno;
  36.     if (vec($'rout, $cno, 1)) {
  37.       &dcc_client($cno);
  38.       vec($'rout, $cno, 1) = 0;
  39.     } elsif (time() - $'access[$cno] > $timeout) {
  40.       &'close($cno);
  41.       $dccclientlist = &'remove($dccclientlist, $cno);
  42.       &add_msg($'userno[$server[$cno]], $info[$cno]);
  43.       &msg_get($cno, 'geterror');
  44.     }
  45.   }
  46.   foreach $lno (&'array($dcclistenlist)) {
  47.     next unless $'userno[$server[$lno]] == $userno;
  48.     if (vec($'rout, $lno, 1)) {
  49.       &dcc_listen($lno);
  50.       vec($'rout, $lno, 1) = 0;
  51.     } elsif (time() - $'access[$lno] > $timeout) {
  52.       &'close($lno);
  53.       $dcclistenlist = &'remove($dcclistenlist, $lno);
  54.       &add_msg($'userno[$server[$lno]], $info[$lno]);
  55.       &msg_get($lno, 'geterror');
  56.     }
  57.   }
  58. }
  59.  
  60. sub module_disable {
  61.   local($userno) = @_;
  62.   local($no, $nick);
  63.   foreach $sno (&'array($dccserverlist)) {
  64.     &'close($sno);
  65.     $dccserverlist = &'remove($dccserverlist, $sno);
  66.   }
  67.   foreach $cno (&'array($dccclientlist)) {
  68.     &'close($cno);
  69.     $dccclientlist = &'remove($dccclientlist, $cno);
  70.     &add_msg($userno, $info[$cno]);
  71.   }
  72.   foreach $lno (&'array($dcclistenlist)) {
  73.     &'close($lno);
  74.     $dcclistenlist = &'remove($dcclistenlist, $lno);
  75.     &add_msg($userno, $info[$lno]);
  76.   }
  77.   foreach $key (keys(%lasttime)) {
  78.     ($no, $nick) = split(/$;/, $key, 2);
  79.     next unless $'userno[$no] == $userno;
  80.     delete $lasttime{$key};
  81.   }
  82. }
  83.  
  84. sub server_close {
  85.   local($serverno) = @_;
  86.   local($no, $nick);
  87.   $dcclist[$serverno] = '';
  88.   foreach $key (keys(%lasttime)) {
  89.     ($no, $nick) = split(/$;/, $key, 2);
  90.     next unless $no == $serverno;
  91.     delete $lasttime{$key};
  92.   }
  93. }
  94.  
  95. sub ss_join {
  96.   local($serverno, $prefix, $cmd, @params) = @_;
  97.   &receive($serverno, $prefix);
  98.   return ($prefix, $cmd, @params);
  99. }
  100.  
  101. sub ss_nick {
  102.   local($serverno, $prefix, $cmd, @params) = @_;
  103.   local($nick);
  104.   $nick = &'prefix($prefix);
  105.   $lasttime{$serverno, $params[0]} = $lasttime{$serverno, $nick};
  106.   delete $lasttime{$serverno, $nick};
  107.   $user = $params[0] . substr($prefix, index($prefix, '!'));
  108.   &receive($serverno, $user);
  109.   return ($prefix, $cmd, @params);
  110. }
  111.  
  112. sub ss_part {
  113.   local($serverno, $prefix, $cmd, @params) = @_;
  114.   &receive($serverno, $prefix);
  115.   return ($prefix, $cmd, @params);
  116. }
  117.  
  118. sub ss_topic {
  119.   local($serverno, $prefix, $cmd, @params) = @_;
  120.   &receive($serverno, $prefix);
  121.   return ($prefix, $cmd, @params);
  122. }
  123.  
  124. sub ss_kick {
  125.   local($serverno, $prefix, $cmd, @params) = @_;
  126.   &receive($serverno, $prefix);
  127.   return ($prefix, $cmd, @params);
  128. }
  129.  
  130. sub ss_mode {
  131.   local($serverno, $prefix, $cmd, @params) = @_;
  132.   &receive($serverno, $prefix);
  133.   return ($prefix, $cmd, @params);
  134. }
  135.  
  136. sub ss_privmsg {
  137.   local($serverno, $prefix, $cmd, @params) = @_;
  138.   local($userno, $str, $who, $text);
  139.   $userno = $'userno[$serverno];
  140.   if ($params[1]) {
  141.     foreach $get (&'property($userno, 'get')) {
  142.       next unless $params[1] eq $get;
  143.       &get($serverno, $prefix, $params[0]);
  144.       return ($prefix, $cmd, @params);
  145.     }
  146.     foreach $check (&'property($userno, 'check')) {
  147.       next unless $params[1] eq $check;
  148.       &check($serverno, $prefix, $params[0]);
  149.       return ($prefix, $cmd, @params);
  150.     }
  151.     ($str, $who, $text) = split(/\s+/, $params[1], 3);
  152.     if ($text) {
  153.       foreach $send (&'property($userno, 'send')) {
  154.         next unless $str eq $send;
  155.         &send($serverno, $prefix, $params[0], $who, $text);
  156.         return ($prefix, $cmd, @params);
  157.       }
  158.     }
  159.   }
  160.   &receive($serverno, $prefix);
  161.   return ($prefix, $cmd, @params);
  162. }
  163.  
  164. sub cpss_dcc {
  165.   local($serverno, $prefix, $cmd, @params) = @_;
  166.   local(@msg, $from);
  167.   @msg = split(/\s+/, $params[1]);
  168.   if ("\L$msg[0]\E" eq 'send') {
  169.     foreach $dcc (&'array($dcclist[$serverno])) {
  170.       $from = (split(/\s+/, $dcc))[0];
  171.       next if $from ne $prefix;
  172.       $dcclist[$serverno] = &'remove($dcclist[$serverno], $dcc);
  173.     }
  174.     $dcclist[$serverno] = &'add($dcclist[$serverno], join(' ', $prefix, @params));
  175.   }
  176.   return ($prefix, $cmd, @params);
  177. }
  178.  
  179. sub dcc_server {
  180.   local($sno) = @_;
  181.   local($recv, $socket, $tmp, $size, $length);
  182.   $recv = &'property($'userno[$server[$sno]], 'recvsize') || $RECVSIZE;
  183.   if ($size[$sno] - $done[$sno] > $recv) {
  184.     $size = $size[$sno] - $done[$sno];
  185.   } else {
  186.     $size = $recv;
  187.   }
  188.   $tmp = '';
  189.   $socket = $'socket[$sno];
  190.   if ($length = sysread($socket, $tmp, $size)) {
  191.     if (open(FILE, ">>$name[$sno]")) {
  192.       select((select(FILE), $| = 1)[0]);
  193.       print FILE $tmp;
  194.       close(FILE);
  195.     }
  196.     $done[$sno] += $length;
  197.     print $socket pack('N', $done[$sno]);
  198.     if ($done[$sno] == $size[$sno]) {
  199.       &'close($sno);
  200.       $dccserverlist = &'remove($dccserverlist, $sno);
  201.       &add_msg($'userno[$server[$sno]], $info[$sno]);
  202.       &msg_send($sno, 'accept');
  203.     }
  204.   } else {
  205.     &'close($sno);
  206.     $dccserverlist = &'remove($dccserverlist, $sno);
  207.     &msg_send($sno, 'senderror');
  208.     unlink($name[$sno]);
  209.   }
  210. }
  211.  
  212. sub dcc_client {
  213.   local($cno) = @_;
  214.   local($tmp, $length);
  215.   $tmp = '';
  216.   if ($length = sysread($'socket[$cno], $tmp, 4)) {
  217.     if (unpack('N', $tmp) == $done[$cno]) {
  218.       if ($done[$cno] == $size[$cno]) {
  219.         &'close($cno);
  220.         $dccclientlist = &'remove($dccclientlist, $cno);
  221.         unlink($name[$cno]);
  222.       } else {
  223.         &dcc_send($cno);
  224.       }
  225.     }
  226.   } else {
  227.     &'close($cno);
  228.     $dccclientlist = &'remove($dccclientlist, $cno);
  229.     &add_msg($'userno[$server[$cno]], $info[$cno]);
  230.     &msg_get($cno, 'geterror');
  231.   }
  232. }
  233.  
  234. sub dcc_listen {
  235.   local($lno) = @_;
  236.   local($cno);
  237.   if ($cno = &'accept($lno)) {
  238.     $dccclientlist = &'add($dccclientlist, $cno);
  239.     $info[$cno] = $info[$lno];
  240.     $name[$cno] = $name[$lno];
  241.     $size[$cno] = $size[$lno];
  242.     $done[$cno] = $done[$lno];
  243.     $pref[$cno] = $pref[$lno];
  244.     $chan[$cno] = $chan[$lno];
  245.     $server[$cno] = $server[$lno];
  246.     &dcc_send($cno);
  247.     &delete_msg($'userno[$server[$cno]], $info[$cno]);
  248.   }
  249.   &'close($lno);
  250.   $dcclistenlist = &'remove($dcclistenlist, $lno);
  251. }
  252.  
  253. sub dcc_send {
  254.   local($cno) = @_;
  255.   local($send, $size, $tmp, $socket);
  256.   $send = &'property($'userno[$server[$cno]], 'sendsize') || $SENDSIZE;
  257.   if ($size[$cno] - $done[$cno] < $send) {
  258.     $size = $size[$cno] - $done[$cno];
  259.   } else {
  260.     $size = $send;
  261.   }
  262.   if (open(FILE, $name[$cno])) {
  263.     $tmp = '';
  264.     seek(FILE, $done[$cno], 0);
  265.     if (read(FILE, $tmp, $size)) {
  266.       $socket = $'socket[$cno];
  267.       print $socket $tmp;
  268.       $done[$cno] += $size;
  269.     }
  270.     close(FILE);
  271.   }
  272. }
  273.  
  274. sub receive {
  275.   local($serverno, $prefix) = @_;
  276.   local($userno, $nick, $time, $int, @msg, %alias);
  277.   $userno = $'userno[$serverno];
  278.   $nick = &'prefix($prefix);
  279.   @msg = &get_msg($userno, $prefix);
  280.   if (@msg) {
  281.     %alias = &get_alias_user($userno, $prefix);
  282.     $alias{'nick.now'} = $nick;
  283.     $time = time();
  284.     $alias{'number'} = @msg;
  285.     $lasttime{$serverno, $nick} = 0 unless $lasttime{$serverno, $nick};
  286.     $int = &'property($userno, 'interval') || $INTERVAL;
  287.     if ($time - $lasttime{$serverno, $nick} > $int) {
  288.       foreach $reply (&'property($userno, 'receive')) {
  289.         &privmsg($serverno, $nick, &'format($reply, %alias));
  290.       }
  291.     }
  292.     $lasttime{$serverno, $nick} = $time;
  293.   } else {
  294.     $lasttime{$serverno, $nick} = 0;
  295.   }
  296. }
  297.  
  298. sub get {
  299.   local($serverno, $prefix, $chan) = @_;
  300.   local($userno, $nick, @msg, $to, @data, $size, %alias, %from, $date, @format, $lno, @params);
  301.   $userno = $'userno[$serverno];
  302.   $nick = &'prefix($prefix);
  303.   @msg = &get_msg($userno, $prefix);
  304.   %alias = &get_alias_user($userno, $prefix);
  305.   $alias{'nick.now'} = $nick;
  306.   if (&'channel($chan)) {
  307.     $alias{'channel'} = $chan;
  308.     $to = $chan;
  309.   } else {
  310.     $to = $nick;
  311.   }
  312.   if (@msg) {
  313.     foreach $line (@msg) {
  314.       @data = split(/\s+/, $line, 7);
  315.       %from = &get_alias_user($userno, $data[2], 'from');
  316.       $alias{'from.nick.now'} = &'prefix($data[2]);
  317.       if (&'channel($data[3])) {
  318.         $alias{'from.channel'} = $data[3];
  319.       }
  320.       $alias{'file'} = $data[4];
  321.       $alias{'message'} = $data[6];
  322.       $date = &'property($userno, 'date') || $DATE;
  323.       $alias{'date'} = &'date($date, $data[0]);
  324.       @format = &'property($userno, 'format');
  325.       if (@format) {
  326.         foreach $reply (@format) {
  327.           &privmsg($serverno, $nick, &'format($reply, %alias, %from));
  328.         }
  329.       } else {
  330.         &privmsg($serverno, $nick, &'format($FORMAT, %alias, %from));
  331.       }
  332.       $size = (stat($data[5]))[7];
  333.       if ($size) {
  334.         if ($lno = &'listen(0, 1)) {
  335.           $dcclistenlist = &'add($dcclistenlist, $lno);
  336.           @params = ();
  337.           push(@params, 'DCC');
  338.           push(@params, 'SEND');
  339.           push(@params, $data[4]);
  340.           push(@params, (&'sockname($serverno))[1]);
  341.           push(@params, (&'sockname($lno))[0]);
  342.           push(@params, $size);
  343.           &'s_print($serverno, '', 'PRIVMSG', $nick, "\cA" . join(' ', @params) . "\cA");
  344.           $info[$lno] = $line;
  345.           $name[$lno] = $data[5];
  346.           $size[$lno] = $size;
  347.           $done[$lno] = 0;
  348.           $pref[$lno] = $prefix;
  349.           $chan[$lno] = $chan;
  350.           $server[$lno] = $serverno;
  351.         } else {
  352.           foreach $reply (&'property($userno, 'geterror')) {
  353.             &privmsg($serverno, $to, &'format($reply, %alias, %from));
  354.           }
  355.           return;
  356.         }
  357.       }
  358.       &delete_msg($userno, @msg);
  359.       return;
  360.     }
  361.   } else {
  362.     foreach $reply (&'property($userno, 'nothing')) {
  363.       &privmsg($serverno, $to, &'format($reply, %alias));
  364.     }
  365.   }
  366.   $lasttime{$serverno, $nick} = 0;
  367. }
  368.  
  369. sub check {
  370.   local($serverno, $prefix, $chan) = @_;
  371.   local($userno, $nick, $time, @msg, %alias);
  372.   $userno = $'userno[$serverno];
  373.   $nick = &'prefix($prefix);
  374.   %alias = &get_alias_user($userno, $prefix);
  375.   $alias{'nick.now'} = $nick;
  376.   if (&'channel($chan)) {
  377.     $alias{'channel'} = $chan;
  378.     $to = $chan;
  379.   } else {
  380.     $to = $nick;
  381.   }
  382.   @msg = &get_msg($userno, $prefix);
  383.   if (@msg) {
  384.     $alias{'number'} = @msg;
  385.     foreach $reply (&'property($userno, 'exists')) {
  386.       &privmsg($serverno, $to, &'format($reply, %alias));
  387.     }
  388.     $lasttime{$serverno, $nick} = time();
  389.   } else {
  390.     foreach $reply (&'property($userno, 'nothing')) {
  391.       &privmsg($serverno, $to, &'format($reply, %alias));
  392.     }
  393.     $lasttime{$serverno, $nick} = 0;
  394.   }
  395. }
  396.  
  397. sub send {
  398.   local($serverno, $prefix, $chan, $who, $text) = @_; 
  399.   local($userno, $nick, %alias, %to, $to, @arg, @params, $sno, $dir, $name);
  400.   $userno = $'userno[$serverno];
  401.   $nick = &'prefix($prefix);
  402.   %alias = &get_alias_user($userno, $prefix);
  403.   $alias{'nick.now'} = $nick;
  404.   $alias{'to'} = $who;
  405.   if (&'channel($chan)) {
  406.     $alias{'channel'} = $chan;
  407.     $to = $chan;
  408.   } else {
  409.     $to = $nick;
  410.   }
  411.   %to = &get_alias_name_nick($userno, $who, 'to');
  412.   if (%to || $who =~ /^[A-\}][\-\dA-\}]*$/ && length($who) <= 9) {
  413.     foreach $dcc (&'array($dcclist[$serverno])) {
  414.       @arg = split(/\s+/, $dcc, 3);
  415.       next unless $arg[0] eq $prefix;
  416.       $alias{'file'} = $params[1];
  417.       @params = split(/\s+/, $arg[2]);
  418.       if ($sno = &'connect($params[2], $params[3])) {
  419.         $dir = &'expand(&'property($userno, 'directory') || $DIRECTORY);
  420.         $name = "$dir/" . &newfile($dir, $params[1]);
  421.         $dcclist[$serverno] = &'remove($dcclist[$serverno], $dcc);
  422.         $info[$sno] = join(' ', time(), $who, $prefix, $chan, $params[1], $name, $text);
  423.         $name[$sno] = $name;
  424.         $size[$sno] = $params[4];
  425.         $done[$sno] = 0;
  426.         $pref[$sno] = $prefix;
  427.         $chan[$sno] = $chan;
  428.         $server[$sno] = $serverno;
  429.         $dccserverlist = &'add($dccserverlist, $sno);
  430.       } else {
  431.         foreach $reply (&'property($userno, 'senderror')) {
  432.           &privmsg($serverno, $to, &'format($reply, %alias, %to));
  433.         }
  434.       }
  435.       return;
  436.     }
  437.     foreach $reply (&'property($userno, 'norequest')) {
  438.       &privmsg($serverno, $to, &'format($reply, %alias, %to));
  439.     }
  440.   } else {
  441.     foreach $reply (&'property($userno, 'unknown')) {
  442.       &privmsg($serverno, $to, &'format($reply, %alias));
  443.     }
  444.   }
  445. }
  446.  
  447. sub newfile {
  448.   local($dir, $file) = @_;
  449.   local($name, $ext);
  450.   $file =~ s/^.*[\\\/]([^\\\/]+)$/$1/;
  451.   $name = $file;
  452.   if (-e "$dir/$name") {
  453.     $ext = '';
  454.     if (rindex($file, '.') > 0) {
  455.       $ext = substr($file, rindex($file, '.'));
  456.       $file = substr($file, 0, rindex($file, '.'));
  457.     }
  458.     $num = 1;
  459.     $name = "$file-$num$ext";
  460.     while (-e "$dir/$name") {
  461.       $num++;
  462.       $name = "$file-$num$ext";
  463.     }
  464.   }
  465.   return $name;
  466. }
  467.  
  468. sub privmsg {
  469.   local($serverno, $to, $msg) = @_;
  470.   &'s_print($serverno, '', 'PRIVMSG', $to, $msg);
  471.   foreach $cno (&'array($'clientlist)) {
  472.     next unless $'avail[$cno];
  473.     next unless $'server[$cno] == $serverno;
  474.     &'c_print($cno, &'user($cno), 'PRIVMSG', $to, $msg);
  475.   }
  476. }
  477.  
  478. sub msg_get {
  479.   local($cno, $prop) = @_;
  480.   local(@data, $to, %alias, %from);
  481.   @data = split(/\s+/, $info[$cno], 7);
  482.   if (&'channel($chan[$cno])) {
  483.     $to = $chan[$cno];
  484.   } else {
  485.     $to = &'prefix($pref[$cno]);
  486.   }
  487.   %alias = &get_alias_user($'userno[$server[$cno]], $pref[$cno]);
  488.   $alias{'nick.now'} = (&'prefix($pref[$cno]))[0];
  489.   if (&'channel($data[3])) {
  490.     $alias{'channel'} = $data[3];
  491.   }
  492.   $alias{'file'} = $data[4];
  493.   %from = &get_alias_user($'userno[$server[$cno]], $data[1], 'from');
  494.   $alias{'from.nick.now'} = (&'prefix($data[1]))[0];
  495.   if (&'channel($data[2])) {
  496.     $alias{'from.channel'} = $data[2];
  497.   }
  498.   foreach $reply (&'property($'userno[$server[$cno]], $prop)) {
  499.     &privmsg($server[$cno], $to, &'format($reply, %alias, %from));
  500.   }
  501. }
  502.  
  503. sub msg_send {
  504.   local($sno, $prop) = @_;
  505.   local(@data, $to, %alias, %to);
  506.   @data = split(/\s+/, $info[$sno], 7);
  507.   if (&'channel($chan[$sno])) {
  508.     $to = $chan[$sno];
  509.   } else {
  510.     $to = &'prefix($pref[$sno]);
  511.   }
  512.   %alias = &get_alias_user($'userno[$server[$sno]], $pref[$sno]);
  513.   $alias{'nick.now'} = (&'prefix($pref[$sno]))[0];
  514.   if (&'channel($data[3])) {
  515.     $alias{'channel'} = $data[3];
  516.   }
  517.   $alias{'file'} = $data[4];
  518.   $alias{'to'} = $data[1];
  519.   %to = &get_alias_name_nick($'userno[$server[$sno]], $data[1], 'to');
  520.   foreach $reply (&'property($'userno[$server[$sno]], $prop)) {
  521.     &privmsg($server[$sno], $to, &'format($reply, %alias, %to));
  522.   }
  523. }
  524.  
  525. sub get_msg {
  526.   local($userno, $prefix) = @_;
  527.   local($nick, @list, $name, $code, $line, @data, %alias, $regex);
  528.   @list = ();
  529.   $nick = &'prefix($prefix);
  530.   ($name, $code) = &filename(&'property($userno, 'file'));
  531.   if (open(FILE, $name)) {
  532.     while (defined($line = <FILE>)) {
  533.       $line =~ tr/\r\n//d;
  534.       next unless $line;
  535.       $line = &code_jis($line, $code) if $code;
  536.       @data = split(/\s+/, $line, 7);
  537.       if (&check_alias($userno, $prefix, $data[1])) {
  538.         push(@list, $line);
  539.       }
  540.     }
  541.     close(FILE);
  542.   }
  543.   return @list;
  544. }
  545.  
  546. sub add_msg {
  547.   local($userno, $msg) = @_;
  548.   local($name, $code);
  549.   ($name, $code) = &filename(&'property($userno, 'file'));
  550.   $msg = &jis_code($line, $msg) if $code;
  551.   if (open(FILE, ">>$name")) {
  552.     print FILE $msg, "\n";
  553.     close(FILE);
  554.   }
  555. }
  556.  
  557. sub delete_msg {
  558.   local($userno, @list) = @_;
  559.   local($name, $code, $list, @msg);
  560.   @msg = ();
  561.   ($name, $code) = &filename(&'property($userno, 'file'));
  562.   if (open(FILE, $name)) {
  563.     $list = &'list(@list);
  564.     while (defined($line = <FILE>)) {
  565.       $line =~ tr/\r\n//d;
  566.       next unless $line;
  567.       $line = &code_jis($line, $code) if $code;
  568.       next if &'exist($list, $line);
  569.       push(@msg, $line);
  570.     }
  571.     close(FILE);
  572.     if (open(FILE, ">$name")) {
  573.       foreach $line (@msg) {
  574.         $line = &jis_code($line, $code) if $code;
  575.         print FILE $line, "\n";
  576.       }
  577.       close(FILE);
  578.     }
  579.   }
  580. }
  581.  
  582. sub get_alias_user {
  583.   local($userno, $from, $prefix) = @_;
  584.   local($file, @list);
  585.   $file = &'property($userno, 'alias');
  586.   foreach $list (&split_list('nick', &read_file($file))) {
  587.     @list = &'array($list);
  588.     if (&match_alias_user($from, @list)) {
  589.       return &parse_alias($prefix, @list);
  590.     }
  591.   }
  592.   return ();
  593. }
  594.  
  595. sub get_alias_name_nick {
  596.   local($userno, $from, $prefix) = @_;
  597.   local($file, @list);
  598.   $file = &'property($userno, 'alias');
  599.   foreach $list (&split_list('nick', &read_file($file))) {
  600.     @list = &'array($list);
  601.     if (&match_alias_name_nick($from, @list)) {
  602.       return &parse_alias($prefix, @list);
  603.     }
  604.   }
  605.   return ();
  606. }
  607.  
  608. sub check_alias {
  609.   local($userno, $from, $name) = @_;
  610.   local($file, @list, $nick);
  611.   $file = &'property($userno, 'alias');
  612.   foreach $list (&split_list('nick', &read_file($file))) {
  613.     @list = &'array($list);
  614.     if (&match_alias_name_nick($name, @list)) {
  615.       if (&match_alias_user($from, @list)) {
  616.         return 1;
  617.       } else {
  618.         return 0;
  619.       }
  620.     }
  621.   }
  622.   $nick = &'prefix($from);
  623.   if ("\L$name\E" eq "\L$nick\E") {
  624.     return 1;
  625.   } else {
  626.     return 0;
  627.   }
  628. }
  629.  
  630. sub match_alias_user {
  631.   local($from, @list) = @_;
  632.   local($var, $arg, $regex);
  633.   foreach $line (@list) {
  634.     ($var, $arg) = split(/\s+/, $line, 2);
  635.     next unless "\L$var\E" eq 'user';
  636.     $regex = &'regex($arg);
  637.     next unless $from =~ /$regex/i;
  638.     return 1;
  639.   }
  640.   return 0;
  641. }
  642.  
  643. sub match_alias_name_nick {
  644.   local($from, @list) = @_;
  645.   local($var, $arg);
  646.   foreach $line (@list) {
  647.     ($var, $arg) = split(/\s+/, $line, 2);
  648.     if ("\L$var\E" eq 'name') {
  649.       foreach $name (split(/\s+/, $arg)) {
  650.         next unless $from eq $name;
  651.         return 1;
  652.       }
  653.     } elsif ("\L$var\E" eq 'nick') {
  654.       next unless &'exist(&'list(split(/\s+/, $arg)), $from);
  655.       return 1;
  656.     }
  657.   }
  658.   return 0;
  659. }
  660.  
  661. sub parse_alias {
  662.   local($prefix, @list) = @_;
  663.   local(%alias, $var, $arg, $key);
  664.   %alias = ();
  665.   foreach $line (@list) {
  666.     ($var, $arg) = split(/\s+/, $line, 2);
  667.     $var = "\L$var\E";
  668.     if ($prefix) {
  669.       $key = $prefix . '.' . $var;
  670.     } else {
  671.       $key = $var;
  672.     }
  673.     next if defined($alias{$key});
  674.     if ($var eq 'nick') {
  675.       $alias{$key} = (split(/\,/, $arg))[0];
  676.     } elsif ($var eq 'name') {
  677.       $alias{$key} = (split(/\s+/, $arg))[0];
  678.     } else {
  679.       $alias{$key} = $arg;
  680.     }
  681.   }
  682.   return %alias;
  683. }
  684.  
  685. sub split_list {
  686.   local($field, @list) = @_;
  687.   local($var, $arg, @array, @entry);
  688.   $field = "\L$field\E";
  689.   @array = ();
  690.   @entry = ();
  691.   foreach $line (@list) {
  692.     ($var, $arg) = split(/\s*\:\s*/, $line, 2);
  693.     if ($field eq "\L$var\E") {
  694.       push(@array, &'list(@entry)) if @entry;
  695.       @entry = ();
  696.     }
  697.     push(@entry, $var . ' ' . $arg);
  698.   }
  699.   push(@array, &'list(@entry)) if @entry;
  700.   return @array;
  701. }
  702.  
  703. sub read_file {
  704.   local($file) = @_;
  705.   local($name, $code, $mtime, @data, $line);
  706.   ($name, $code) = &filename($file);
  707.   $mtime = (stat($name))[9];
  708.   if (defined($mtime)) {
  709.     $modify{$name} = -1 unless defined($modify{$name});
  710.     if ($modify{$name} != $mtime) {
  711.       if (open(TMP, $name)) {
  712.         @data = ();
  713.         while (defined($line = <TMP>)) {
  714.           $line =~ s/^\s+//;
  715.           next if $line =~ /^[\#\;]/;
  716.           $line =~ tr/\r\n//d;
  717.           next unless $line;
  718.           $line =~ s/\s+$//;
  719.           $line = &code_jis($line, $code) if $code;
  720.           push(@data, $line);
  721.         }
  722.         close(TMP);
  723.         $modify{$name} = $mtime;
  724.         $cache{$name} = &'list(@data);
  725.         return @data;
  726.       }
  727.     } else {
  728.       return &'array($cache{$name});
  729.     }
  730.   }
  731.   return ();
  732. }
  733.  
  734. sub filename {
  735.   local($file) = @_;
  736.   local($idx, $name, $code);
  737.   return ('', '') unless $file;
  738.   if (($idx = rindex($file, ';')) != -1) {
  739.     $name = substr($file, 0, $idx);
  740.     $code = substr($file, $idx + 1);
  741.   } else {
  742.     $name = $file;
  743.     $code = '';
  744.   }
  745.   return (&'expand($name), $code);
  746. }
  747.  
  748. sub code_jis {
  749.   local($line, $list) = @_;
  750.   foreach $code (split(/\,/, "\L$list\E")) {
  751.     if ($code eq 'euc') {
  752.       $line = &'euc_jis($line);
  753.     } elsif ($code eq 'jis') {
  754.       $line = &'jis_jis($line);
  755.     } elsif ($code eq 'sjis') {
  756.       $line = &'sjis_jis($line);
  757.     }
  758.   }
  759.   return $line;
  760. }
  761.  
  762. sub jis_code {
  763.   local($line, $list) = @_;
  764.   local($code);
  765.   $code = (split(/\,/, "\L$list\E"))[0];
  766.   if ($code eq 'euc') {
  767.     $line = &'jis_euc($line);
  768.   } elsif ($code eq 'jis') {
  769.     $line = &'jis_jis($line);
  770.   } elsif ($code eq 'sjis') {
  771.     $line = &'jis_sjis($line);
  772.   }
  773.   return $line;
  774. }
  775.  
  776. __END__
  777. --><HTML><HEAD>
  778. <META HTTP-EQUIV="Content-Type" CONTENT="text/html; charset=ISO-2022-JP">
  779. <LINK REV="made" HREF="mailto:hasegawa@madoka.org">
  780. <TITLE>auto/package.plm</TITLE></HEAD><BODY>
  781.  
  782. $B%*%s%i%$%s%I%-%e%a%s%H(B
  783.  
  784.  
  785. <HR><H3>$BL>A0(B</H3>
  786.  
  787. auto/package.plm - $B;XDj$7$??M$K(BDCC$B$G%U%!%$%k$rFO$1$k(B
  788.  
  789.  
  790. <HR><H3>$B@bL@(B</H3>
  791.  
  792. $B;XDj$7$??M$K%a%C%;!<%8$r$D$1$F(BDCC$B$G%U%!%$%k$rFO$1$^$9!#(B
  793. DCC$B$G%U%!%$%k$NAw?.MW5a$r=P$7$?$"$H!"(B
  794. $BAw$j@h$r;XDj$9$k$3$H$G%U%!%$%k$rAw?.$9$k$3$H$,$G$-$^$9!#(B
  795. $B%U%!%$%k$,FO$$$F$$$k$+$I$&$+$N3NG'$O%f!<%6$,%A%c%s%M%k$KF~$C$F$-$?$H$-$H!"(B
  796. $B%K%C%/%M!<%`$rJQ99$7$?$H$-$K9T$$$^$9!#(B
  797. $B$=$N$?$a!"F1$8%A%c%s%M%k$KF~$i$J$$%f!<%6$KBP$7$F$O(B
  798. $B%U%!%$%k$rAw$k$3$H$O$G$-$^$;$s!#(B
  799.  
  800.  
  801. <HR><H3>$B%W%m%Q%F%#(B</H3>
  802.  
  803. <DL>
  804. <DT>  auto.package.file $B%U%!%$%kL>(B[;({jis|euc|sjis})]
  805. </DT>
  806. <DD>    $B<u$1<h$C$?%U%!%$%k$dAw$j@h$N>pJs$r3JG<$9$k%U%!%$%k$r;XDj$7$^$9!#(B
  807.         $B%U%!%$%k$O;XDj$7$?4A;z%3!<%I$GJ]B8$5$l$^$9!#(B
  808.         $B4A;z%3!<%I$rJ#?t;XDj$7$?>l9g$O!":G=i$K;XDj$7$?4A;z%3!<%I$G(B
  809.         $BJ]B8$5$l!">JN,$7$?>l9g$O!V(Bjis$B!W$r;XDj$7$?$3$H$HF1$8$G$9!#(B
  810.         $B$^$?!"!V(Beuc$B!W$H!V(Bsjis$B!W$rF1;~$K;XDj$9$k$3$H$O$G$-$^$;$s!#(B
  811. </DD>
  812. <DT>  auto.package.directory $B%G%#%l%/%H%jL>(B
  813. </DT>
  814. <DD>    $B<u$1<h$C$?%U%!%$%k$rJ]B8$9$k%G%#%l%/%H%j$r;XDj$7$^$9!#(B
  815.         $B@5$7$/Aw?.$5$l$?%U%!%$%k$O>C$5$l$^$9!#(B
  816. </DD>
  817. <DT>  auto.package.alias $B%U%!%$%kL>(B[;({jis|euc|sjis})]
  818. </DT>
  819. <DD>    $B%(%$%j%"%9$r;2>H$9$k%U%!%$%kL>$r;XDj$7$^$9!#(B
  820.         $B$3$N%U%!%$%k$O(Bauto/alias.plm$B$G;HMQ$9$k$b$N$HF1$8$b$N$G$9!#(B
  821.         $B%U%!%$%k$O;XDj$7$?4A;z%3!<%I$GJ]B8$5$l$F$$$kI,MW$,$"$j$^$9!#(B
  822. </DD>
  823. <DT>  auto.package.get* $BJ8;zNs(B
  824. </DT>
  825. <DD>    $B%U%!%$%k$r<u$1<h$k$?$a$NJ8;zNs$G$9!#(B
  826.         $B$3$3$G;XDj$7$?J8;zNs$rH/8@$9$k$H!"%a%C%;!<%8$H$H$b$K(B
  827.         DCC$B$G%U%!%$%k$,Aw$i$l$F$-$^$9!#(B
  828. </DD>
  829. <DT>  auto.package.send* $BJ8;zNs(B
  830. </DT>
  831. <DD>    $B%U%!%$%k$rAw$k$?$a$NJ8;zNs$G$9!#(BDCC$B$NAw?.BT$A$N>uBV$G(B
  832.         $B$3$3$G;XDj$7$?J8;zNs$H!"$=$l$KB3$/Aw$j@h$H%a%C%;!<%8$rH/8@$9$k$H!"(B
  833.         $B;XDj$7$?Aw$j@h$K%U%!%$%k$rAw?.$7$^$9!#(B
  834. </DD>
  835. <DT>  auto.package.check* $BJ8;zNs(B
  836. </DT>
  837. <DD>    $B%U%!%$%k$,FO$$$F$$$k$+$I$&$+3NG'$9$k$?$a$NJ8;zNs$r;XDj$7$^$9!#(B
  838.         $B$3$3$G;XDj$7$?J8;zNs$HF1$8J8;zNs$,H/8@$5$l$k$H!"(B
  839.         $B$=$N?M$KBP$7$FAw$i$l$?%U%!%$%k$,$"$k$+$I$&$+3NG'$7!"(B
  840.         $B$=$N7k2L$rH/8@$7$^$9!#(B
  841. </DD>
  842. <DT>  auto.package.date $BJ8;zNs(B
  843. </DT>
  844. <DD>    auto.package.format$B$G;XDj$9$k$3$H$N$G$-$kCM$N$&$A!"(B
  845.         #(date)$B$GCV49$5$l$kF|IU$N%U%)!<%^%C%H$r;XDj$7$^$9!#(B
  846.         $B%G%U%)%k%H$G$O!V(B%m/%d %H:%M$B!W$H$J$C$F$$$^$9!#(B
  847. </DD>
  848. <DT>  auto.package.format* $B%U%)!<%^%C%H(B
  849. </DT>
  850. <DD>    $BAw$j@h$K%U%!%$%k$rAw$k$H$-$K!"$I$N$h$&$J7A<0$GH/8@$9$k$+$r(B
  851.         $B;XDj$7$^$9!#%U%)!<%^%C%H$K(B#(nick)$B$N$h$&$K=q$/$3$H$G!"(B
  852.         $B%U%!%$%k$r<u$1$H$k?M$N%(%$%j%"%9$NBP1~$9$kCM$GCV$-49$($^$9!#(B
  853.         $B$^$?!"%U%!%$%k$rAw$C$??M$N%(%$%j%"%9$O(B#(from.nick)$B$N$h$&$J7A<0(B
  854.         $B$GCV49$9$k$3$H$,$G$-$^$9!#%(%$%j%"%90J30$N>pJs$H$7$F$O!"(B
  855.         #(date)$B$G%U%!%$%k$rAw$C$?F|IU$H;~9o$r!"(B#(message)$B$G(B
  856.         $B%U%!%$%k$NFbMF$r$=$l$>$lCV$-49$($^$9!#(B
  857.         $B$^$?!"3g8LFb$r!V(B|$B!W$G6h@Z$C$FJ#?t;XDj$7$?>l9g!"(B
  858.         $B:G=i$KDj5A$5$l$F$$$kCM$GCV$-49$($^$9!#(B
  859. </DD>
  860. <DT>  auto.package.accept* $B%U%)!<%^%C%H(B
  861. </DT>
  862. <DD>    $B%U%!%$%k$r@5$7$/<u$1<h$k$C$?$H$-$K!"$3$3$G;XDj$7$?$b$N$r(B
  863.         $BH/8@$7$^$9!#%U%)!<%^%C%H$K(B#(nick)$B$N$h$&$K;XDj$9$k$3$H$G!"(B
  864.         $B%U%!%$%k$NAw$j85$N%(%$%j%"%9$NBP1~$9$kCM$GCV$-49$($^$9!#(B
  865.         $B$^$?!"(B#(to)$B$G%U%!%$%k$NAw$j@h$H$7$F;XDj$7$?L>A0$r!"(B
  866.         #(to.nick)$B$N$h$&$K!V(Bto.$B!W$rIU$1$k$3$H$G!"%U%!%$%k$NAw$j@h$N(B
  867.         $B%(%$%j%"%9$NBP1~$9$kCM$GCV$-49$($^$9!#(B
  868. </DD>
  869. <DT>  auto.package.receive* $B%U%)!<%^%C%H(B
  870. </DT>
  871. <DD>    $B%A%c%s%M%k$KF~$C$F$-$?;~$d!"%K%C%/%M!<%`$rJQ99$7$?;~$K!"(B
  872.         $B$=$N?M$KBP$9$k%a%C%;!<%8$,FO$$$F$$$l$P!"$3$3$G;XDj$7$?$b$N$r(B
  873.         $BH/8@$7$^$9!#%U%)!<%^%C%H$K(B#(nick)$B$N$h$&$K;XDj$9$k$3$H$G!"(B
  874.         $B%U%!%$%k$NAw$j85$N%(%$%j%"%9$NBP1~$9$kCM$GCV$-49$($^$9!#(B
  875.         $B$^$?!"(B#(number)$B$GFO$$$F$$$k%U%!%$%k?t$KCV$-49$($^$9!#(B
  876. </DD>
  877. <DT>  auto.package.norequest* $B%U%)!<%^%C%H(B
  878. </DT>
  879. <DD>    DCC$B$NAw?.MW5a$r=P$5$:$K%U%!%$%k$rAw$m$&$H$7$?>l9g$K(B
  880.         $B$3$3$G;XDj$7$?$b$N$rH/8@$7$^$9!#(B
  881.         $B%U%)!<%^%C%H$K(B#(nick)$B$N$h$&$K;XDj$9$k$3$H$G!"(B
  882.         $B%U%!%$%k$NAw$j85$N%(%$%j%"%9$NBP1~$9$kCM$GCV$-49$($^$9!#(B
  883. </DD>
  884. <DT>  auto.package.unknown* $B%U%)!<%^%C%H(B
  885. </DT>
  886. <DD>    $B%U%!%$%k$rAw$kAj<j$,$o$+$i$J$$$H$-$K!"$3$3$G;XDj$7$?$b$N$r(B
  887.         $BH/8@$7$^$9!#%U%)!<%^%C%H$K(B#(nick)$B$N$h$&$K;XDj$9$k$3$H$G!"(B
  888.         $B%U%!%$%k$NAw$j85$N%(%$%j%"%9$NBP1~$9$kCM$GCV$-49$($^$9!#(B
  889.         $B$^$?!"(B#(to)$B$G%U%!%$%k$rAw$m$&$H$7$?Aj<j$NL>A0$KCV$-49$($^$9!#(B
  890. </DD>
  891. <DT>  auto.package.nothing* $B%U%)!<%^%C%H(B
  892. </DT>
  893. <DD>    $B%U%!%$%k$r<u$1<h$m$&$H$7$?$,!"%U%!%$%k$,FO$$$F$$$J$+$C$?$H$-!"(B
  894.         $B$3$3$G;XDj$7$?$b$N$rH/8@$7$^$9!#%U%)!<%^%C%H$K(B#(nick)$B$N$h$&$K(B
  895.         $B;XDj$9$k$3$H$G!"%(%$%j%"%9$NBP1~$9$kCM$GCV$-49$($^$9!#(B
  896. </DD>
  897. <DT>  auto.package.exists* $B%U%)!<%^%C%H(B
  898. </DT>
  899. <DD>    $B%U%!%$%k$,FO$$$F$$$k$+$I$&$+3NG'$7$?$H$-$K!"(B
  900.         $BFO$$$F$$$k%U%!%$%k$,$"$l$P!"$3$3$G;XDj$7$?$b$N$rH/8@$7$^$9!#(B
  901. </DD>
  902. <DT>  auto.package.geterror* $B%U%)!<%^%C%H(B
  903. </DT>
  904. <DD>    $B%f!<%6$,%U%!%$%k$r<u?.$7$F$$$k$H$-$K%(%i!<$,H/@8$7$?>l9g!"(B
  905.         $B$3$3$G;XDj$7$?$b$N$rH/8@$7$^$9!#%U%)!<%^%C%H$K(B#(nick)$B$N$h$&$K(B
  906.         $B;XDj$9$k$3$H$G!"%(%$%j%"%9$NBP1~$9$kCM$GCV$-49$($^$9!#(B
  907.         $B$^$?!"(B#(file)$B$GE>AwCf$N%U%!%$%kL>$KCV$-49$($^$9!#(B
  908. </DD>
  909. <DT>  auto.package.senderror* $B%U%)!<%^%C%H(B
  910. </DT>
  911. <DD>    $B%f!<%6$,%U%!%$%k$rAw?.$7$F$$$k$H$-$K%(%i!<$,H/@8$7$?>l9g!"(B
  912.         $B$3$3$G;XDj$7$?$b$N$rH/8@$7$^$9!#%U%)!<%^%C%H$K(B#(nick)$B$N$h$&$K(B
  913.         $B;XDj$9$k$3$H$G!"%(%$%j%"%9$NBP1~$9$kCM$GCV$-49$($^$9!#(B
  914.         $B$^$?!"(B#(file)$B$GE>AwCf$N%U%!%$%kL>$KCV$-49$($^$9!#(B
  915. </DD>
  916. </DL>
  917.  
  918.  
  919. <HR><H3>$B@_DjNc(B</H3>
  920.  
  921. <PRE>
  922. + auto.package.plm
  923. auto.package.file: package.txt;jis
  924. auto.package.directory: DCC
  925. auto.package.alias: alias.txt;jis,euc
  926. auto.package.get: $B>.JqAw$C$F(B
  927. auto.package.send: $B>.Jq(B
  928. auto.package.format: #(from.name|from.nick.now)$B$5$s$+$i!V(B#(message)$B!W(B(#(date))
  929. auto.package.date: %m$B7n(B%d$BF|(B%H$B;~(B%M$BJ,(B
  930. auto.package.accept: $B>.Jq$r<u$1<h$j$^$7$?(B
  931. auto.package.receive: #(number)$B8D$N>.Jq$,FO$$$F$$$^$9!#!V>.JqAw$C$F!W$G$*FO$1$7$^$9!#(B
  932. auto.package.norequest: #(name|nick.now): DCC$BMW5a$,$"$j$^$;$s(B
  933. auto.package.unknown: #(to)$B$5$s$H$$$&$N$OC/$G$9$+(B?
  934. auto.package.nothing: #(name|nick)$B$5$s08$N>.Jq$OFO$$$F$$$^$;$s(B
  935. auto.package.geterror: #(nick.now): #(file)$B$NAw?.$K<:GT$7$^$7$?(B
  936. auto.package.senderror: #(nick.now): #(file)$B$N<u?.$K<:GT$7$^$7$?(B
  937. </PRE>
  938.  
  939. DCC$B$G%U%!%$%k$NAw?.MW5a$r=P$7$?$"$H!"!V>.Jq(B pupu $B$[$2$[$2!W(B
  940. $B$N$h$&$KH/8@$9$k$H!"!V$[$2$[$2!W$H$$$&%a%C%;!<%8$H$H$b$K(B
  941. DCC$B$GAw?.$7$?%U%!%$%k$r(Bpupu$B$H$$$&%K%C%/%M!<%`$N?M$KAw$j$^$9!#(B
  942. $B$^$?!V(Balias.txt$B!W$NCf$KE,Ev$J>pJs$r;XDj$9$k$3$H$K$h$C$F!"(B
  943. $B!V>.Jq(B $B$W$W(B $B$[$2$[$2!W$N$h$&$J;H$$J}$b$G$-$^$9!#(B
  944. $B$^$?!"$3$N$H$-Aw$i$l$?%U%!%$%k$O(BDCC$B$H$$$&%G%#%l%/%H%j$NCf$KJ]B8$5$l$^$9!#(B
  945.  
  946. <BR><BR>
  947.  
  948. $B%U%!%$%k$,FO$$$F$$$k$H$-$K%A%c%s%M%k$KF~$C$?$j!"%K%C%/%M!<%`$rJQ99$9$k$H!"(B
  949. $B!V>.Jq$,FO$$$F$$$^$9!#!V>.JqAw$C$F!W$G$*FO$1$7$^$9!W$H8@$C$FCN$i$;$^$9!#(B
  950. $B$3$N$H$-!V>.JqAw$C$F!W$HH/8@$9$k$H!"Aw$j<g$NL>A0$H%a%C%;!<%8$rH/8@$7$F!"(B
  951. DCC$B$G%U%!%$%k$rAw$C$F$-$^$9!#(B
  952.  
  953. </BODY></HTML>
  954.