home
***
CD-ROM
|
disk
|
FTP
|
other
***
search
/
ftp.madoka.org
/
2014.12.ftp.madoka.org.tar
/
ftp.madoka.org
/
pub
/
plum
/
2.x
/
plum2_28_2.lzh
/
module
/
auto
/
message.plm
< prev
next >
Wrap
Text File
|
1998-10-15
|
13KB
|
461 lines
<!DOCTYPE HTML PUBLIC "-//IETF//DTD HTML//EN"><!-- $_ if 0; # -*- perl -*-
# $Id: message.plm,v 2.31 1998/10/13 14:05:34 hasegawa Exp $
# copyright (c)1998 pupu_j <hasegawa@agusa.nuie.nagoya-u.ac.jp>
package auto_message;
$FREQUENCY = 3600;
$_ = 'auto_message';
sub ss_join {
local($serverno, $prefix, $cmd, @params) = @_;
&receive($serverno, $prefix);
return ($prefix, $cmd, @params);
}
sub ss_nick {
local($serverno, $prefix, $cmd, @params) = @_;
local($nick);
$nick = &'prefix($prefix);
$last{$serverno, $params[0]} = $last{$serverno, $nick};
delete($last{$serverno, $nick});
$user = $params[0] . substr($prefix, index($prefix, '!'));
&receive($serverno, $user);
return ($prefix, $cmd, @params);
}
sub ss_part {
local($serverno, $prefix, $cmd, @params) = @_;
&receive($serverno, $prefix);
return ($prefix, $cmd, @params);
}
sub ss_topic {
local($serverno, $prefix, $cmd, @params) = @_;
&receive($serverno, $prefix);
return ($prefix, $cmd, @params);
}
sub ss_kick {
local($serverno, $prefix, $cmd, @params) = @_;
&receive($serverno, $prefix);
return ($prefix, $cmd, @params);
}
sub ss_mode {
local($serverno, $prefix, $cmd, @params) = @_;
&receive($serverno, $prefix);
return ($prefix, $cmd, @params);
}
sub ss_privmsg {
local($serverno, $prefix, $cmd, @params) = @_;
local($userno, $str, $to, $text, $reply, $who);
$userno = $'userno[$serverno];
&receive($serverno, $prefix);
if ($params[1]) {
foreach $get (&'property($userno, 'get')) {
next unless $params[1] eq $get;
&get($serverno, $prefix, $params[0]);
return ($prefix, $cmd, @params);
}
($str, $to, $text) = split(/\s+/, $params[1], 3);
if ($text) {
foreach $send (&'property($userno, 'send')) {
next unless $str eq $send;
&send($serverno, $prefix, $params[0], $to, $text);
return ($prefix, $cmd, @params);
}
}
}
return ($prefix, $cmd, @params);
}
sub get {
local($serverno, $prefix, $chan) = @_;
local($userno, $nick, @alias, @msg, @data, $name, $reply);
$userno = $'userno[$serverno];
$nick = &'prefix($prefix);
@alias = &read_alias($userno);
@msg = &get_msg($userno, $prefix, @alias);
if (scalar(@msg)) {
foreach $line (@msg) {
@data = split(/\s+/, $line, 6);
$name = &user_name($data[3], @alias);
$reply = substr($data[0], index($data[0], '/') + 1) . ' ' . substr($data[1], 0, rindex($data[1], ':')) . ' ' . $name . ' >> ' . $data[5];
&privmsg($serverno, $nick, $reply);
}
&delete_msg($userno, @msg);
} else {
$reply = &'property($userno, 'nothing');
&privmsg($serverno, $nick, $reply) if $reply;
}
}
sub receive {
local($serverno, $prefix) = @_;
local($userno, $nick, $time, $recv, @alias, @msg);
$userno = $'userno[$serverno];
$nick = &'prefix($prefix);
@alias = &read_alias($userno);
@msg = &get_msg($userno, $prefix, @alias);
if (scalar(@msg)) {
$time = time();
$last{$serverno, $nick} = 0 unless $last{$serverno, $nick};
if ($time - $last{$serverno, $nick} > $FREQUENCY) {
$recv = &'property($userno, 'receive');
&privmsg($serverno, $nick, $recv) if $recv;
}
$last{$serverno, $nick} = $time;
} else {
$last{$serverno, $nick} = 0;
}
}
sub send {
local($serverno, $prefix, $chan, $to, $text) = @_;
local($userno, @alias, $file, $idx, $name, $code, $reply, $who, $line);
$userno = $'userno[$serverno];
@alias = &read_alias($userno);
if (&check($to, @alias)) {
$file = &'property($userno, 'file') || '';
if (($idx = rindex($file, ';')) != -1) {
$name = substr($file, 0, $idx);
$code = substr($file, $idx + 1);
} else {
$name = $file;
$code = '';
}
$name = &'expand($name);
if ($name && open(FILE, ">>$name")) {
$line = join(' ', &'date('%Y/%m/%d %H:%M:%S'), $to, $prefix, $chan, $text);
$line = &jis_code($line, $code) if $code;
print FILE $line, "\n";
close(FILE);
}
$reply = &'property($userno, 'accept');
} else {
$reply = &'property($userno, 'unknown');
}
if ($reply) {
if ($chan =~ /^[\#\&\+]/) {
$who = $chan;
} else {
$who = &'prefix($prefix);
}
&privmsg($serverno, $who, $reply) if $reply;
}
}
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_msg {
local($userno, $prefix, @alias) = @_;
local(@list, $file, $idx, $name, $code, $line, @data);
$file = &'property($userno, 'file') || '';
if (($idx = rindex($file, ';')) != -1) {
$name = substr($file, 0, $idx);
$code = substr($file, $idx + 1);
} else {
$name = $file;
$code = '';
}
$name = &'expand($name);
if ($name && open(FILE, $name)) {
while (defined($line = <FILE>)) {
$line =~ tr/\r\n//d;
next unless $line;
$line = &code_jis($line, $code) if $code;
@data = split(/\s+/, $line, 6);
next unless &match($prefix, $data[2], @alias);
push(@list, $line);
}
close(FILE);
}
return @list;
}
sub delete_msg {
local($userno, @list) = @_;
local($file, $idx, $name, $code, $list, @msg);
$file = &'property($userno, 'file') || '';
if (($idx = rindex($file, ';')) != -1) {
$name = substr($file, 0, $idx);
$code = substr($file, $idx + 1);
} else {
$name = $file;
$code = '';
}
$name = &'expand($name);
if ($name && open(FILE, $name)) {
$list = &'list(@list);
while (defined($line = <FILE>)) {
$line =~ tr/\r\n//d;
next unless $line;
next if &'exist($list, $line);
push(@msg, $line);
}
close(FILE);
if ($name && open(FILE, ">$name")) {
foreach $line (@msg) {
$line = &code_jis($line, $code) if $code;
print FILE $line, "\n";
}
close(FILE);
}
}
}
sub check {
local($to, @alias) = @_;
local($i);
if ($to =~ /^[A-\}][\-\dA-\}]*$/ && length($to) <= 9) {
return 1;
} else {
for ($i = 0; $i < scalar(@alias); $i += 3) {
foreach $str (&'array($alias[$i + 1] || '')) {
return 1 if $str eq $to;
}
}
return 0;
}
}
sub user_name {
local($prefix, @alias) = @_;
local($regex, $i);
for ($i = 0; $i < scalar(@alias); $i += 3) {
foreach $mask (&'array($alias[$i + 2] || '')) {
$regex = &'regex($mask);
next unless $prefix =~ /$regex/i;
return ((&'array($alias[$i + 1] || $alias[$i]))[0]);
}
}
return (&'prefix($prefix))[0];
}
sub match {
local($prefix, $to, @alias) = @_;
local($i, $regex, $no, $nick);
for ($i = 0; $i < scalar(@alias); $i += 3) {
foreach $str (&'array($alias[$i])) {
next unless "\L$str\E" eq "\L$to\E";
$no = $i + 2;
last;
}
foreach $str (&'array($alias[$i + 1] || '')) {
next unless $str eq $to;
$no = $i + 2;
last;
}
}
if ($no) {
foreach $mask (&'array($alias[$no] || '')) {
$regex = &'regex($mask);
return 1 if $prefix =~ /$regex/i;
}
} else {
$nick = &'prefix($prefix);
return 1 if "\L$nick\E" eq "\L$to\E";
}
return 0;
}
sub read_alias {
local($userno) = @_;
local(@alias, $file, $idx, $name, $code, $line, $var, $arg, $no);
$file = &'property($userno, 'alias') || '';
if (($idx = rindex($file, ';')) != -1) {
$name = substr($file, 0, $idx);
$code = substr($file, $idx + 1);
} else {
$name = $file;
$code = '';
}
$name = &'expand($name);
if ($name && open(FILE, $name)) {
@alias = ();
$no = -3;
while (defined($line = <FILE>)) {
$line =~ s/^\s+//;
next if $line =~ /^[\#\;]/;
$line =~ tr/\r\n//d;
next unless $line;
$line =~ s/\s+$//;
$line = &code_jis($line, $code) if $code;
$line = &read_line($userno, $line);
next unless (($var, $arg) = split(/\s*\:\s*/, $line, 2)) == 2;
if ("\L$var\E" eq 'nick') {
$no += 3;
$alias[$no] = &'list(split(/\,/, $arg));
} elsif ("\L$var\E" eq 'name') {
$alias[$no + 1] = &'add($alias[$no + 1], split(/\s+/, $arg));
} elsif ("\L$var\E" eq 'user') {
$alias[$no + 2] = &'add($alias[$no + 2], $arg);
}
}
close(FILE);
}
return @alias;
}
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;
}
sub read_line {
local($userno, $line) = @_;
foreach $kanji (&'property($userno, 'kanji')) {
foreach $code (split(/\,/, "\L$kanji\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;
}
__END__
--><HTML><HEAD>
<META HTTP-EQUIV="Content-Type" CONTENT="text/html; charset=ISO-2022-JP">
<LINK REV="made" HREF="mailto:hasegawa@agusa.nuie.nagoya-u.ac.jp">
<TITLE>auto/message.plm</TITLE></HEAD><BODY>
$B%*%s%i%$%s%I%-%e%a%s%H(B
<HR><H3>$BL>A0(B</H3>
auto/message.plm - $B;XDj$7$??M$K%a%C%;!<%8$rFO$1$k(B
<HR><H3>$B@bL@(B</H3>
$B;XDj$7$??M$KBP$7$F%a%C%;!<%8$rFO$1$^$9!#$$$o$f$kEA8@$G$9!#(B
$B%f!<%6$,%A%c%s%M%k$KF~$C$F$-$?$H$-!"%K%C%/%M!<%`$rJQ$($?$H$-$K(B
$B%a%C%;!<%8$,FO$$$F$$$k$3$H$rCN$i$;$^$9!#(B
$B$=$N$?$a!"F1$8%A%c%s%M%k$KF~$i$J$$%f!<%6$KBP$7$F$O(B
$B%a%C%;!<%8$rFO$1$k$3$H$,$G$-$^$;$s!#(B
<HR><H3>$B%W%m%Q%F%#(B</H3>
<DL>
<DT> auto.message.file $B%U%!%$%kL>(B[;({jis|euc|sjis})]
</DT>
<DD> $B%a%C%;!<%8$r3JG<$9$k%U%!%$%kL>$G$9!#(B
$B%U%!%$%k$O;XDj$7$?4A;z%3!<%I$GJ]B8$5$l$^$9!#(B
$B4A;z%3!<%I$rJ#?t;XDj$7$?>l9g$O!":G=i$K;XDj$7$?4A;z%3!<%I$G(B
$BJ]B8$5$l!">JN,$7$?>l9g$O!V(Bjis$B!W$r;XDj$7$?$3$H$HF1$8$G$9!#(B
$B$^$?!"!V(Beuc$B!W$H!V(Bsjis$B!W$rF1;~$K;XDj$9$k$3$H$O$G$-$^$;$s!#(B
</DD>
<DT> auto.message.alias $B%U%!%$%kL>(B[;({jis|euc|sjis})]
</DT>
<DD> $B%(%$%j%"%9$r;2>H$9$k%U%!%$%kL>$G$9!#(B
$B$3$N%U%!%$%k$O(Bauto/alias.plm$B$G;H$&$b$N$HF1$8$b$N$G$9!#(B
$B%U%!%$%k$O;XDj$7$?4A;z%3!<%I$GJ]B8$5$l$F$$$kI,MW$,$"$j$^$9!#(B
</DD>
<DT> auto.message.get* $BJ8;zNs(B
</DT>
<DD> $BFO$$$F$$$k%a%C%;!<%8$rJ9$/$?$a$NJ8;zNs$G$9!#(B
$B$3$3$G;XDj$7$?J8;zNs$HF1$8H/8@$,$"$k$H!"(B
$BH/8@$7$??M$KBP$7$FFO$$$F$$$k%a%C%;!<%8$rEA$($^$9!#(B
</DD>
<DT> auto.message.send* $BJ8;zNs(B
</DT>
<DD> $B%a%C%;!<%8$rFO$1$k$?$a$NJ8;zNs$G$9!#(B
$B$3$N%a%C%;!<%8$N0z?t$H$7$F%f!<%6L>$HJ8;zNs$r;XDj$9$k$3$H$G!"(B
$B$=$N?M$KBP$7$F%a%C%;!<%8$rFO$1$^$9!#(B
</DD>
<DT> auto.message.accept $BJ8;zNs(B
</DT>
<DD> $B%a%C%;!<%8$r>5$C$?$H$-$KH/8@$9$kJ8;zNs$G$9!#(B
$B%a%C%;!<%8$r@5$7$/<u$1<h$C$?$H$-$K$H$-$K!"(B
$B$3$3$G;XDj$7$?J8;zNs$rH/8@$7$^$9!#(B
</DD>
<DT> auto.message.unknown $B%a%C%;!<%8(B
</DT>
<DD> $B%a%C%;!<%8$rAw$kAj<j$,$o$+$i$J$$$H$-$KH/8@$9$kJ8;zNs$G$9!#(B
$BC/$KEA$($F$$$$$+$o$+$i$J$$>l9g$O$3$3$G;XDj$7$?J8;zNs$rH/8@$7!"(B
$B%a%C%;!<%8$rFO$1$k$3$H$,$G$-$J$$$3$H$rEA$($^$9!#(B
</DD>
<DT> auto.message.receive $BJ8;zNs(B
</DT>
<DD> $B%a%C%;!<%8$,FO$$$F$$$k$3$H$rEA$($kJ8;zNs$G$9!#(B
$B%A%c%s%M%k$KF~$C$F$-$?;~$d!"%K%C%/%M!<%`$rJQ99$7$?;~$K!"(B
$B$=$N?M$KBP$9$k%a%C%;!<%8$,FO$$$F$$$l$P!"(B
$B$3$3$G;XDj$7$?J8;zNs$rH/8@$7$^$9!#(B
</DD>
<DT> auto.message.nothing $BJ8;zNs(B
</DT>
<DD> $B%a%C%;!<%8$rJ9$$$F$-$?$H$-$K!"$=$N?M$KBP$9$k%a%C%;!<%8$,(B
$BFO$$$F$$$J$+$C$?$H$-$O!"$3$3$G;XDj$7$?J8;zNs$rH/8@$7$^$9!#(B
</DD>
</DL>
<HR><H3>$B@_DjNc(B</H3>
<PRE>
+ auto/message.plm
auto.message.file: message.txt;jis
auto.message.alias: alias.txt;jis,euc
auto.message.get: $BEA8@65$($F(B
auto.message.send: $BEA8@(B
auto.message.accept: $BEA8@$r3P$($^$7$?(B
auto.message.unknown: $B08@h$,$o$+$j$^$;$s(B
auto.message.receive: $BEA8@$,FO$$$F$$$^$9!#!VEA8@65$($F!W$G$*EA$($7$^$9(B
auto.message.nothing: $BEA8@$O$"$j$^$;$s(B
</PRE>
$B!VEA8@(B pupu_j $B$[$($[$(!W$N$h$&$KH/8@$9$k$H!"(B
$B!V(Bpupu_j$B!W$H$$$&%K%C%/%M!<%`$N?M$K!V$[$($[$(!W$H$$$&%a%C%;!<%8$rEA$($^$9!#(B
$B$^$?!V(Balias.txt$B!W$K;XDj$5$l$F$$$kL>A0$r;H$C$F!"(B
$B!VEA8@(B $B$W$W(B $B$[$($[$(!W$N$h$&$K$7$F%a%C%;!<%8$rEA$($k$3$H$b$G$-$^$9!#(B
<BR><BR>
$B%a%C%;!<%8$,FO$$$F$$$k$H$-$K!"%A%c%s%M%k$KF~$C$?$j!"(B
$B%K%C%/%M!<%`$rJQ99$9$k$H!"!VEA8@$,FO$$$F$$$^$9!#!VEA8@65$($F!W$G8+$i$l$^$9!W(B
$B$H8@$C$FCN$i$;$^$9!#%a%C%;!<%8$,FO$$$F$$$k$H$-$K!"(B
$B!VEA8@65$($F!W$HH/8@$9$k$H!"FO$$$F$$$k%a%C%;!<%8$rJ9$/$3$H$,$G$-$^$9!#(B
</BODY></HTML>