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