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 / answer.plm < prev    next >
Text File  |  1999-03-24  |  7KB  |  251 lines
  1. <!DOCTYPE HTML PUBLIC "-//IETF//DTD HTML//EN"><!-- $_ if 0; # -*- perl -*-
  2. # $Id: answer.plm,v 2.31 1999/01/21 17:16:20 hasegawa Exp $
  3. # copyright (c)1997-1999 Yoshinori Hasegawa <hasegawa@madoka.org>
  4.  
  5. package auto_answer;
  6.  
  7. $_ = 'auto_answer';
  8.  
  9. sub ss_privmsg {
  10.   local($serverno, $prefix, $cmd, @params) = @_;
  11.   local($userno, $nick, %alias, $to, $str, $answer);
  12.   $userno = $'userno[$serverno];
  13.   $nick = &'prefix($prefix);
  14.   %alias = &get_alias_user($userno, $prefix);
  15.   $alias{'nick.now'} = $nick;
  16.   if (&'channel($params[0])) {
  17.     $alias{'channel'} = $params[0];
  18.     $to = $params[0];
  19.   } else {
  20.     $to = $nick;
  21.   }
  22.   foreach $reply (&'property($userno, 'reply')) {
  23.     ($str, $answer) = split(/\s+/, $reply, 2);
  24.     next unless $str eq $params[1];
  25.     &privmsg($serverno, $to, &'format($answer, %alias));
  26.   }
  27.   return ($prefix, $cmd, @params);
  28. }
  29.  
  30. sub privmsg {
  31.   local($serverno, $to, $msg) = @_;
  32.   &'s_print($serverno, '', 'PRIVMSG', $to, $msg);
  33.   foreach $cno (&'array($'clientlist)) {
  34.     next unless $'avail[$cno];
  35.     next unless $'server[$cno] == $serverno;
  36.     &'c_print($cno, &'user($cno), 'PRIVMSG', $to, $msg);
  37.   }
  38. }
  39.  
  40. sub get_alias_user {
  41.   local($userno, $from, $prefix) = @_;
  42.   local($file, @list);
  43.   $file = &'property($userno, 'alias');
  44.   foreach $list (&split_list('nick', &read_file($file))) {
  45.     @list = &'array($list);
  46.     if (&match_alias_user($from, @list)) {
  47.       return &parse_alias($prefix, @list);
  48.     }
  49.   }
  50.   return ();
  51. }
  52.  
  53. sub match_alias_user {
  54.   local($from, @list) = @_;
  55.   local($var, $arg, $regex);
  56.   foreach $line (@list) {
  57.     ($var, $arg) = split(/\s+/, $line, 2);
  58.     next unless "\L$var\E" eq 'user';
  59.     $regex = &'regex($arg);
  60.     next unless $from =~ /$regex/i;
  61.     return 1;
  62.   }
  63.   return 0;
  64. }
  65.  
  66. sub parse_alias {
  67.   local($prefix, @list) = @_;
  68.   local(%alias, $var, $arg, $key);
  69.   %alias = ();
  70.   foreach $line (@list) {
  71.     ($var, $arg) = split(/\s+/, $line, 2);
  72.     $var = "\L$var\E";
  73.     if ($prefix) {
  74.       $key = $prefix . '.' . $var;
  75.     } else {
  76.       $key = $var;
  77.     }
  78.     next if defined($alias{$key});
  79.     if ($var eq 'nick') {
  80.       $alias{$key} = (split(/\,/, $arg))[0];
  81.     } elsif ($var eq 'name') {
  82.       $alias{$key} = (split(/\s+/, $arg))[0];
  83.     } else {
  84.       $alias{$key} = $arg;
  85.     }
  86.   }
  87.   return %alias;
  88. }
  89.  
  90. sub split_list {
  91.   local($field, @list) = @_;
  92.   local($var, $arg, @array, @entry);
  93.   $field = "\L$field\E";
  94.   @array = ();
  95.   @entry = ();
  96.   foreach $line (@list) {
  97.     ($var, $arg) = split(/\s*\:\s*/, $line, 2);
  98.     if ($field eq "\L$var\E") {
  99.       push(@array, &'list(@entry)) if @entry;
  100.       @entry = ();
  101.     }
  102.     push(@entry, $var . ' ' . $arg);
  103.   }
  104.   push(@array, &'list(@entry)) if @entry;
  105.   return @array;
  106. }
  107.  
  108. sub read_file {
  109.   local($file) = @_;
  110.   local($name, $code, $mtime, @data, $line);
  111.   ($name, $code) = &filename($file);
  112.   $mtime = (stat($name))[9];
  113.   if (defined($mtime)) {
  114.     $modify{$name} = -1 unless defined($modify{$name});
  115.     if ($modify{$name} != $mtime) {
  116.       if (open(TMP, $name)) {
  117.         @data = ();
  118.         while (defined($line = <TMP>)) {
  119.           $line =~ s/^\s+//;
  120.           next if $line =~ /^[\#\;]/;
  121.           $line =~ tr/\r\n//d;
  122.           next unless $line;
  123.           $line =~ s/\s+$//;
  124.           $line = &code_jis($line, $code) if $code;
  125.           push(@data, $line);
  126.         }
  127.         close(TMP);
  128.         $modify{$name} = $mtime;
  129.         $cache{$name} = &'list(@data);
  130.         return @data;
  131.       }
  132.     } else {
  133.       return &'array($cache{$name});
  134.     }
  135.   }
  136.   return ();
  137. }
  138.  
  139. sub filename {
  140.   local($file) = @_;
  141.   local($idx, $name, $code);
  142.   return ('', '') unless $file;
  143.   if (($idx = rindex($file, ';')) != -1) {
  144.     $name = substr($file, 0, $idx);
  145.     $code = substr($file, $idx + 1);
  146.   } else {
  147.     $name = $file;
  148.     $code = '';
  149.   }
  150.   return (&'expand($name), $code);
  151. }
  152.  
  153. sub code_jis {
  154.   local($line, $list) = @_;
  155.   foreach $code (split(/\,/, "\L$list\E")) {
  156.     if ($code eq 'euc') {
  157.       $line = &'euc_jis($line);
  158.     } elsif ($code eq 'jis') {
  159.       $line = &'jis_jis($line);
  160.     } elsif ($code eq 'sjis') {
  161.       $line = &'sjis_jis($line);
  162.     }
  163.   }
  164.   return $line;
  165. }
  166.  
  167. sub jis_code {
  168.   local($line, $list) = @_;
  169.   local($code);
  170.   $code = (split(/\,/, "\L$list\E"))[0];
  171.   if ($code eq 'euc') {
  172.     $line = &'jis_euc($line);
  173.   } elsif ($code eq 'jis') {
  174.     $line = &'jis_jis($line);
  175.   } elsif ($code eq 'sjis') {
  176.     $line = &'jis_sjis($line);
  177.   }
  178.   return $line;
  179. }
  180.  
  181. __END__
  182. --><HTML><HEAD>
  183. <META HTTP-EQUIV="Content-Type" CONTENT="text/html; charset=ISO-2022-JP">
  184. <LINK REV="made" HREF="mailto:hasegawa@madoka.org">
  185. <TITLE>auto/answer.plm</TITLE></HEAD><BODY>
  186.  
  187. $B%*%s%i%$%s%I%-%e%a%s%H(B
  188.  
  189.  
  190. <HR><H3>$BL>A0(B</H3>
  191.  
  192. auto/answer.plm - $BFCDj$NH/8@$KH?1~$7$FBP1~$9$kH/8@$r$9$k(B
  193.  
  194.  
  195. <HR><H3>$B@bL@(B</H3>
  196.  
  197. $BFCDj$NJ8;zNs$,H/8@$5$l$k$H!"$=$l$KBP1~$9$kJ8;zNs$rH/8@$7$^$9!#(B
  198. $B$9$Y$F$NH/8@$KH?1~$9$k$?$a!"F1$8H/8@$r2?EY$b7+$jJV$92DG=@-$,(B
  199. $B$"$k$N$GCm0U$7$F2<$5$$!#(B
  200.  
  201.  
  202. <HR><H3>$B%W%m%Q%F%#(B</H3>
  203.  
  204. <DL>
  205. <DT>  auto.answer.alias $B%U%!%$%kL>(B[;({jis|euc|sjis})]
  206. </DT>
  207. <DD>    $B%f!<%6L>$N%(%$%j%"%9$rDj5A$9$k%U%!%$%k$r;XDj$7$^$9!#(B
  208.         $B$3$N%U%!%$%k$O(Bauto/alias.plm$B$G;H$&$b$N$HF1$8$b$N$G$9!#(B
  209.         $B%U%!%$%k$O;XDj$7$?4A;z%3!<%I$GJ]B8$5$l$F$$$kI,MW$,$"$j$^$9!#(B
  210. </DD>
  211. <DT>  auto.answer.reply* $BJ8;zNs(B $B%U%)!<%^%C%H(B
  212. </DT>
  213. <DD>    $BH?1~$9$kH/8@$H!"$=$l$KBP$9$kJV;v$r;XDj$7$^$9!#H?1~$9$kH/8@$K$O(B
  214.         $B6uGr$r4^$a$k$3$H$O$G$-$^$;$s!#JV;v$K(B#(nick)$B$N$h$&$K=q$/$3$H$G!"(B
  215.         $B%(%$%j%"%9$NBP1~$9$k%G!<%?$GCV$-49$($k$3$H$,$G$-$^$9!#(B
  216.         $B$^$?!"%(%$%j%"%90J30$K$b(B#(nick.now)$B$G8=:_$N%K%C%/%M!<%`$K!"(B
  217.         #(channel)$B$GH/8@$N$"$C$?%A%c%s%M%kL>$KCV49$7$^$9!#(B
  218.         $B$^$?!"3g8LFb$r!V(B|$B!W$G6h@Z$C$FJ#?t;XDj$7$?>l9g!"(B
  219.         $B:G=i$KDj5A$5$l$F$$$kCM$GCV$-49$($^$9!#(B
  220. </DD>
  221. </DL>
  222.  
  223.  
  224. <HR><H3>$B@_DjNc(B</H3>
  225.  
  226. <PRE>
  227. + auto/answer.plm
  228. auto.answer.alias: alias.txt
  229. auto.answer.reply: $B$3$s$K$A$O(B $B$3$s$K$A$O!A!y(B
  230. auto.answer.reply: $B$3$s$P$s$O(B #(name|nick|nick.now)$B$5$s!"$3$s$P$s$O!A!y(B
  231. </PRE>
  232.  
  233. $B!V$3$s$K$A$O!W$H$$$&H/8@$,$"$C$?$H$-$K!V$3$s$K$A$O!A!y!W$HH/8@$7$^$9!#(B
  234. $B$^$?!"!V$3$s$P$s$O!W$H$$$&H/8@$,$"$C$?$H$-$K!"(B
  235. $BH/8@$7$??M$N%(%$%j%"%9$r!V(Balias.txt$B!W$+$i;2>H$7$F!"(B
  236. $BNc$($P!V$W$i$`$5$s!"$3$s$P$s$o!A!y!W$N$h$&$KH/8@$7$^$9!#(B
  237.  
  238. <PRE>
  239. + auto/answer.plm
  240. auto.answer.reply: $B$X$k$W(B $BEA8@5!G=$H>.Jq5!G=$N%X%k%W$G$9(B
  241. auto.answer.reply: $B$X$k$W(B $B$G$s$4$s(B nick message : nick$B08$K%a%C%;!<%8$rFO$1$^$9(B
  242. auto.answer.reply: $B$X$k$W(B $B$3$E$D$_(B nick message : nick$B08$K%U%!%$%k$rFO$1$^$9(B
  243. auto.answer.reply: $B$3$E$D$_$X$k$W(B DCC$B$rAw$C$F$+$i08@h$r65$($F2<$5$$$M(B
  244. </PRE>
  245.  
  246. $B!V$X$k$W!W$HH/8@$9$k$H!"(B3$B9T$K$o$?$k%X%k%W%a%C%;!<%8$rH/8@$7$^$9!#(B
  247. $B$^$?!"!V$3$E$D$_$X$k$W!W$HH/8@$9$k$H!"(B
  248. $B!V(BDCC$B$r@h$KAw$C$F$+$i08@h$r65$($F2<$5$$$M!W$HH/8@$7$^$9!#(B
  249.  
  250. </BODY></HTML>
  251.