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 / response.plm < prev    next >
Text File  |  1999-03-24  |  8KB  |  321 lines
  1. <!DOCTYPE HTML PUBLIC "-//IETF//DTD HTML//EN"><!-- $_ if 0; # -*- perl -*-
  2. # $Id: response.plm,v 2.13 1999/01/21 16:19:43 hasegawa Exp $
  3. # copyright (c)1998-1999 Yoshinori Hasegawa <hasegawa@madoka.org>
  4.  
  5. package auto_response;
  6.  
  7. $FORMAT = '#(message)';
  8.  
  9. $_ = 'auto_response';
  10.  
  11. sub ss_privmsg {
  12.   local($serverno, $prefix, $cmd, @params) = @_;
  13.   local($userno, @data, %alias, $to, @format, $list, $rate, @rand);
  14.   $userno = $'userno[$serverno];
  15.   @data = &get_response($userno, $params[1]);
  16.   %alias = &get_alias_user($userno, $prefix);
  17.   $alias{'nick.now'} = (&'prefix($prefix))[0];
  18.   if (&'channel($params[0])) {
  19.     $alias{'channel'} = &'list($params[0]);
  20.     $to = $params[0];
  21.   } else {
  22.     $to = &'prefix($prefix);
  23.   }
  24.   foreach $list (@data) {
  25.     ($rate, @rand) = &'array($list);
  26.     next unless rand(100) < $rate;
  27.     $alias{'message'} = &'format($rand[rand(@rand)], %alias);
  28.     @format = &'property($userno, 'format');
  29.     if (@format) {
  30.       foreach $reply (@format) {
  31.         &privmsg($serverno, $to, &'format($reply, %alias));
  32.       }
  33.     } else {
  34.       &privmsg($serverno, $to, &'format($FORMAT, %alias));
  35.     }
  36.   }
  37.   return ($prefix, $cmd, @params);
  38. }
  39.  
  40. sub privmsg {
  41.   local($serverno, $to, $msg) = @_;
  42.   &'s_print($serverno, '', 'PRIVMSG', $to, $msg);
  43.   foreach $cno (&'array($'clientlist)) {
  44.     next unless $'avail[$cno];
  45.     next unless $'server[$cno] == $serverno;
  46.     &'c_print($cno, &'user($cno), 'PRIVMSG', $to, $msg);
  47.   }
  48. }
  49.  
  50. sub get_response {
  51.   local($userno, $text) = @_;
  52.   local($file, @list);
  53.   $file = &'property($userno, 'file');
  54.   foreach $list (&split_list('pattern', &read_file($file))) {
  55.     @list = &'array($list);
  56.     if (&match_response($text, @list)) {
  57.       return &parse_response(@list);
  58.     }
  59.   }
  60.   return ();
  61. }
  62.  
  63. sub match_response {
  64.   local($value, @list) = @_;
  65.   local($regex, $var, $arg, $pat);
  66.   foreach $line (@list) {
  67.     ($var, $arg) = split(/\s+/, $line, 2);
  68.     next unless "\L$var\E" eq 'pattern';
  69.     if (&'exist($'kanjilist, 'euc') || !&'exist($'kanjilist, 'sjis')) {
  70.       $pat = &'jis_euc($arg);
  71.       return 1 if &'jis_euc($value) =~ /$pat/;
  72.     } else {
  73.       $pat = &'jis_sjis($arg);
  74.       return 1 if &'jis_sjis($value) =~ /$pat/;
  75.     }
  76.   }
  77.   return 0;
  78. }
  79.  
  80. sub parse_response {
  81.   local(@list) = @_;
  82.   local(@data, $var, $arg, $rate, @tmp);
  83.   $rate = 0;
  84.   @tmp = ();
  85.   @data = ();
  86.   foreach $line (@list) {
  87.     ($var, $arg) = split(/\s+/, $line, 2);
  88.     $var = "\L$var\E";
  89.     if ($var eq 'rate') {
  90.       push(@data, &'list($rate, @tmp)) if ($rate && @tmp);
  91.       $rate = $arg;
  92.       @tmp = ();
  93.     } elsif ($var eq 'response') {
  94.       push(@tmp, $arg);
  95.     }
  96.   }
  97.   push(@data, &'list($rate, @tmp)) if ($rate && @tmp);
  98.   return @data;
  99. }
  100.  
  101. sub get_alias_user {
  102.   local($userno, $from, $prefix) = @_;
  103.   local($file, @list);
  104.   $file = &'property($userno, 'alias');
  105.   foreach $list (&split_list('nick', &read_file($file))) {
  106.     @list = &'array($list);
  107.     if (&match_alias_user($from, @list)) {
  108.       return &parse_alias($prefix, @list);
  109.     }
  110.   }
  111.   return ();
  112. }
  113.  
  114. sub match_alias_user {
  115.   local($from, @list) = @_;
  116.   local($var, $arg, $regex);
  117.   foreach $line (@list) {
  118.     ($var, $arg) = split(/\s+/, $line, 2);
  119.     next unless "\L$var\E" eq 'user';
  120.     $regex = &'regex($arg);
  121.     next unless $from =~ /$regex/i;
  122.     return 1;
  123.   }
  124.   return 0;
  125. }
  126.  
  127. sub parse_alias {
  128.   local($prefix, @list) = @_;
  129.   local(%alias, $var, $arg, $key);
  130.   %alias = ();
  131.   foreach $line (@list) {
  132.     ($var, $arg) = split(/\s+/, $line, 2);
  133.     $var = "\L$var\E";
  134.     if ($prefix) {
  135.       $key = $prefix . '.' . $var;
  136.     } else {
  137.       $key = $var;
  138.     }
  139.     next if defined($alias{$key});
  140.     if ($var eq 'nick') {
  141.       $alias{$key} = (split(/\,/, $arg))[0];
  142.     } elsif ($var eq 'name') {
  143.       $alias{$key} = (split(/\s+/, $arg))[0];
  144.     } else {
  145.       $alias{$key} = $arg;
  146.     }
  147.   }
  148.   return %alias;
  149. }
  150.  
  151. sub split_list {
  152.   local($field, @list) = @_;
  153.   local($var, $arg, @array, @entry);
  154.   $field = "\L$field\E";
  155.   @array = ();
  156.   @entry = ();
  157.   foreach $line (@list) {
  158.     ($var, $arg) = split(/\s*\:\s*/, $line, 2);
  159.     if ($field eq "\L$var\E") {
  160.       push(@array, &'list(@entry)) if @entry;
  161.       @entry = ();
  162.     }
  163.     push(@entry, $var . ' ' . $arg);
  164.   }
  165.   push(@array, &'list(@entry)) if @entry;
  166.   return @array;
  167. }
  168.  
  169. sub read_file {
  170.   local($file) = @_;
  171.   local($name, $code, $mtime, @data, $line);
  172.   ($name, $code) = &filename($file);
  173.   $mtime = (stat($name))[9];
  174.   if (defined($mtime)) {
  175.     $modify{$name} = -1 unless defined($modify{$name});
  176.     if ($modify{$name} != $mtime) {
  177.       if (open(TMP, $name)) {
  178.         @data = ();
  179.         while (defined($line = <TMP>)) {
  180.           $line =~ s/^\s+//;
  181.           next if $line =~ /^[\#\;]/;
  182.           $line =~ tr/\r\n//d;
  183.           next unless $line;
  184.           $line =~ s/\s+$//;
  185.           $line = &code_jis($line, $code) if $code;
  186.           push(@data, $line);
  187.         }
  188.         close(TMP);
  189.         $modify{$name} = $mtime;
  190.         $cache{$name} = &'list(@data);
  191.         return @data;
  192.       }
  193.     } else {
  194.       return &'array($cache{$name});
  195.     }
  196.   }
  197.   return ();
  198. }
  199.  
  200. sub filename {
  201.   local($file) = @_;
  202.   local($idx, $name, $code);
  203.   return ('', '') unless $file;
  204.   if (($idx = rindex($file, ';')) != -1) {
  205.     $name = substr($file, 0, $idx);
  206.     $code = substr($file, $idx + 1);
  207.   } else {
  208.     $name = $file;
  209.     $code = '';
  210.   }
  211.   return (&'expand($name), $code);
  212. }
  213.  
  214. sub code_jis {
  215.   local($line, $list) = @_;
  216.   foreach $code (split(/\,/, "\L$list\E")) {
  217.     if ($code eq 'euc') {
  218.       $line = &'euc_jis($line);
  219.     } elsif ($code eq 'jis') {
  220.       $line = &'jis_jis($line);
  221.     } elsif ($code eq 'sjis') {
  222.       $line = &'sjis_jis($line);
  223.     }
  224.   }
  225.   return $line;
  226. }
  227.  
  228. sub jis_code {
  229.   local($line, $list) = @_;
  230.   local($code);
  231.   $code = (split(/\,/, "\L$list\E"))[0];
  232.   if ($code eq 'euc') {
  233.     $line = &'jis_euc($line);
  234.   } elsif ($code eq 'jis') {
  235.     $line = &'jis_jis($line);
  236.   } elsif ($code eq 'sjis') {
  237.     $line = &'jis_sjis($line);
  238.   }
  239.   return $line;
  240. }
  241.  
  242. __END__
  243. --><HTML><HEAD>
  244. <META HTTP-EQUIV="Content-Type" CONTENT="text/html; charset=ISO-2022-JP">
  245. <LINK REV="made" HREF="mailto:hasegawa@madoka.org">
  246. <TITLE>auto/response.plm</TITLE></HEAD><BODY>
  247.  
  248. $B%*%s%i%$%s%I%-%e%a%s%H(B
  249.  
  250.  
  251. <HR><H3>$BL>A0(B</H3>
  252.  
  253. auto/response.plm - $B%a%C%;!<%8$KH?1~$7$FH/8@$r9T$&(B
  254.  
  255.  
  256. <HR><H3>$B@bL@(B</H3>
  257.  
  258.  
  259. $B%f!<%6$NH/8@$KH?1~$7$F!"$=$l$KBP$9$kH/8@$r9T$$$^$9!#(B
  260. $BH?1~$H$=$NH/8@$O%U%!%$%k$K0J2<$N$h$&$J%U%)!<%^%C%H$G5-=R$7$^$9!#(B
  261.  
  262. <PRE>
  263. pattern: ^$B$3$s$K$A(B($B$O(B|$B$o(B)$B!A(B?$
  264. rate: 100
  265. response: $B$3$s$K$A$O!A(B
  266. response: #(name|nick|nick.now)$B$5$s!"$$$i$C$7$c!A$$(B
  267.  
  268. pattern: ($B$M$k(B|$B$*$d$9$_(B)
  269. rate: 50
  270. response: #(name|nick|nick.now)$B$5$s!"$*$d$9$_$J$5$$(B
  271. response: #(nick.now): $B$@$a!y(B
  272. response: $B$($C!"$b$&?2$A$c$&$s$G$9$+!A(B?(;-;)
  273. </PRE>
  274.  
  275. $B$=$l$>$l$N%Q%?!<%s$O@55,I=8=$G!"BgJ8;z>.J8;z$O6hJL$7$^$9!#(B
  276. $B$^$?!"(Brate$B$KB3$/(Bresponse$B$NO"B3$7$?9T$N$&$A$+$i0l9T$rA*Br$7$F!"(B
  277. rate$B%Q!<%;%s%H$N3NN($GH/8@$r9T$$$^$9!#(B
  278.  
  279.  
  280. <HR><H3>$B%W%m%Q%F%#(B</H3>
  281.  
  282. <DL>
  283. <DT>  auto.response.file $B%U%!%$%kL>(B[;({euc|jis|sjis})]
  284. </DT>
  285. <DD>    $BH?1~$9$kH/8@$H!"$=$l$KBP$9$kH/8@$r5-=R$9$k%U%!%$%k$G$9!#(B
  286.         $B%U%!%$%k$N4A;z%3!<%I$,(Bjis$B0J30$N>l9g$O4A;z%3!<%I$r(B
  287.        $B;XDj$9$kI,MW$,$"$j$^$9!#(B
  288. </DD>
  289. <DT>  auto.response.alias $B%U%!%$%kL>(B[;({euc|jis|sjis})]
  290. </DT>
  291. <DD>    $B%(%$%j%"%9$r;2>H$9$k%U%!%$%k$r;XDj$7$^$9!#(B
  292.         $B$3$N%U%!%$%k$NFbMF$K=>$C$F!"%a%C%;!<%8Cf$N%U%)!<%^%C%H$H!"(B
  293.         auto.response.format$B$rE83+$7$^$9!#(B
  294. </DD>
  295. <DT>  auto.response.format* $B%U%)!<%^%C%H(B
  296. </DT>
  297. <DD>    $BH/8@;~$N%U%)!<%^%C%H$r;XDj$7$^$9!#$9$Y$F$NH/8@$KBP$7$F!"(B
  298.         $B$3$N%U%)!<%^%C%H$GH/8@$r9T$$$^$9!#(B#(nick)$B$N$h$&$K=q$/$3$H$G!"(B
  299.         $B%(%$%j%"%9$NBP1~$9$kCM$GCV$-49$($^$9!#%(%$%j%"%90J30$NCM$G$O!"(B
  300.         #(nick.now)$B$G%K%C%/%M!<%`!"(B#(channel)$B$G%A%c%s%M%k!"(B#(message)$B$G(B
  301.         $BH/8@$7$h$&$H$7$F$$$k%a%C%;!<%8$KCV$-49$($^$9!#(B
  302.         $B%G%U%)%k%H$G$O!V(B#(message)$B!W$G$9!#(B
  303. </DD>
  304. </DL>
  305.  
  306.  
  307. <HR><H3>$B@_DjNc(B</H3>
  308.  
  309. <PRE>
  310. + auto/response.plm
  311. auto.response.file: response.txt;euc
  312. auto.response.alias: alias.txt
  313. </PRE>
  314.  
  315. $BH?1~$r5-=R$9$k%U%!%$%k$H$7$F!V(Bresponse.txt$B!W$r!"(B
  316. $B%(%$%j%"%9$r;2>H$9$k%U%!%$%k$H$7$F!V(Balias.txt$B!W$r;HMQ$7$^$9!#(B
  317. $B!V(Bresponse.txt$B!W$O4A;z%3!<%I$r!V(Beuc$B!W$G5-=R$7$^$9!#(B
  318. $B$^$?!V(Balias.txt$B!W$O4A;z%3!<%I$r!V(Bjis$B!W$G5-=R$7$^$9!#(B
  319.  
  320. </BODY></HTML>
  321.