home *** CD-ROM | disk | FTP | other *** search
/ ftp.madoka.org / 2014.12.ftp.madoka.org.tar / ftp.madoka.org / pub / plum / 2.x / plum2_28_2.lzh / module / auto / reply.plm < prev    next >
Text File  |  1998-10-15  |  10KB  |  336 lines

  1. <!DOCTYPE HTML PUBLIC "-//IETF//DTD HTML//EN"><!-- $_ if 0; # -*- perl -*-
  2. # $Id: reply.plm,v 2.8 1998/09/24 15:31:37 hasegawa Exp $
  3. # copyright (c)1998 pupu_j <hasegawa@agusa.nuie.nagoya-u.ac.jp>
  4.  
  5. package auto_reply;
  6.  
  7. $_ = 'auto_reply';
  8.  
  9. sub ss_privmsg {
  10.   local($serverno, $prefix, $cmd, @params) = @_;
  11.   local($userno, $mtime, $file, $idx, $name, $code, $req, $rep, $rate, @list, $regex, $to);
  12.   $userno = $'userno[$serverno];
  13.   $file = &'property($userno, 'file') || '';
  14.   if (($idx = rindex($file, ';')) != -1) {
  15.     $name = substr($file, 0, $idx);
  16.     $code = substr($file, $idx + 1);
  17.   } else {
  18.     $name = $file;
  19.     $code = '';
  20.   }
  21.   $name = &'expand($name);
  22.   if ($name) {
  23.     $mtime = (stat($name))[9];
  24.     if (defined($mtime) && ($modify[$userno] || 0) != $mtime) {
  25.       $modify[$userno] = $mtime;
  26.       &read_file($userno);
  27.     }
  28.   }
  29.   ($req, @reply) = split(/\s+/, $params[1]);
  30.   if (@reply) {
  31.     foreach $add (&'property($userno, 'add')) {
  32.       next unless $req eq $add;
  33.       &add_file($userno, @reply);
  34.       return ($prefix, $cmd, @params);
  35.     }
  36.     foreach $remove (&'property($userno, 'remove')) {
  37.       next unless $req eq $remove;
  38.       &remove_file($userno, @reply);
  39.       return ($prefix, $cmd, @params);
  40.     }
  41.     foreach $change (&'property($userno, 'change')) {
  42.       next unless $req eq $change;
  43.       &change_file($userno, @reply);
  44.       return ($prefix, $cmd, @params);
  45.     }
  46.   }
  47.   $rate = &'property($userno, 'rate');
  48.   if (rand(100) < $rate) {
  49.     foreach $str (&'array($message[$userno])) {
  50.       ($req, $rep) = &parse($str);
  51.       foreach $text (&'array($req)) {
  52.         $regex = &'regex(&'jis_euc($text));
  53.         next unless &'jis_euc($params[1]) =~ /$regex/;
  54.         if ($params[0] =~ /^[\#\&\+]/) {
  55.           $to = $params[0];
  56.         } else {
  57.           $to = &'prefix($prefix);
  58.         }
  59.         @list = &'array($rep);
  60.         &privmsg($serverno, $to, $list[rand(scalar(@list))]);
  61.         return ($prefix, $cmd, @params);
  62.       }
  63.     }
  64.   }
  65.   return ($prefix, $cmd, @params);
  66. }
  67.  
  68. sub privmsg {
  69.   local($serverno, $to, $msg) = @_;
  70.   &'s_print($serverno, '', 'PRIVMSG', $to, $msg);
  71.   foreach $cno (&'array($'clientlist)) {
  72.     next unless $'avail[$cno];
  73.     next unless $'server[$cno] == $serverno;
  74.     &'c_print($cno, &'user($cno), 'PRIVMSG', $to, $msg);
  75.   }
  76. }
  77.  
  78. sub parse {
  79.   local($str) = @_;
  80.   local($left, $right, $req, $rep);
  81.   ($left, $right) = split(/\s+\:\s+/, $str);
  82.   $req = &'list(split(/\s+/, $left || ''));
  83.   $rep = &'list(split(/\s+/, $right || ''));
  84.   return ($req, $rep);
  85. }
  86.  
  87. sub add_file {
  88.   local($userno, $req, @reply) = @_;
  89.   local(@array, $line, $recv, $send, $i);
  90.   @array = &'array($message[$userno]);
  91.   for ($i = 0; $i < scalar(@array); $i++) {
  92.     ($recv, $send) = &parse($array[$i]);
  93.     next unless &'exist($recv, $req);
  94.     $array[$i] = join(' ', &'array($recv)) . ' : ' . join(' ', &'array(&'add($send, @reply)));
  95.     $message[$userno] = &'list(@array);
  96.     &write_file($userno);
  97.     return;
  98.   }
  99.   push(@array, $req . ' : ' . join(' ', @reply));
  100.   $message[$userno] = &'list(@array);
  101.   &write_file($userno);
  102. }
  103.  
  104. sub remove_file {
  105.   local($userno, $req, @reply) = @_;
  106.   local(@array, $line, $recv, $send, $i);
  107.   @array = &'array($message[$userno]);
  108.   for ($i = 0; $i < scalar(@array); $i++) {
  109.     ($recv, $send) = &parse($array[$i]);
  110.     next unless &'exist($recv, $req);
  111.     $send = &'remove($send, @reply);
  112.     if ($send) {
  113.       $array[$i] = join(' ', &'array($recv)) . ' : ' . join(' ', &'array($send));
  114.     } else {
  115.       splice(@array, $i, 1);
  116.     }
  117.     last;
  118.   }
  119.   $message[$userno] = &'list(@array);
  120.   &write_file($userno);
  121. }
  122.  
  123. sub change_file {
  124.   local($userno, $req, @reply) = @_;
  125.   local(@array, $line, $recv, $send, $i);
  126.   @array = &'array($message[$userno]);
  127.   for ($i = 0; $i < scalar(@array); $i++) {
  128.     ($recv, $send) = &parse($array[$i]);
  129.     next unless &'exist($recv, $req);
  130.     $array[$i] = join(' ', &'array($recv)) . ' : ' . join(' ', &'array(&'change($send, @reply)));
  131.     last;
  132.   }
  133.   $message[$userno] = &'list(@array);
  134.   &write_file($userno);
  135. }
  136.  
  137. sub read_file {
  138.   local($userno) = @_;
  139.   local($file, $idx, $name, $code, $line);
  140.   $file = &'property($userno, 'file') || '';
  141.   if (($idx = rindex($file, ';')) != -1) {
  142.     $name = substr($file, 0, $idx);
  143.     $code = substr($file, $idx + 1);
  144.   } else {
  145.     $name = $file;
  146.     $code = '';
  147.   }
  148.   $name = &'expand($name);
  149.   if ($name && open(FILE, $name)) {
  150.     undef($message[$userno]);
  151.     while (defined($line = <FILE>)) {
  152.       $line =~ tr/\r\n//d;
  153.       next unless $line;
  154.       $line = &code_jis($line, $code) if $code;
  155.       $line = &read_line($userno, $line);
  156.       $message[$userno] = &'add($message[$userno], $line);
  157.     }
  158.     close(FILE);
  159.   }
  160. }
  161.  
  162. sub write_file {
  163.   local($userno) = @_;
  164.   local($file, $idx, $name, $code);
  165.   $file = &'property($userno, 'file') || '';
  166.   if (($idx = rindex($file, ';')) != -1) {
  167.     $name = substr($file, 0, $idx);
  168.     $code = substr($file, $idx + 1);
  169.   } else {
  170.     $name = $file;
  171.     $code = '';
  172.   }
  173.   $name = &'expand($name);
  174.   if ($name && open(FILE, ">$name")) {
  175.     foreach $line (&'array($message[$userno])) {
  176.       $line = &jis_code($line, $code) if $code;
  177.       $line = &write_line($userno, $line);
  178.       print FILE $line, "\n";
  179.     }
  180.     close(FILE);
  181.   }
  182. }
  183.  
  184. sub code_jis {
  185.   local($line, $list) = @_;
  186.   foreach $code (split(/\,/, "\L$list\E")) {
  187.     if ($code eq 'euc') {
  188.       $line = &'euc_jis($line);
  189.     } elsif ($code eq 'jis') {
  190.       $line = &'jis_jis($line);
  191.     } elsif ($code eq 'sjis') {
  192.       $line = &'sjis_jis($line);
  193.     }
  194.   }
  195.   return $line;
  196. }
  197.  
  198. sub jis_code {
  199.   local($line, $list) = @_;
  200.   local($code);
  201.   $code = (split(/\,/, "\L$list\E"))[0];
  202.   if ($code eq 'euc') {
  203.     $line = &'jis_euc($line);
  204.   } elsif ($code eq 'jis') {
  205.     $line = &'jis_jis($line);
  206.   } elsif ($code eq 'sjis') {
  207.     $line = &'jis_sjis($line);
  208.   }
  209.   return $line;
  210. }
  211.  
  212. sub read_line {
  213.   local($userno, $line) = @_;
  214.   foreach $kanji (&'property($userno, 'kanji')) {
  215.     foreach $code (split(/\,/, "\L$kanji\E")) {
  216.       if ($code eq 'euc') {
  217.         $line = &'euc_jis($line);
  218.       } elsif ($code eq 'jis') {
  219.         $line = &'jis_jis($line);
  220.       } elsif ($code eq 'sjis') {
  221.         $line = &'sjis_jis($line);
  222.       }
  223.     }
  224.   }
  225.   return $line;
  226. }
  227.  
  228. sub write_line {
  229.   local($userno, $line) = @_;
  230.   local($kanji, $code);
  231.   $kanji = &'property($userno, 'kanji');
  232.   if ($kanji) {
  233.     $code = (split(/\,/, "\L$kanji\E"))[0];
  234.     if ($code eq 'euc') {
  235.       $line = &'jis_euc($line);
  236.     } elsif ($code eq 'jis') {
  237.       $line = &'jis_jis($line);
  238.     } elsif ($code eq 'sjis') {
  239.       $line = &'jis_sjis($line);
  240.     }
  241.   }
  242.   return $line;
  243. }
  244.  
  245. __END__
  246. --><HTML><HEAD>
  247. <META HTTP-EQUIV="Content-Type" CONTENT="text/html; charset=ISO-2022-JP">
  248. <LINK REV="made" HREF="mailto:hasegawa@agusa.nuie.nagoya-u.ac.jp">
  249. <TITLE>auto/reply.plm</TITLE></HEAD><BODY>
  250.  
  251. $B%*%s%i%$%s%I%-%e%a%s%H(B
  252.  
  253.  
  254. <HR><H3>$BL>A0(B</H3>
  255.  
  256. auto/reply.plm - $BFCDj$NH/8@$KH?1~$7$?%a%C%;!<%8$rH/8@$9$k(B
  257.  
  258.  
  259. <HR><H3>$B@bL@(B</H3>
  260.  
  261. $BFCDj$NH/8@$KH?1~$7$F!"$=$l$KBP$9$k%a%C%;!<%8$rH/8@$7$^$9!#(B
  262. $B0l$D$NH/8@$KBP$7$FJ#?t$N%a%C%;!<%8$r;XDj$9$k$3$H$,$G$-!"(B
  263. $B$=$NCf$+$i%i%s%@%`$G$I$l$+0l$D$N%a%C%;!<%8$rH/8@$7$^$9!#(B
  264. $B%a%C%;!<%8$O%U%!%$%k$G;XDj$7!"%U%!%$%k$N%U%)!<%^%C%H$O(B
  265. $B0J2<$N$h$&$K$J$C$F$$$^$9!#(B
  266.  
  267. <PRE>
  268. $B$3$s$P$s$o(B : $B$3$s$P$s$o!A!y(B $B$3$s$P$s!&$o$s!A(B
  269. $B$4$O$s(B* : $B$"$?$7$b9T$/!A(B
  270. *$B$W$i$`(B* : $B$h$s$@$!(B? $B$O!<$$!y(B
  271. </PRE>
  272.  
  273. $BH?1~$O0l9T$K0l$D5-=R$7!"H?1~$9$kH/8@$H$=$l$KBP$9$k%a%C%;!<%8$O(B
  274. $B!V(B:$B!W$H$=$NA08e$K(B1$B$D0J>e$N6uGr$r$D$1$F6h@Z$C$F;XDj$7$^$9!#(B
  275. $B$^$?!"H/8@$H%a%C%;!<%8$N$=$l$>$l$O(B1$B$D0J>e$N6uGr$G6h@Z$j$^$9!#(B
  276. $BH?1~$9$kH/8@$K$O%o%$%k%I%+!<%I$H$7$F!V(B*$B!W$,;XDj$G$-$^$9!#(B
  277.  
  278.  
  279. <HR><H3>$B%W%m%Q%F%#(B</H3>
  280.  
  281. <DL>
  282. <DT>  auto.reply.file $B%U%!%$%kL>(B[;({jis|euc|sjis})]
  283. </DT>
  284. <DD>    $BH?1~$9$k%a%C%;!<%8$rJ]B8$9$k%U%!%$%kL>$r;XDj$7$^$9!#(B
  285.         $B%U%!%$%k$O;XDj$7$?4A;z%3!<%I$GJ]B8$5$l$^$9!#(B
  286.         $B4A;z%3!<%I$rJ#?t;XDj$7$?>l9g$O!":G=i$K;XDj$7$?4A;z%3!<%I$G(B
  287.         $BJ]B8$5$l!">JN,$7$?>l9g$O!V(Bjis$B!W$r;XDj$7$?$3$H$HF1$8$G$9!#(B
  288.         $B$^$?!"!V(Beuc$B!W$H!V(Bsjis$B!W$rF1;~$K;XDj$9$k$3$H$O$G$-$^$;$s!#(B
  289. </DD>
  290. <DT>  auto.reply.rate $B3NN((B
  291. </DT>
  292. <DD>    $BH/8@$KH?1~$9$k3NN($r;XDj$7$^$9!#(B0$B$r;XDj$9$k$HA4$/H?1~$;$:!"(B
  293.         100$B$r;XDj$9$k$HA4$F$NH/8@$KH?1~$7$^$9!#(B
  294. </DD>
  295. <DT>  auto.reply.add* $BJ8;zNs(B
  296. </DT>
  297. <DD>    $BH?1~$9$k%a%C%;!<%8$rDI2C$9$k$?$a$NJ8;zNs$r;XDj$7$^$9!#(B
  298.         $BJ8;zNs$K$OH?1~$9$kH/8@$H$=$l$KBP$9$k%a%C%;!<%8$r(B
  299.         $B6uGr$G6h@Z$C$F;XDj$7$^$9!#(B
  300. </DD>
  301. <DT>  auto.reply.remove* $BJ8;zNs(B
  302. </DT>
  303. <DD>    $BH?1~$9$k%a%C%;!<%8$r:o=|$9$k$?$a$NJ8;zNs$r;XDj$7$^$9!#(B
  304.         $BJ8;zNs$K$OH?1~$9$kH/8@$H$=$l$KBP$9$k%a%C%;!<%8$r(B
  305.         $B6uGr$G6h@Z$C$F;XDj$7$^$9!#(B
  306. </DD>
  307. <DT>  auto.reply.change* $BJ8;zNs(B
  308. </DT>
  309. <DD>    $BH?1~$9$k%a%C%;!<%8$rJQ99$9$k$?$a$NJ8;zNs$r;XDj$7$^$9!#(B
  310.         $BJ8;zNs$K$OH?1~$9$kH/8@$H$=$l$KBP$9$k%a%C%;!<%8$r(B
  311.         $B6uGr$G6h@Z$C$F;XDj$7$^$9!#(B
  312. </DD>
  313. </DL>
  314.  
  315.  
  316. <HR><H3>$B@_DjNc(B</H3>
  317.  
  318. <PRE>
  319. + auto/reply.plm
  320. auto.reply.file: reply.txt;jis
  321. auto.reply.rate: 100
  322. auto.reply.add: $B%a%C%;!<%8DI2C(B
  323. auto.reply.remove: $B%a%C%;!<%8:o=|(B
  324. auto.reply.change: $B%a%C%;!<%8JQ99(B
  325. </PRE>
  326.  
  327. $B!V(Breply.txt$B!W$K=q$+$l$?FbMF$K$b$H$E$$$F!"H/8@$KH?1~$7$F$=$l$KBP$9$k(B
  328. $B%a%C%;!<%8$rH/8@$7$^$9!#(Breply.txt$B$O(Bjis$B$G=q$+$l$F$$$kI,MW$,$"$j$^$9!#(B
  329. $B$^$?!"!V%a%C%;!<%8DI2C(B $B$3$s$K$A$O(B $B$3$s$K$A$O!A!y!W$N$h$&$KH/8@$9$l$P!"(B
  330. $B?7$?$JH?1~$rDI2C$9$k$3$H$,$G$-$^$9!#(B
  331. $BF1MM$K!"!V%a%C%;!<%8:o=|(B $B$3$s$K$A$O(B $B$3$s$K$A$O!A!y!W$d!"(B
  332. $B!V%a%C%;!<%8JQ99(B $B$3$s$K$A$O(B $B$3$s$K$A!&$o$s!A!W$N$h$&$KH/8@$9$k$3$H$G!"(B
  333. $BH?1~$r:o=|$7$?$jJQ99$9$k$3$H$,$G$-$^$9!#(B
  334.  
  335. </BODY></HTML>
  336.