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 / reply.plm < prev    next >
Text File  |  1999-03-24  |  12KB  |  427 lines
  1. <!DOCTYPE HTML PUBLIC "-//IETF//DTD HTML//EN"><!-- $_ if 0; # -*- perl -*-
  2. # $Id: reply.plm,v 2.29 1999/01/28 14:56:27 hasegawa Exp $
  3. # copyright (c)1998-1999 Yoshinori Hasegawa <hasegawa@madoka.org>
  4.  
  5. package auto_reply;
  6.  
  7. $FORMAT = '#(message)';
  8.  
  9. $_ = 'auto_reply';
  10.  
  11. sub ss_privmsg {
  12.   local($serverno, $prefix, $cmd, @params) = @_;
  13.   local($userno, $mtime, $file, $idx, $name, $code, $req, $rep, $rate, @list, %alias, $regex, $to, $str, @format);
  14.   $userno = $'userno[$serverno];
  15.   $file = &'property($userno, 'file') || '';
  16.   if (($idx = rindex($file, ';')) != -1) {
  17.     $name = substr($file, 0, $idx);
  18.     $code = substr($file, $idx + 1);
  19.   } else {
  20.     $name = $file;
  21.     $code = '';
  22.   }
  23.   $name = &'expand($name);
  24.   if ($name) {
  25.     $mtime = (stat($name))[9];
  26.     if (defined($mtime) && ($modify[$userno] || 0) != $mtime) {
  27.       $modify[$userno] = $mtime;
  28.       &read_data($userno);
  29.     }
  30.   }
  31.   ($req, @reply) = split(/\s+/, $params[1]);
  32.   if (@reply) {
  33.     foreach $add (&'property($userno, 'add')) {
  34.       next unless $req eq $add;
  35.       &add_file($userno, @reply);
  36.       return ($prefix, $cmd, @params);
  37.     }
  38.     foreach $remove (&'property($userno, 'remove')) {
  39.       next unless $req eq $remove;
  40.       &remove_file($userno, @reply);
  41.       return ($prefix, $cmd, @params);
  42.     }
  43.     foreach $change (&'property($userno, 'change')) {
  44.       next unless $req eq $change;
  45.       &change_file($userno, @reply);
  46.       return ($prefix, $cmd, @params);
  47.     }
  48.   }
  49.   $rate = &'property($userno, 'rate');
  50.   if (rand(100) < $rate) {
  51.     foreach $str (&'array($message[$userno])) {
  52.       ($req, $rep) = &parse($str);
  53.       foreach $text (&'array($req)) {
  54.         $regex = &'regex(&'jis_euc($text));
  55.         next unless &'jis_euc($params[1]) =~ /$regex/;
  56.         @list = &'array($rep);
  57.         $str = $list[rand(@list)];
  58.         %alias = &get_alias_user($userno, $prefix);
  59.         $alias{'nick.now'} = (&'prefix($prefix))[0];
  60.         $alias{'message'} = &'format($str, %alias);
  61.         if (&'channel($params[0])) {
  62.           $alias{'channel'} = $params[0];
  63.           $to = $params[0];
  64.         } else {
  65.           $to = &'prefix($prefix);
  66.         }
  67.         @format = &'property($userno, 'format');
  68.         if (@format) {
  69.           foreach $reply (@format) {
  70.             &privmsg($serverno, $to, &'format($reply, %alias));
  71.           }
  72.         } else {
  73.           &privmsg($serverno, $to, &'format($FORMAT, %alias));
  74.         }
  75.         return ($prefix, $cmd, @params);
  76.       }
  77.     }
  78.   }
  79.   return ($prefix, $cmd, @params);
  80. }
  81.  
  82. sub privmsg {
  83.   local($serverno, $to, $msg) = @_;
  84.   &'s_print($serverno, '', 'PRIVMSG', $to, $msg);
  85.   foreach $cno (&'array($'clientlist)) {
  86.     next unless $'avail[$cno];
  87.     next unless $'server[$cno] == $serverno;
  88.     &'c_print($cno, &'user($cno), 'PRIVMSG', $to, $msg);
  89.   }
  90. }
  91.  
  92. sub parse {
  93.   local($str) = @_;
  94.   local($left, $right, $req, $rep);
  95.   ($left, $right) = split(/\s+\:\s+/, $str);
  96.   $req = &'list(split(/\s+/, $left || ''));
  97.   $rep = &'list(split(/\s+/, $right || ''));
  98.   return ($req, $rep);
  99. }
  100.  
  101. sub add_file {
  102.   local($userno, $req, @reply) = @_;
  103.   local(@array, $line, $recv, $send, $i);
  104.   @array = &'array($message[$userno]);
  105.   for ($i = 0; $i < @array; $i++) {
  106.     ($recv, $send) = &parse($array[$i]);
  107.     next unless &'exist($recv, $req);
  108.     $array[$i] = join(' ', &'array($recv)) . ' : ' . join(' ', &'array(&'add($send, @reply)));
  109.     $message[$userno] = &'list(@array);
  110.     &write_file($userno);
  111.     return;
  112.   }
  113.   push(@array, $req . ' : ' . join(' ', @reply));
  114.   $message[$userno] = &'list(@array);
  115.   &write_file($userno);
  116. }
  117.  
  118. sub remove_file {
  119.   local($userno, $req, @reply) = @_;
  120.   local(@array, $line, $recv, $send, $i);
  121.   @array = &'array($message[$userno]);
  122.   for ($i = 0; $i < @array; $i++) {
  123.     ($recv, $send) = &parse($array[$i]);
  124.     next unless &'exist($recv, $req);
  125.     $send = &'remove($send, @reply);
  126.     if ($send) {
  127.       $array[$i] = join(' ', &'array($recv)) . ' : ' . join(' ', &'array($send));
  128.     } else {
  129.       splice(@array, $i, 1);
  130.     }
  131.     last;
  132.   }
  133.   $message[$userno] = &'list(@array);
  134.   &write_file($userno);
  135. }
  136.  
  137. sub change_file {
  138.   local($userno, $req, @reply) = @_;
  139.   local(@array, $line, $recv, $send, $i);
  140.   @array = &'array($message[$userno]);
  141.   for ($i = 0; $i < @array; $i++) {
  142.     ($recv, $send) = &parse($array[$i]);
  143.     next unless &'exist($recv, $req);
  144.     $array[$i] = join(' ', &'array($recv)) . ' : ' . join(' ', &'array(&'change($send, @reply)));
  145.     last;
  146.   }
  147.   $message[$userno] = &'list(@array);
  148.   &write_file($userno);
  149. }
  150.  
  151. sub read_data {
  152.   local($userno) = @_;
  153.   local($name, $code, $line);
  154.   ($name, $code) = &filename(&'property($userno, 'file'));
  155.   if ($name && open(FILE, $name)) {
  156.     undef($message[$userno]);
  157.     while (defined($line = <FILE>)) {
  158.       $line =~ tr/\r\n//d;
  159.       next unless $line;
  160.       $line = &code_jis($line, $code) if $code;
  161.       $message[$userno] = &'add($message[$userno], $line);
  162.     }
  163.     close(FILE);
  164.   }
  165. }
  166.  
  167. sub write_file {
  168.   local($userno) = @_;
  169.   local($name, $code);
  170.   ($name, $code) = &filename(&'property($userno, 'file'));
  171.   if ($name && open(FILE, ">$name")) {
  172.     foreach $line (&'array($message[$userno])) {
  173.       $line = &jis_code($line, $code) if $code;
  174.       print FILE $line, "\n";
  175.     }
  176.     close(FILE);
  177.   }
  178. }
  179.  
  180. sub get_alias_user {
  181.   local($userno, $from, $prefix) = @_;
  182.   local($file, @list);
  183.   $file = &'property($userno, 'alias');
  184.   foreach $list (&split_list('nick', &read_file($file))) {
  185.     @list = &'array($list);
  186.     if (&match_alias_user($from, @list)) {
  187.       return &parse_alias($prefix, @list);
  188.     }
  189.   }
  190.   return ();
  191. }
  192.  
  193. sub match_alias_user {
  194.   local($from, @list) = @_;
  195.   local($var, $arg, $regex);
  196.   foreach $line (@list) {
  197.     ($var, $arg) = split(/\s+/, $line, 2);
  198.     next unless "\L$var\E" eq 'user';
  199.     $regex = &'regex($arg);
  200.     next unless $from =~ /$regex/i;
  201.     return 1;
  202.   }
  203.   return 0;
  204. }
  205.  
  206. sub parse_alias {
  207.   local($prefix, @list) = @_;
  208.   local(%alias, $var, $arg, $key);
  209.   %alias = ();
  210.   foreach $line (@list) {
  211.     ($var, $arg) = split(/\s+/, $line, 2);
  212.     $var = "\L$var\E";
  213.     if ($prefix) {
  214.       $key = $prefix . '.' . $var;
  215.     } else {
  216.       $key = $var;
  217.     }
  218.     next if defined($alias{$key});
  219.     if ($var eq 'nick') {
  220.       $alias{$key} = (split(/\,/, $arg))[0];
  221.     } elsif ($var eq 'name') {
  222.       $alias{$key} = (split(/\s+/, $arg))[0];
  223.     } else {
  224.       $alias{$key} = $arg;
  225.     }
  226.   }
  227.   return %alias;
  228. }
  229.  
  230. sub split_list {
  231.   local($field, @list) = @_;
  232.   local($var, $arg, @array, @entry);
  233.   $field = "\L$field\E";
  234.   @array = ();
  235.   @entry = ();
  236.   foreach $line (@list) {
  237.     ($var, $arg) = split(/\s*\:\s*/, $line, 2);
  238.     if ($field eq "\L$var\E") {
  239.       push(@array, &'list(@entry)) if @entry;
  240.       @entry = ();
  241.     }
  242.     push(@entry, $var . ' ' . $arg);
  243.   }
  244.   push(@array, &'list(@entry)) if @entry;
  245.   return @array;
  246. }
  247.  
  248. sub read_file {
  249.   local($file) = @_;
  250.   local($name, $code, $mtime, @data, $line);
  251.   ($name, $code) = &filename($file);
  252.   $mtime = (stat($name))[9];
  253.   if (defined($mtime)) {
  254.     $modify{$name} = -1 unless defined($modify{$name});
  255.     if ($modify{$name} != $mtime) {
  256.       if (open(TMP, $name)) {
  257.         @data = ();
  258.         while (defined($line = <TMP>)) {
  259.           $line =~ s/^\s+//;
  260.           next if $line =~ /^[\#\;]/;
  261.           $line =~ tr/\r\n//d;
  262.           next unless $line;
  263.           $line =~ s/\s+$//;
  264.           $line = &code_jis($line, $code) if $code;
  265.           push(@data, $line);
  266.         }
  267.         close(TMP);
  268.         $modify{$name} = $mtime;
  269.         $cache{$name} = &'list(@data);
  270.         return @data;
  271.       }
  272.     } else {
  273.       return &'array($cache{$name});
  274.     }
  275.   }
  276.   return ();
  277. }
  278.  
  279. sub filename {
  280.   local($file) = @_;
  281.   local($idx, $name, $code);
  282.   return ('', '') unless $file;
  283.   if (($idx = rindex($file, ';')) != -1) {
  284.     $name = substr($file, 0, $idx);
  285.     $code = substr($file, $idx + 1);
  286.   } else {
  287.     $name = $file;
  288.     $code = '';
  289.   }
  290.   return (&'expand($name), $code);
  291. }
  292.  
  293. sub code_jis {
  294.   local($line, $list) = @_;
  295.   foreach $code (split(/\,/, "\L$list\E")) {
  296.     if ($code eq 'euc') {
  297.       $line = &'euc_jis($line);
  298.     } elsif ($code eq 'jis') {
  299.       $line = &'jis_jis($line);
  300.     } elsif ($code eq 'sjis') {
  301.       $line = &'sjis_jis($line);
  302.     }
  303.   }
  304.   return $line;
  305. }
  306.  
  307. sub jis_code {
  308.   local($line, $list) = @_;
  309.   local($code);
  310.   $code = (split(/\,/, "\L$list\E"))[0];
  311.   if ($code eq 'euc') {
  312.     $line = &'jis_euc($line);
  313.   } elsif ($code eq 'jis') {
  314.     $line = &'jis_jis($line);
  315.   } elsif ($code eq 'sjis') {
  316.     $line = &'jis_sjis($line);
  317.   }
  318.   return $line;
  319. }
  320.  
  321. __END__
  322. --><HTML><HEAD>
  323. <META HTTP-EQUIV="Content-Type" CONTENT="text/html; charset=ISO-2022-JP">
  324. <LINK REV="made" HREF="mailto:hasegawa@madoka.org">
  325. <TITLE>auto/reply.plm</TITLE></HEAD><BODY>
  326.  
  327. $B%*%s%i%$%s%I%-%e%a%s%H(B
  328.  
  329.  
  330. <HR><H3>$BL>A0(B</H3>
  331.  
  332. auto/reply.plm - $BFCDj$NH/8@$KH?1~$7$?%a%C%;!<%8$rH/8@$9$k(B
  333.  
  334.  
  335. <HR><H3>$B@bL@(B</H3>
  336.  
  337. $BFCDj$NH/8@$KH?1~$7$F!"$=$l$KBP$9$k%a%C%;!<%8$rH/8@$7$^$9!#(B
  338. $B0l$D$NH/8@$KBP$7$FJ#?t$N%a%C%;!<%8$r;XDj$9$k$3$H$,$G$-!"(B
  339. $B$=$NCf$+$i%i%s%@%`$G$I$l$+0l$D$N%a%C%;!<%8$rH/8@$7$^$9!#(B
  340. $B%a%C%;!<%8$O%U%!%$%k$G;XDj$7!"%U%!%$%k$N%U%)!<%^%C%H$O(B
  341. $B0J2<$N$h$&$K$J$C$F$$$^$9!#(B
  342.  
  343. <PRE>
  344. $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
  345. $B$4$O$s(B* : $B$"$?$7$b9T$/!A(B
  346. *$B$W$i$`(B* : $B$h$s$@$!(B? $B$O!<$$!y(B
  347. </PRE>
  348.  
  349. $BH?1~$O0l9T$K0l$D5-=R$7!"H?1~$9$kH/8@$H$=$l$KBP$9$k%a%C%;!<%8$O(B
  350. $B!V(B:$B!W$H$=$NA08e$K(B1$B$D0J>e$N6uGr$r$D$1$F6h@Z$C$F;XDj$7$^$9!#(B
  351. $B$^$?!"H/8@$H%a%C%;!<%8$N$=$l$>$l$O(B1$B$D0J>e$N6uGr$G6h@Z$j$^$9!#(B
  352. $BH?1~$9$kH/8@$K$O%o%$%k%I%+!<%I$H$7$F!V(B*$B!W$,;XDj$G$-$^$9!#(B
  353.  
  354.  
  355. <HR><H3>$B%W%m%Q%F%#(B</H3>
  356.  
  357. <DL>
  358. <DT>  auto.reply.file $B%U%!%$%kL>(B[;({jis|euc|sjis})]
  359. </DT>
  360. <DD>    $BH?1~$9$k%a%C%;!<%8$rJ]B8$9$k%U%!%$%kL>$r;XDj$7$^$9!#(B
  361.         $B%U%!%$%k$O;XDj$7$?4A;z%3!<%I$GJ]B8$5$l$^$9!#(B
  362.         $B4A;z%3!<%I$rJ#?t;XDj$7$?>l9g$O!":G=i$K;XDj$7$?4A;z%3!<%I$G(B
  363.         $BJ]B8$5$l!">JN,$7$?>l9g$O!V(Bjis$B!W$r;XDj$7$?$3$H$HF1$8$G$9!#(B
  364.         $B$^$?!"!V(Beuc$B!W$H!V(Bsjis$B!W$rF1;~$K;XDj$9$k$3$H$O$G$-$^$;$s!#(B
  365. </DD>
  366. <DT>  auto.random.alias $B%U%!%$%kL>(B[;({jis|euc|sjis})]
  367. </DT>
  368. <DD>    $B%(%$%j%"%9$r;2>H$9$k%U%!%$%k$r;XDj$7$^$9!#(B
  369.         $B$3$N%U%!%$%k$O(Bauto/alias.plm$B$G;H$&$b$N$HF1$8$b$N$G$9!#(B
  370.         $B%U%!%$%k$O;XDj$7$?4A;z%3!<%I$GJ]B8$5$l$F$$$kI,MW$,$"$j$^$9!#(B
  371. </DD>
  372. <DT>  auto.reply.format* $B%U%)!<%^%C%H(B
  373. </DT>
  374. <DD>    $B%a%C%;!<%8$rH/8@$9$k:]$N%U%)!<%^%C%H$r;XDj$7$^$9!#(B
  375.         $B%U%)!<%^%C%H$K(B#(nick)$B$N$h$&$K;XDj$9$k$3$H$G%(%$%j%"%9Cf$N(B
  376.         $BBP1~$9$kCM$GCV$-49$($^$9!#$^$?(B#(message)$B$G%a%C%;!<%8$NFbMF$K!"(B
  377.         #(nick.now)$B$G8=:_$N%K%C%/%M!<%`$K!"(B#(channel)$B$G%A%c%s%M%kL>$K(B
  378.         $B$=$l$>$lCV$-49$($^$9!#(B
  379. </DD>
  380. <DT>  auto.reply.rate $B3NN((B
  381. </DT>
  382. <DD>    $BH/8@$KH?1~$9$k3NN($r;XDj$7$^$9!#(B0$B$r;XDj$9$k$HA4$/H?1~$;$:!"(B
  383.         100$B$r;XDj$9$k$HA4$F$NH/8@$KH?1~$7$^$9!#(B
  384. </DD>
  385. <DT>  auto.reply.add* $BJ8;zNs(B
  386. </DT>
  387. <DD>    $BH?1~$9$k%a%C%;!<%8$rDI2C$9$k$?$a$NJ8;zNs$r;XDj$7$^$9!#(B
  388.         $BJ8;zNs$K$OH?1~$9$kH/8@$H$=$l$KBP$9$k%a%C%;!<%8$r(B
  389.         $B6uGr$G6h@Z$C$F;XDj$7$^$9!#(B
  390. </DD>
  391. <DT>  auto.reply.remove* $BJ8;zNs(B
  392. </DT>
  393. <DD>    $BH?1~$9$k%a%C%;!<%8$r:o=|$9$k$?$a$NJ8;zNs$r;XDj$7$^$9!#(B
  394.         $BJ8;zNs$K$OH?1~$9$kH/8@$H$=$l$KBP$9$k%a%C%;!<%8$r(B
  395.         $B6uGr$G6h@Z$C$F;XDj$7$^$9!#(B
  396. </DD>
  397. <DT>  auto.reply.change* $BJ8;zNs(B
  398. </DT>
  399. <DD>    $BH?1~$9$k%a%C%;!<%8$rJQ99$9$k$?$a$NJ8;zNs$r;XDj$7$^$9!#(B
  400.         $BJ8;zNs$K$OH?1~$9$kH/8@$H$=$l$KBP$9$k%a%C%;!<%8$r(B
  401.         $B6uGr$G6h@Z$C$F;XDj$7$^$9!#(B
  402. </DD>
  403. </DL>
  404.  
  405.  
  406. <HR><H3>$B@_DjNc(B</H3>
  407.  
  408. <PRE>
  409. + auto/reply.plm
  410. auto.reply.file: reply.txt;jis
  411. auto.reply.format: #(name): #(message)
  412. auto.reply.rate: 100
  413. auto.reply.add: $B%a%C%;!<%8DI2C(B
  414. auto.reply.remove: $B%a%C%;!<%8:o=|(B
  415. auto.reply.change: $B%a%C%;!<%8JQ99(B
  416. </PRE>
  417.  
  418. $B!V(Breply.txt$B!W$K=q$+$l$?FbMF$K4p$E$$$F!"H/8@$KH?1~$7$F$=$l$KBP$9$k(B
  419. $B%a%C%;!<%8$rH/8@$7$^$9!#(Breply.txt$B$O(Bjis$B$G=q$+$l$F$$$kI,MW$,$"$j$^$9!#(B
  420. $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
  421. $B?7$?$JH?1~$rDI2C$9$k$3$H$,$G$-$^$9!#(B
  422. $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
  423. $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
  424. $BH?1~$r:o=|$7$?$jJQ99$9$k$3$H$,$G$-$^$9!#(B
  425.  
  426. </BODY></HTML>
  427.