home
***
CD-ROM
|
disk
|
FTP
|
other
***
search
/
ftp.madoka.org
/
2014.12.ftp.madoka.org.tar
/
ftp.madoka.org
/
pub
/
plum
/
2.x
/
plum2_32_1.lzh
/
module
/
auto
/
response.plm
< prev
next >
Wrap
Text File
|
1999-02-20
|
8KB
|
321 lines
<!DOCTYPE HTML PUBLIC "-//IETF//DTD HTML//EN"><!-- $_ if 0; # -*- perl -*-
# $Id: response.plm,v 2.13 1999/01/21 16:19:43 hasegawa Exp $
# copyright (c)1998-1999 Yoshinori Hasegawa <hasegawa@madoka.org>
package auto_response;
$FORMAT = '#(message)';
$_ = 'auto_response';
sub ss_privmsg {
local($serverno, $prefix, $cmd, @params) = @_;
local($userno, @data, %alias, $to, @format, $list, $rate, @rand);
$userno = $'userno[$serverno];
@data = &get_response($userno, $params[1]);
%alias = &get_alias_user($userno, $prefix);
$alias{'nick.now'} = (&'prefix($prefix))[0];
if (&'channel($params[0])) {
$alias{'channel'} = &'list($params[0]);
$to = $params[0];
} else {
$to = &'prefix($prefix);
}
foreach $list (@data) {
($rate, @rand) = &'array($list);
next unless rand(100) < $rate;
$alias{'message'} = &'format($rand[rand(@rand)], %alias);
@format = &'property($userno, 'format');
if (@format) {
foreach $reply (@format) {
&privmsg($serverno, $to, &'format($reply, %alias));
}
} else {
&privmsg($serverno, $to, &'format($FORMAT, %alias));
}
}
return ($prefix, $cmd, @params);
}
sub privmsg {
local($serverno, $to, $msg) = @_;
&'s_print($serverno, '', 'PRIVMSG', $to, $msg);
foreach $cno (&'array($'clientlist)) {
next unless $'avail[$cno];
next unless $'server[$cno] == $serverno;
&'c_print($cno, &'user($cno), 'PRIVMSG', $to, $msg);
}
}
sub get_response {
local($userno, $text) = @_;
local($file, @list);
$file = &'property($userno, 'file');
foreach $list (&split_list('pattern', &read_file($file))) {
@list = &'array($list);
if (&match_response($text, @list)) {
return &parse_response(@list);
}
}
return ();
}
sub match_response {
local($value, @list) = @_;
local($regex, $var, $arg, $pat);
foreach $line (@list) {
($var, $arg) = split(/\s+/, $line, 2);
next unless "\L$var\E" eq 'pattern';
if (&'exist($'kanjilist, 'euc') || !&'exist($'kanjilist, 'sjis')) {
$pat = &'jis_euc($arg);
return 1 if &'jis_euc($value) =~ /$pat/;
} else {
$pat = &'jis_sjis($arg);
return 1 if &'jis_sjis($value) =~ /$pat/;
}
}
return 0;
}
sub parse_response {
local(@list) = @_;
local(@data, $var, $arg, $rate, @tmp);
$rate = 0;
@tmp = ();
@data = ();
foreach $line (@list) {
($var, $arg) = split(/\s+/, $line, 2);
$var = "\L$var\E";
if ($var eq 'rate') {
push(@data, &'list($rate, @tmp)) if ($rate && @tmp);
$rate = $arg;
@tmp = ();
} elsif ($var eq 'response') {
push(@tmp, $arg);
}
}
push(@data, &'list($rate, @tmp)) if ($rate && @tmp);
return @data;
}
sub get_alias_user {
local($userno, $from, $prefix) = @_;
local($file, @list);
$file = &'property($userno, 'alias');
foreach $list (&split_list('nick', &read_file($file))) {
@list = &'array($list);
if (&match_alias_user($from, @list)) {
return &parse_alias($prefix, @list);
}
}
return ();
}
sub match_alias_user {
local($from, @list) = @_;
local($var, $arg, $regex);
foreach $line (@list) {
($var, $arg) = split(/\s+/, $line, 2);
next unless "\L$var\E" eq 'user';
$regex = &'regex($arg);
next unless $from =~ /$regex/i;
return 1;
}
return 0;
}
sub parse_alias {
local($prefix, @list) = @_;
local(%alias, $var, $arg, $key);
%alias = ();
foreach $line (@list) {
($var, $arg) = split(/\s+/, $line, 2);
$var = "\L$var\E";
if ($prefix) {
$key = $prefix . '.' . $var;
} else {
$key = $var;
}
next if defined($alias{$key});
if ($var eq 'nick') {
$alias{$key} = (split(/\,/, $arg))[0];
} elsif ($var eq 'name') {
$alias{$key} = (split(/\s+/, $arg))[0];
} else {
$alias{$key} = $arg;
}
}
return %alias;
}
sub split_list {
local($field, @list) = @_;
local($var, $arg, @array, @entry);
$field = "\L$field\E";
@array = ();
@entry = ();
foreach $line (@list) {
($var, $arg) = split(/\s*\:\s*/, $line, 2);
if ($field eq "\L$var\E") {
push(@array, &'list(@entry)) if @entry;
@entry = ();
}
push(@entry, $var . ' ' . $arg);
}
push(@array, &'list(@entry)) if @entry;
return @array;
}
sub read_file {
local($file) = @_;
local($name, $code, $mtime, @data, $line);
($name, $code) = &filename($file);
$mtime = (stat($name))[9];
if (defined($mtime)) {
$modify{$name} = -1 unless defined($modify{$name});
if ($modify{$name} != $mtime) {
if (open(TMP, $name)) {
@data = ();
while (defined($line = <TMP>)) {
$line =~ s/^\s+//;
next if $line =~ /^[\#\;]/;
$line =~ tr/\r\n//d;
next unless $line;
$line =~ s/\s+$//;
$line = &code_jis($line, $code) if $code;
push(@data, $line);
}
close(TMP);
$modify{$name} = $mtime;
$cache{$name} = &'list(@data);
return @data;
}
} else {
return &'array($cache{$name});
}
}
return ();
}
sub filename {
local($file) = @_;
local($idx, $name, $code);
return ('', '') unless $file;
if (($idx = rindex($file, ';')) != -1) {
$name = substr($file, 0, $idx);
$code = substr($file, $idx + 1);
} else {
$name = $file;
$code = '';
}
return (&'expand($name), $code);
}
sub code_jis {
local($line, $list) = @_;
foreach $code (split(/\,/, "\L$list\E")) {
if ($code eq 'euc') {
$line = &'euc_jis($line);
} elsif ($code eq 'jis') {
$line = &'jis_jis($line);
} elsif ($code eq 'sjis') {
$line = &'sjis_jis($line);
}
}
return $line;
}
sub jis_code {
local($line, $list) = @_;
local($code);
$code = (split(/\,/, "\L$list\E"))[0];
if ($code eq 'euc') {
$line = &'jis_euc($line);
} elsif ($code eq 'jis') {
$line = &'jis_jis($line);
} elsif ($code eq 'sjis') {
$line = &'jis_sjis($line);
}
return $line;
}
__END__
--><HTML><HEAD>
<META HTTP-EQUIV="Content-Type" CONTENT="text/html; charset=ISO-2022-JP">
<LINK REV="made" HREF="mailto:hasegawa@madoka.org">
<TITLE>auto/response.plm</TITLE></HEAD><BODY>
$B%*%s%i%$%s%I%-%e%a%s%H(B
<HR><H3>$BL>A0(B</H3>
auto/response.plm - $B%a%C%;!<%8$KH?1~$7$FH/8@$r9T$&(B
<HR><H3>$B@bL@(B</H3>
$B%f!<%6$NH/8@$KH?1~$7$F!"$=$l$KBP$9$kH/8@$r9T$$$^$9!#(B
$BH?1~$H$=$NH/8@$O%U%!%$%k$K0J2<$N$h$&$J%U%)!<%^%C%H$G5-=R$7$^$9!#(B
<PRE>
pattern: ^$B$3$s$K$A(B($B$O(B|$B$o(B)$B!A(B?$
rate: 100
response: $B$3$s$K$A$O!A(B
response: #(name|nick|nick.now)$B$5$s!"$$$i$C$7$c!A$$(B
pattern: ($B$M$k(B|$B$*$d$9$_(B)
rate: 50
response: #(name|nick|nick.now)$B$5$s!"$*$d$9$_$J$5$$(B
response: #(nick.now): $B$@$a!y(B
response: $B$($C!"$b$&?2$A$c$&$s$G$9$+!A(B?(;-;)
</PRE>
$B$=$l$>$l$N%Q%?!<%s$O@55,I=8=$G!"BgJ8;z>.J8;z$O6hJL$7$^$9!#(B
$B$^$?!"(Brate$B$KB3$/(Bresponse$B$NO"B3$7$?9T$N$&$A$+$i0l9T$rA*Br$7$F!"(B
rate$B%Q!<%;%s%H$N3NN($GH/8@$r9T$$$^$9!#(B
<HR><H3>$B%W%m%Q%F%#(B</H3>
<DL>
<DT> auto.response.file $B%U%!%$%kL>(B[;({euc|jis|sjis})]
</DT>
<DD> $BH?1~$9$kH/8@$H!"$=$l$KBP$9$kH/8@$r5-=R$9$k%U%!%$%k$G$9!#(B
$B%U%!%$%k$N4A;z%3!<%I$,(Bjis$B0J30$N>l9g$O4A;z%3!<%I$r(B
$B;XDj$9$kI,MW$,$"$j$^$9!#(B
</DD>
<DT> auto.response.alias $B%U%!%$%kL>(B[;({euc|jis|sjis})]
</DT>
<DD> $B%(%$%j%"%9$r;2>H$9$k%U%!%$%k$r;XDj$7$^$9!#(B
$B$3$N%U%!%$%k$NFbMF$K=>$C$F!"%a%C%;!<%8Cf$N%U%)!<%^%C%H$H!"(B
auto.response.format$B$rE83+$7$^$9!#(B
</DD>
<DT> auto.response.format* $B%U%)!<%^%C%H(B
</DT>
<DD> $BH/8@;~$N%U%)!<%^%C%H$r;XDj$7$^$9!#$9$Y$F$NH/8@$KBP$7$F!"(B
$B$3$N%U%)!<%^%C%H$GH/8@$r9T$$$^$9!#(B#(nick)$B$N$h$&$K=q$/$3$H$G!"(B
$B%(%$%j%"%9$NBP1~$9$kCM$GCV$-49$($^$9!#%(%$%j%"%90J30$NCM$G$O!"(B
#(nick.now)$B$G%K%C%/%M!<%`!"(B#(channel)$B$G%A%c%s%M%k!"(B#(message)$B$G(B
$BH/8@$7$h$&$H$7$F$$$k%a%C%;!<%8$KCV$-49$($^$9!#(B
$B%G%U%)%k%H$G$O!V(B#(message)$B!W$G$9!#(B
</DD>
</DL>
<HR><H3>$B@_DjNc(B</H3>
<PRE>
+ auto/response.plm
auto.response.file: response.txt;euc
auto.response.alias: alias.txt
</PRE>
$BH?1~$r5-=R$9$k%U%!%$%k$H$7$F!V(Bresponse.txt$B!W$r!"(B
$B%(%$%j%"%9$r;2>H$9$k%U%!%$%k$H$7$F!V(Balias.txt$B!W$r;HMQ$7$^$9!#(B
$B!V(Bresponse.txt$B!W$O4A;z%3!<%I$r!V(Beuc$B!W$G5-=R$7$^$9!#(B
$B$^$?!V(Balias.txt$B!W$O4A;z%3!<%I$r!V(Bjis$B!W$G5-=R$7$^$9!#(B
</BODY></HTML>