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
/
alias.plm
next >
Wrap
Text File
|
1999-02-20
|
17KB
|
593 lines
<!DOCTYPE HTML PUBLIC "-//IETF//DTD HTML//EN"><!-- $_ if 0; # -*- perl -*-
# $Id: alias.plm,v 2.32 1999/01/29 08:31:45 hasegawa Exp $
# copyright (c)1998-1999 Yoshinori Hasegawa <hasegawa@madoka.org>
package auto_alias;
$_ = 'auto_alias';
sub ss_privmsg {
local($serverno, $prefix, $cmd, @params) = @_;
local($userno, $str, $action, $type, @arg);
$userno = $'userno[$serverno];
($action, $type, @arg) = split(/\s+/, $params[1]);
if ($action) {
$type = '' unless $type;
foreach $str (&'property($userno, 'get')) {
next unless $str eq $action;
&get_alias($serverno, $prefix, $params[0], "\L$type\E", @arg);
return ($prefix, $cmd, @params);
}
foreach $str (&'property($userno, 'add')) {
next unless $str eq $action;
&add_alias($serverno, $prefix, $params[0], "\L$type\E", @arg);
return ($prefix, $cmd, @params);
}
foreach $str (&'property($userno, 'remove')) {
next unless $str eq $action;
&remove_alias($serverno, $prefix, $params[0], "\L$type\E", @arg);
return ($prefix, $cmd, @params);
}
foreach $str (&'property($userno, 'change')) {
next unless $str eq $action;
&change_alias($serverno, $prefix, $params[0], "\L$type\E", @arg);
return ($prefix, $cmd, @params);
}
}
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_alias {
local($serverno, $prefix, $chan, $type, $text) = @_;
local($userno, @data, $no, $to, $hidden, %alias);
$userno = $'userno[$serverno];
@data = &read_alias($userno);
$hidden = &property($userno, 'invisible');
if ($text) {
$no = &get_alias_index($type, $text, @data);
$hidden .= &property($userno, 'private');
} else {
$no = &get_alias_user_index($prefix, @data);
}
return if $no == -1;
$to = &'prefix($prefix);
%alias = &parse_list(&'array($data[$no]));
foreach $key (keys(%alias)) {
next if &'exist($hidden, $key);
foreach $line (&format_list($key, $alias{$key})) {
&privmsg($serverno, $to, $line);
}
}
}
sub add_alias {
local($serverno, $prefix, $chan, $type, @arg) = @_;
local($userno, $readonly, @data, $no, %alias, $scalar);
$userno = $'userno[$serverno];
$readonly = &property($userno, 'readonly');
return if &'exist($readonly, $type);
@data = &read_alias($userno);
$no = &get_alias_user_index($prefix, @data);
if ($no == -1) {
%alias = ('nick', &'list((&'prefix($prefix))[0]));
$no = @data;
} else {
%alias = &parse_list(&'array($data[$no]));
}
$scalar = &property($userno, 'scalar');
if (@arg) {
if (&'exist($scalar, $type)) {
$alias{$type} = &'list($arg[0]);
} else {
$alias{$type} = &'add($alias{$type}, @arg);
}
}
$data[$no] = &build_list(%alias);
&write_alias($userno, @data);
}
sub remove_alias {
local($serverno, $prefix, $chan, $type, @arg) = @_;
local($userno, $readonly, @data, $no, %alias, $scalar);
return unless $type;
$userno = $'userno[$serverno];
$readonly = &property($userno, 'readonly');
return if &'exist($readonly, $type);
@data = &read_alias($userno);
$no = &get_alias_user_index($prefix, @data);
if ($no == -1) {
%alias = ('nick', &'list((&'prefix($prefix))[0]));
$no = @data;
} else {
%alias = &parse_list(&'array($data[$no]));
}
$scalar = &property($userno, 'scalar');
if (&'exist($scalar, $type)) {
$alias{$type} = '';
} elsif (@arg) {
$alias{$type} = &'remove($alias{$type}, @arg);
}
$data[$no] = &build_list(%alias);
&write_alias($userno, @data);
}
sub change_alias {
local($serverno, $prefix, $chan, $type, @arg) = @_;
local($userno, $readonly, @data, $no, %alias, $scalar);
return unless @arg;
$userno = $'userno[$serverno];
$readonly = &property($userno, 'readonly');
return if &'exist($readonly, $type);
@data = &read_alias($userno);
$no = &get_alias_user_index($prefix, @data);
if ($no == -1) {
%alias = ('nick', &'list((&'prefix($prefix))[0]));
$no = @data;
} else {
%alias = &parse_list(&'array($data[$no]));
}
$scalar = &property($userno, 'scalar');
if (&'exist($scalar, $type)) {
$alias{$type} = &'list($arg[0]);
} else {
$alias{$type} = &'change($alias{$type}, @arg);
}
$data[$no] = &build_list(%alias);
&write_alias($userno, @data);
}
sub property {
local($userno, $name) = @_;
local($list);
$list = '';
foreach $line (&'property($userno, $name)) {
$list = &'add($list, split(/\,/, $line));
}
return $list;
}
sub format_list {
local($key, $value) = @_;
local(@list);
if ($key eq 'nick') {
return 'nick: ' . join(',', &'array($value));
} elsif ($key eq 'name') {
return 'name: ' . join(' ', &'array($value));
} else {
@list = ();
foreach $arg (&'array($value)) {
push(@list, $key . ': ' . $arg);
}
return @list;
}
}
sub get_alias_index {
local($type, $value, @data) = @_;
local($i, @list);
if ($type eq 'user') {
return &get_alias_user_index($value, @data);
} elsif ($type eq 'name') {
return &get_alias_name_index($value, @data);
} else {
for ($i = 0; $i < @data; $i++) {
@list = &'array($data[$i]);
if (&match_alias($type, $value, @list)) {
return $i;
}
}
return -1;
}
}
sub match_alias {
local($type, $value, @list) = @_;
local(%alias, $var, $arg);
%alias = &parse_list(@list);
foreach $key (keys(%alias)) {
next unless "\L$key\E" eq $type;
if (&'exist($alias{$key}, $value)) {
return 1;
}
}
return 0;
}
sub get_alias_user_index {
local($from, @data) = @_;
local($i, @list);
for ($i = 0; $i < @data; $i++) {
@list = &'array($data[$i]);
if (&match_alias_user($from, @list)) {
return $i;
}
}
return -1;
}
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 get_alias_name_index {
local($from, @data) = @_;
local($i, @list);
for ($i = 0; $i < @data; $i++) {
@list = &'array($data[$i]);
if (&match_alias_name($from, @list)) {
return $i;
}
}
return -1;
}
sub match_alias_name {
local($from, @list) = @_;
local($var, $arg);
foreach $line (@list) {
($var, $arg) = split(/\s+/, $line, 2);
if ("\L$var\E" eq 'name') {
foreach $name (split(/\s+/, $arg)) {
next unless $from eq $name;
return 1;
}
}
}
return 0;
}
sub build_list {
local(%alias) = @_;
local($nick, $name, @user, @other);
$nick = '';
$name = '';
@user = ();
@other = ();
foreach $key (sort(keys(%alias))) {
if ($key eq 'nick') {
$nick = 'nick ' . join(',', &'array($alias{$key}));
} elsif ($key eq 'name') {
$name = 'name ' . join(' ', &'array($alias{$key}));
} elsif ($key eq 'user') {
foreach $arg (&'array($alias{$key})) {
push(@user, $key . ' ' . $arg);
}
} else {
foreach $arg (&'array($alias{$key})) {
push(@other, $key . ' ' . $arg);
}
}
}
if ($nick && $name) {
return &'list($nick, $name, @user, @other);
} elsif ($nick) {
return &'list($nick, @user, @other);
} else {
return '';
}
}
sub parse_list {
local(@list) = @_;
local(%alias, $var, $arg, $key);
%alias = ();
foreach $line (@list) {
($var, $arg) = split(/\s+/, $line, 2);
$var = "\L$var\E";
if ($var eq 'nick') {
$alias{$var} = &'add($alias{$var}, split(/\,/, $arg));
} elsif ($var eq 'name') {
$alias{$var} = &'add($alias{$var}, split(/\s+/, $arg));
} else {
$alias{$var} = &'add($alias{$var}, $arg);
}
}
return %alias;
}
sub read_alias {
local($userno) = @_;
local($file);
$file = &'property($userno, 'file');
return &split_list('nick', &read_file($file));
}
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 write_alias {
local($userno, @data) = @_;
local($file);
$file = &'property($userno, 'file');
&write_file($file, &merge_list(@data));
}
sub merge_list {
local(@list) = @_;
local(@data, @entry, $var, $arg);
@data = ();
foreach $list (@list) {
next unless $list;
@entry = &'array($list);
foreach $line (@entry) {
next unless $line;
($var, $arg) = split(/\s+/, $line, 2);
next unless $arg;
push(@data, $var . ': ' . $arg);
}
push(@data, '');
}
return @data;
}
sub write_file {
local($file, @data) = @_;
local($name, $code, @list);
($name, $code) = &filename($file);
@list = ();
if (open(TMP, ">$name")) {
foreach $line (@data) {
push(@list, $line) if $line;
$line = &jis_code($line, $code) if $code;
print TMP $line, "\n";
}
close(TMP);
$modify{$name} = (stat($name))[9];
$cache{$name} = &'list(@list);
}
}
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/alias.plm</TITLE></HEAD><BODY>
$B%*%s%i%$%s%I%-%e%a%s%H(B
<HR><H3>$BL>A0(B</H3>
auto/alias.plm - $B%f!<%6%(%$%j%"%9>pJs$N4IM}(B
<HR><H3>$B@bL@(B</H3>
$B%f!<%6L>$N%(%$%j%"%9$NDI2C!":o=|!"3NG'$r9T$$$^$9!#(B
$B%(%$%j%"%9$NDI2C!":o=|$O<+J,$N>pJs$KBP$7$F$7$+9T$&$3$H$O$G$-$^$;$s!#(B
$B%(%$%j%"%9$O4pK\E*$K(Bnick$B!"(Bname$B!"(Buser$B$N(B3$B$D$N%U%#!<%k%I$+$i$J$C$F$*$j!"(B
$B$=$l$>$l%K%C%/%M!<%`!"L>A0!"%f!<%6%^%9%/$rI=$7$^$9!#(B
$B<B:]$K%f!<%6$r<1JL$9$k$?$a$K$O(Buser$B$,;HMQ$5$l$^$9!#(B
<BR><BR>
$B$^$?!"%(%$%j%"%9%U%!%$%k$NCf$G$O!"%G!<%?$O%f!<%6$4$H$K(B
nick$B!"(Bname$B!"(Buser$B$N=gHV$GJ]B8$5$l$F$$$^$9!#(B
$B$=$l$>$l$N%G!<%?$OJ#?t;XDj$9$k$3$H$,$G$-!"(Bnick$B$O!V(B,$B!W$G!"(B
name$B$O6uGr$G!"(Buser$B$O(B1$B9T$K(B1$B$D$:$D$=$l$>$l6h@Z$j$^$9!#(B
$B<B:]$N%U%!%$%kCf$N%G!<%?$O0J2<$N$h$&$K$J$C$F$$$^$9!#(B
<PRE>
nick: plum,plum_j,plum-j
name: $B$W$i$`(B $B$W$i$`$A$c$s(B
user: *!plum@*.plum.org
user: plum*!*plum@*.plum.com
nick: plum_
name: $B$W$i$`(B($B56(B)
user: *!*plum@*.plum.org
</PRE>
<HR><H3>$B%W%m%Q%F%#(B</H3>
<DL>
<DT> auto.alias.file $B%U%!%$%kL>(B[;({jis|euc|sjis})]
</DT>
<DD> $B%(%$%j%"%9$rJ]B8$9$k%U%!%$%kL>$r;XDj$7$^$9!#(B
$B%U%!%$%kL>$N8e$K4A;z%3!<%I$r;XDj$9$k$3$H$,$G$-$^$9!#(B
$B4A;z%3!<%I$rJ#?t;XDj$7$?>l9g$O:G=i$K;XDj$7$?4A;z%3!<%I$GJ]B8$5$l!"(B
$B>JN,$7$?>l9g$O!V(Bjis$B!W$r;XDj$7$?$3$H$HF1$8$K$J$j$^$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.alias.readonly* ($B%?%$%W(B)
</DT>
<DD> $BJQ99$9$k$3$H$N$G$-$J$$%?%$%W$r;XDj$7$^$9!#(B
</DD>
<DT> auto.alias.invisible* ($B%?%$%W(B)
</DT>
<DD> $B8+$k$3$H$N$G$-$J$$%?%$%W$r;XDj$7$^$9!#(B
</DD>
<DT> auto.alias.private* ($B%?%$%W(B)
</DT>
<DD> $BK\?M$K$7$+8+$k$3$H$N$G$-$J$$%?%$%W$r;XDj$7$^$9!#(B
</DD>
<DT> auto.alias.scalar* ($B%?%$%W(B)
</DT>
<DD> $BCM$r0l$D$7$+@_Dj$9$k$3$H$,$G$-$J$$%?%$%W$r;XDj$7$^$9!#(B
</DD>
<DT> auto.alias.get* $BJ8;zNs(B
</DT>
<DD> $B%(%$%j%"%9$r3NG'$9$k$?$a$N%a%C%;!<%8$G$9!#(B
$B$3$N%a%C%;!<%8$HF1$8J8;zNs$rH/8@$r$9$k$H!"(B
$B<+J,$K@_Dj$5$l$F$$$k%(%$%j%"%9$r3NG'$9$k$3$H$,$G$-$^$9!#(B
$B$^$?!"0z?t$H$7$F%(%$%j%"%9$N%?%$%W$H%G!<%?$r;XDj$9$k$H!"(B
$B$=$l$K%^%C%A$9$k?M$N%(%$%j%"%9$r3NG'$G$-$^$9!#(B
</DD>
<DT> auto.alias.add* $BJ8;zNs(B
</DT>
<DD> $B%(%$%j%"%9$rDI2C$9$k$?$a$N%a%C%;!<%8$G$9!#(B
$B$3$N%a%C%;!<%8$K0z?t$H$7$F%(%$%j%"%9$N%?%$%W$H%G!<%?$r;XDj$9$k$H!"(B
$B<+J,$N%(%$%j%"%9$K;XDj$7$?%G!<%?$rDI2C$7$^$9!#(B
</DD>
<DT> auto.alias.remove* $BJ8;zNs(B
</DT>
<DD> $B%(%$%j%"%9$r:o=|$9$k$?$a$N%a%C%;!<%8$G$9!#(B
$B$3$N%a%C%;!<%8$K0z?t$H$7$F%(%$%j%"%9$N%?%$%W$H%G!<%?$r;XDj$9$k$H!"(B
$B<+J,$N%(%$%j%"%9$N$&$A$G;XDj$7$?%G!<%?$r:o=|$7$^$9!#(B
nick$B$KBP$9$k%G!<%?$r:o=|$9$k$H!"%(%$%j%"%9$=$N$b$N$,:o=|$5$l$^$9!#(B
</DD>
<DT> auto.alias.change* $BJ8;zNs(B
</DT>
<DD> $B%(%$%j%"%9$rJQ99$9$k$?$a$N%a%C%;!<%8$G$9!#(B
$B$3$N%a%C%;!<%8$K0z?t$H$7$F%(%$%j%"%9$N%?%$%W!"8E$$%G!<%?!"(B
$B?7$7$$%G!<%?$r;XDj$9$k$H!"<+J,$N%(%$%j%"%9$N$&$A$G(B
$B;XDj$7$?%?%$%W$N8E$$%G!<%?$r?7$7$$%G!<%?$KJQ99$7$^$9!#(B
$B?7$7$$%G!<%?$,$9$G$KB8:_$9$k$+$I$&$+$O3NG'$7$F$$$J$$$N$G!"(B
$BF1$8%G!<%?$,(B2$B$D$G$-$J$$$h$&$K$7$F$/$@$5$$!#(B
</DD>
</DL>
<HR><H3>$B@_DjNc(B</H3>
<PRE>
+ auto/alias.plm
auto.alias.file: alias.txt;jis,euc
auto.alias.get: $B%(%$%j%"%9(B
auto.alias.add: $B%(%$%j%"%9DI2C(B
auto.alias.remove: $B%(%$%j%"%9:o=|(B
auto.alias.change: $B%(%$%j%"%9JQ99(B
</PRE>
$B!V%(%$%j%"%9!W$H$$$&H/8@$,$"$k$H!"H/8@$7$??M$N%(%$%j%"%9$rH/8@$7$^$9!#(B
$B%(%$%j%"%9$O!V(Balias.txt$B!W$H$$$&%U%!%$%k$+$iFI$_9~$_$^$9!#(B
alias.txt$B$O4A;z%3!<%I$,!V(Bjis$B!W$+!V(Beuc$B!W$G=q$+$l$F$$$kI,MW$,$"$j$^$9$,!"(B
IRC$B>e$+$i%(%$%j%"%9$NJQ99$r9T$C$?>l9g$O(Bjis$B$GJ]B8$5$l$^$9!#(B
$B$^$?!"!V%(%$%j%"%9(B name $B$W$i$`!W$N$h$&$KH/8@$9$k$H!"(B
$B%?%$%W$,!V(Bname$B!W$G!"%G!<%?$,!V$W$i$`!W$H$$$&?M$N%(%$%j%"%9$rJV$7$^$9!#(B
<BR><BR>
$B%(%$%j%"%9$rDI2C$9$k$?$a$K$O!"(B
$B!V%(%$%j%"%9DI2C(B user *!*plum@*.plum.gr.jp$B!W$N$h$&$KH/8@$7$^$9!#(B
$B$3$N>l9g$G$O%?%$%W$,!V(Buser$B!W$G!"%G!<%?$,!V(B*!*plum@*.plum.gr.jp$B!W(B
$B$H$$$&%(%$%j%"%9$r!"H/8@$7$??M$N%(%$%j%"%9$KDI2C$7$^$9!#(B
<BR><BR>
$B%(%$%j%"%9$r:o=|$9$k$?$a$K$O!"(B
$B!V%(%$%j%"%9:o=|(B name $B$W$i$`$A$c$s!W$N$h$&$KH/8@$7$^$9!#(B
$B$3$N>l9g$G$O%?%$%W$,!V(Bname$B!W$G!"%G!<%?$,!V$W$i$`$A$c$s!W$H$$$&%(%$%j%"%9$,!"(B
$BH/8@$7$??M$N%(%$%j%"%9$KB8:_$9$l$P!"$=$l$r:o=|$7$^$9!#(B
$B;XDj$7$?%G!<%?$,H/8@$7$??M$N%(%$%j%"%9$KB8:_$7$J$$>l9g$OL5;k$5$l$^$9!#(B
$B$^$?!"%?%$%W$,!V(Bnick$B!W$N%G!<%?$r$9$Y$F:o=|$7$?>l9g$O!"(B
$B$=$N?M$N%(%$%j%"%9$OA4$F:o=|$5$l$^$9!#(B
<BR><BR>
$B%(%$%j%"%9$rJQ99$9$k$?$a$K$O!"(B
$B!V%(%$%j%"%9JQ99(B name $B$W$i$`(B($B56(B) $B$W$i$`(B($B2>(B)$B!W$N$h$&$KH/8@$7$^$9!#(B
$B$3$N>l9g$G$O%?%$%W$,!V(Bname$B!W$G!"%G!<%?$,!V$W$i$`(B($B56(B)$B!W$H$$$&%(%$%j%"%9$,!"(B
$BH/8@$7$??M$N%(%$%j%"%9$KB8:_$9$l$P!"$=$l$r!V$W$i$`(B($B2>(B)$B!W$KJQ99$7$^$9!#(B
$B;XDj$7$?%G!<%?$,H/8@$7$??M$N%(%$%j%"%9$KB8:_$7$J$$>l9g$OL5;k$5$l$^$9!#(B
</BODY></HTML>