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 / alias.plm next >
Text File  |  1998-10-15  |  13KB  |  431 lines
  1. <!DOCTYPE HTML PUBLIC "-//IETF//DTD HTML//EN"><!-- $_ if 0; # -*- perl -*-
  2. # $Id: alias.plm,v 2.20 1998/07/20 09:52:49 hasegawa Exp $
  3. # copyright (c)1998 pupu_j <hasegawa@agusa.nuie.nagoya-u.ac.jp>
  4.  
  5. package auto_alias;
  6.  
  7. $_ = 'auto_alias';
  8.  
  9. sub ss_privmsg {
  10.   local($serverno, $prefix, $cmd, @params) = @_;
  11.   local($userno, $str, $action, $type, @arg);
  12.   $userno = $'userno[$serverno];
  13.   ($action, $type, @arg) = split(/\s+/, $params[1]);
  14.   if ($action) {
  15.     $type = '' unless $type;
  16.     foreach $str (&'property($userno, 'get')) {
  17.       next unless $str eq $action;
  18.       &get_alias($serverno, $prefix, $params[0], "\L$type\E", @arg);
  19.       return ($prefix, $cmd, @params);
  20.     }
  21.     foreach $str (&'property($userno, 'add')) {
  22.       next unless $str eq $action;
  23.       &add_alias($serverno, $prefix, $params[0], "\L$type\E", @arg);
  24.       return ($prefix, $cmd, @params);
  25.     }
  26.     foreach $str (&'property($userno, 'remove')) {
  27.       next unless $str eq $action;
  28.       &remove_alias($serverno, $prefix, $params[0], "\L$type\E", @arg);
  29.       return ($prefix, $cmd, @params);
  30.     }
  31.     foreach $str (&'property($userno, 'change')) {
  32.       next unless $str eq $action;
  33.       &change_alias($serverno, $prefix, $params[0], "\L$type\E", @arg);
  34.       return ($prefix, $cmd, @params);
  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_alias {
  51.   local($serverno, $prefix, $chan, $type, $text) = @_;
  52.   local($userno, %alias, $no, $to);
  53.   $userno = $'userno[$serverno];
  54.   %alias = &read_alias($userno);
  55.   if ($text) {
  56.     $no = &fetch($type, $text, %alias);
  57.   } else {
  58.     $no = &match($prefix, %alias);
  59.   }
  60.   return unless $no;
  61.   $to = &'prefix($prefix);
  62.   foreach $line (&format($no, %alias)) {
  63.     &privmsg($serverno, $to, $line);
  64.   }
  65. }
  66.  
  67. sub add_alias {
  68.   local($serverno, $prefix, $chan, $type, @arg) = @_;
  69.   local($userno, %alias, $no, $i);
  70.   $userno = $'userno[$serverno];
  71.   %alias = &read_alias($userno);
  72.   $no = &match($prefix, %alias);
  73.   $alias{$no, 'nick'} = &'list((&'prefix($prefix))[0]) unless $no;
  74.   if ($type) {
  75.     $alias{$no, $type} = &'add($alias{$no, $type}, @arg);
  76.   }
  77.   &write_alias($userno, %alias);
  78. }
  79.  
  80. sub remove_alias {
  81.   local($serverno, $prefix, $chan, $type, @arg) = @_;
  82.   local($userno, %alias, $no, $i);
  83.   $userno = $'userno[$serverno];
  84.   %alias = &read_alias($userno);
  85.   return unless $type;
  86.   $no = &match($prefix, %alias);
  87.   if ($no) {
  88.     $alias{$no, $type} = &'remove($alias{$no, $type}, @arg);
  89.   }
  90.   &write_alias($userno, %alias);
  91. }
  92.  
  93. sub change_alias {
  94.   local($serverno, $prefix, $chan, $type, @arg) = @_;
  95.   local($userno, %alias, $no, $i);
  96.   $userno = $'userno[$serverno];
  97.   %alias = &read_alias($userno);
  98.   return unless $type;
  99.   $no = &match($prefix, %alias);
  100.   if ($no) {
  101.     $alias{$no, $type} = &'change($alias{$no, $type}, @arg);
  102.   }
  103.   &write_alias($userno, %alias);
  104. }
  105.  
  106. sub match {
  107.   local($prefix, %alias) = @_;
  108.   local($nick, $i, $regex);
  109.   $nick = &'prefix($prefix);
  110.   for ($i = 1; defined($alias{$i, 'nick'}); $i++) {
  111.     foreach $mask (&'array($alias{$i, 'user'} || '')) {
  112.       $regex = &'regex($mask);
  113.       return $i if $prefix =~ /$regex/i;
  114.     }
  115.     foreach $str (&'array($alias{$i, 'nick'})) {
  116.       return $i if "\L$nick\E" eq "\L$str\E";
  117.     }
  118.   }
  119.   return 0;
  120. }
  121.  
  122. sub fetch {
  123.   local($type, $arg, %alias) = @_;
  124.   local($i, $regex);
  125.   return 0 unless $type;
  126.   for ($i = 1; defined($alias{$i, 'nick'}); $i++) {
  127.     if ($type eq 'nick' || $type eq '*') {
  128.       foreach $str (&'array($alias{$i, 'nick'})) {
  129.         return $i if "\L$str\E" eq "\L$arg\E";
  130.       }
  131.     }
  132.     if ($type eq 'name' || $type eq '*') {
  133.       foreach $str (&'array($alias{$i, 'name'} || '')) {
  134.         return $i if $str eq $arg;
  135.       }
  136.     }
  137.     if ($type eq 'user' || $type eq '*') {
  138.       foreach $mask (&'array($alias{$i, 'user'} || '')) {
  139.         $regex = &'regex($mask);
  140.         return $i if $arg =~ /$regex/i;
  141.       }
  142.     }
  143.   }
  144.   return 0;
  145. }
  146.  
  147. sub format {
  148.   local($no, %alias) = @_;
  149.   local($n, $type, @list);
  150.   @list = ();
  151.   foreach $key (sort(keys(%alias))) {
  152.     ($n, $type) = split(/$;/, $key, 2);
  153.     next unless $n == $no;
  154.     if ($type eq 'nick') {
  155.       unshift(@list, 'nick: ' . join(',', &'array($alias{$key})));
  156.     } elsif ($type eq 'name') {
  157.       push(@list, 'name: ' . join(' ', &'array($alias{$key})));
  158.     } else {
  159.       foreach $str (&'array($alias{$key})) {
  160.         push(@list, $type . ': ' . $str);
  161.       }
  162.     }
  163.   }
  164.   return @list;
  165. }
  166.  
  167. sub read_alias {
  168.   local($userno) = @_;
  169.   local(%alias, $file, $idx, $name, $code, $line, $var, $arg, $type, $no);
  170.   $file = &'property($userno, 'file') || '';
  171.   if (($idx = rindex($file, ';')) != -1) {
  172.     $name = substr($file, 0, $idx);
  173.     $code = substr($file, $idx + 1);
  174.   } else {
  175.     $name = $file;
  176.     $code = '';
  177.   }
  178.   $name = &'expand($name);
  179.   if ($name && open(FILE, $name)) {
  180.     %alias = ();
  181.     $no = 0;
  182.     while (defined($line = <FILE>)) {
  183.       $line =~ s/^\s+//;
  184.       next if $line =~ /^[\#\;]/;
  185.       $line =~ tr/\r\n//d;
  186.       next unless $line;
  187.       $line =~ s/\s+$//;
  188.       $line = &code_jis($line, $code) if $code;
  189.       $line = &read_line($userno, $line);
  190.       if ((($var, $arg) = split(/\s*\:\s*/, $line, 2)) == 2) {
  191.         $type = "\L$var\E";
  192.         if ($type eq 'nick') {
  193.           $no++;
  194.           $alias{$no, 'nick'} = &'list(split(/\,/, $arg));
  195.         } elsif ($type eq 'name') {
  196.           $alias{$no, $type} = &'add($alias{$no, $type}, split(/\s+/, $arg));
  197.         } else {
  198.           $alias{$no, $type} = &'add($alias{$no, $type}, $arg);
  199.         }
  200.       }
  201.     }
  202.     close(FILE);
  203.   }
  204.   return %alias;
  205. }
  206.  
  207. sub write_alias {
  208.   local($userno, %alias) = @_;
  209.   local($file, $idx, $name, $code, $line, $i);
  210.   $file = &'property($userno, 'file') || '';
  211.   if (($idx = rindex($file, ';')) != -1) {
  212.     $name = substr($file, 0, $idx);
  213.     $code = substr($file, $idx + 1);
  214.   } else {
  215.     $name = $file;
  216.     $code = '';
  217.   }
  218.   $name = &'expand($name);
  219.   if ($name && open(FILE, ">$name")) {
  220.     for ($i = 1; defined($alias{$i, 'nick'}); $i++) {
  221.       foreach $line (&format($i, %alias)) {
  222.         $line = &jis_code($line, $code) if $code;
  223.         $line = &write_line($userno, $line);
  224.         print FILE $line, "\n";
  225.       }
  226.       print FILE "\n";
  227.     }
  228.     if (defined($alias{0, 'nick'})) {
  229.       foreach $line (&format(0, %alias)) {
  230.         $line = &jis_code($line, $code) if $code;
  231.         $line = &write_line($userno, $line);
  232.         print FILE $line, "\n";
  233.       }
  234.       print FILE "\n";
  235.     }
  236.     close(FILE);
  237.   }
  238. }
  239.  
  240. sub code_jis {
  241.   local($line, $list) = @_;
  242.   foreach $code (split(/\,/, "\L$list\E")) {
  243.     if ($code eq 'euc') {
  244.       $line = &'euc_jis($line);
  245.     } elsif ($code eq 'jis') {
  246.       $line = &'jis_jis($line);
  247.     } elsif ($code eq 'sjis') {
  248.       $line = &'sjis_jis($line);
  249.     }
  250.   }
  251.   return $line;
  252. }
  253.  
  254. sub jis_code {
  255.   local($line, $list) = @_;
  256.   local($code);
  257.   $code = (split(/\,/, "\L$list\E"))[0];
  258.   if ($code eq 'euc') {
  259.     $line = &'jis_euc($line);
  260.   } elsif ($code eq 'jis') {
  261.     $line = &'jis_jis($line);
  262.   } elsif ($code eq 'sjis') {
  263.     $line = &'jis_sjis($line);
  264.   }
  265.   return $line;
  266. }
  267.  
  268. sub read_line {
  269.   local($userno, $line) = @_;
  270.   foreach $kanji (&'property($userno, 'kanji')) {
  271.     foreach $code (split(/\,/, "\L$kanji\E")) {
  272.       if ($code eq 'euc') {
  273.         $line = &'euc_jis($line);
  274.       } elsif ($code eq 'jis') {
  275.         $line = &'jis_jis($line);
  276.       } elsif ($code eq 'sjis') {
  277.         $line = &'sjis_jis($line);
  278.       }
  279.     }
  280.   }
  281.   return $line;
  282. }
  283.  
  284. sub write_line {
  285.   local($userno, $line) = @_;
  286.   local($kanji, $code);
  287.   $kanji = &'property($userno, 'kanji');
  288.   if ($kanji) {
  289.     $code = (split(/\,/, "\L$kanji\E"))[0];
  290.     if ($code eq 'euc') {
  291.       $line = &'jis_euc($line);
  292.     } elsif ($code eq 'jis') {
  293.       $line = &'jis_jis($line);
  294.     } elsif ($code eq 'sjis') {
  295.       $line = &'jis_sjis($line);
  296.     }
  297.   }
  298.   return $line;
  299. }
  300.  
  301. __END__
  302. --><HTML><HEAD>
  303. <META HTTP-EQUIV="Content-Type" CONTENT="text/html; charset=ISO-2022-JP">
  304. <LINK REV="made" HREF="mailto:hasegawa@agusa.nuie.nagoya-u.ac.jp">
  305. <TITLE>auto/alias.plm</TITLE></HEAD><BODY>
  306.  
  307. $B%*%s%i%$%s%I%-%e%a%s%H(B
  308.  
  309.  
  310. <HR><H3>$BL>A0(B</H3>
  311.  
  312. auto/alias.plm - $B%f!<%6%(%$%j%"%9>pJs$N4IM}(B
  313.  
  314.  
  315. <HR><H3>$B@bL@(B</H3>
  316.  
  317. $B%f!<%6L>$N%(%$%j%"%9$NDI2C!":o=|!"3NG'$r9T$$$^$9!#(B
  318. $B%(%$%j%"%9$NDI2C!":o=|$O<+J,$N>pJs$KBP$7$F$7$+9T$&$3$H$O$G$-$^$;$s!#(B
  319. $B%(%$%j%"%9$O(Bnick$B!"(Bname$B!"(Buser$B$N(B3$B$D$N%?%$%W$N%G!<%?$+$i$J$C$F$*$j!"(B
  320. $B$=$l$>$l%K%C%/%M!<%`!"L>A0!"%f!<%6%^%9%/$rI=$7$^$9!#(B
  321. $B<B:]$K%f!<%6$r<1JL$9$k$?$a$K$O(Buser$B$,;HMQ$5$l$^$9!#(B
  322.  
  323. <BR><BR>
  324.  
  325. $B$^$?!"%(%$%j%"%9%U%!%$%k$NCf$G$O!"%G!<%?$O%f!<%6$4$H$K(B
  326. nick$B!"(Bname$B!"(Buser$B$N=gHV$GJ]B8$5$l$F$$$^$9!#(B
  327. $B$=$l$>$l$N%G!<%?$OJ#?t;XDj$9$k$3$H$,$G$-!"(Bnick$B$O!V(B,$B!W$G!"(B
  328. name$B$O6uGr$G!"(Buser$B$O(B1$B9T$K(B1$B$D$:$D$=$l$>$l6h@Z$j$^$9!#(B
  329. $B<B:]$N%U%!%$%kCf$N%G!<%?$O0J2<$N$h$&$K$J$C$F$$$^$9!#(B
  330.  
  331. <PRE>
  332. nick: plum,plum_j,plum-j
  333. name: $B$W$i$`(B $B$W$i$`$A$c$s(B
  334. user: *!plum@*.plum.org
  335. user: plum*!*plum@*.plum.com
  336.  
  337. nick: plum_
  338. name: $B$W$i$`(B($B56(B)
  339. user: *!*plum@*.plum.org
  340. </PRE>
  341.  
  342.  
  343. <HR><H3>$B%W%m%Q%F%#(B</H3>
  344.  
  345. <DL>
  346. <DT>  auto.alias.file $B%U%!%$%kL>(B[;({jis|euc|sjis})]
  347. </DT>
  348. <DD>    $B%(%$%j%"%9$rJ]B8$9$k%U%!%$%kL>$r;XDj$7$^$9!#(B
  349.         $B%U%!%$%kL>$N8e$K4A;z%3!<%I$r;XDj$9$k$3$H$,$G$-$^$9!#(B
  350.         $B4A;z%3!<%I$rJ#?t;XDj$7$?>l9g$O:G=i$K;XDj$7$?4A;z%3!<%I$GJ]B8$5$l!"(B
  351.         $B>JN,$7$?>l9g$O!V(Bjis$B!W$r;XDj$7$?$3$H$HF1$8$K$J$j$^$9!#(B
  352.         $B$^$?!V(Beuc$B!W$H!V(Bsjis$B!W$rF1;~$K;XDj$9$k$3$H$O$G$-$^$;$s!#(B
  353. </DD>
  354. <DT>  auto.alias.get* $BJ8;zNs(B
  355. </DT>
  356. <DD>    $B%(%$%j%"%9$r3NG'$9$k$?$a$N%a%C%;!<%8$G$9!#(B
  357.         $B$3$N%a%C%;!<%8$HF1$8J8;zNs$rH/8@$r$9$k$H!"(B
  358.         $B<+J,$K@_Dj$5$l$F$$$k%(%$%j%"%9$r3NG'$9$k$3$H$,$G$-$^$9!#(B
  359.         $B$^$?!"0z?t$H$7$F%(%$%j%"%9$N%?%$%W$H%G!<%?$r;XDj$9$k$H!"(B
  360.         $B$=$l$K%^%C%A$9$k?M$N%(%$%j%"%9$r3NG'$G$-$^$9!#(B
  361. </DD>
  362. <DT>  auto.alias.add* $BJ8;zNs(B
  363. </DT>
  364. <DD>    $B%(%$%j%"%9$rDI2C$9$k$?$a$N%a%C%;!<%8$G$9!#(B
  365.         $B$3$N%a%C%;!<%8$K0z?t$H$7$F%(%$%j%"%9$N%?%$%W$H%G!<%?$r;XDj$9$k$H!"(B
  366.         $B<+J,$N%(%$%j%"%9$K;XDj$7$?%G!<%?$rDI2C$7$^$9!#(B
  367. </DD>
  368. <DT>  auto.alias.remove* $BJ8;zNs(B
  369. </DT>
  370. <DD>    $B%(%$%j%"%9$r:o=|$9$k$?$a$N%a%C%;!<%8$G$9!#(B
  371.         $B$3$N%a%C%;!<%8$K0z?t$H$7$F%(%$%j%"%9$N%?%$%W$H%G!<%?$r;XDj$9$k$H!"(B
  372.         $B<+J,$N%(%$%j%"%9$N$&$A$G;XDj$7$?%G!<%?$r:o=|$7$^$9!#(B
  373.         nick$B$KBP$9$k%G!<%?$r:o=|$9$k$H!"%(%$%j%"%9$=$N$b$N$,:o=|$5$l$^$9!#(B
  374. </DD>
  375. <DT>  auto.alias.change* $BJ8;zNs(B
  376. </DT>
  377. <DD>    $B%(%$%j%"%9$rJQ99$9$k$?$a$N%a%C%;!<%8$G$9!#(B
  378.         $B$3$N%a%C%;!<%8$K0z?t$H$7$F%(%$%j%"%9$N%?%$%W!"8E$$%G!<%?!"(B
  379.         $B?7$7$$%G!<%?$r;XDj$9$k$H!"<+J,$N%(%$%j%"%9$N$&$A$G(B
  380.         $B;XDj$7$?%?%$%W$N8E$$%G!<%?$r?7$7$$%G!<%?$KJQ99$7$^$9!#(B
  381.         $B?7$7$$%G!<%?$,$9$G$KB8:_$9$k$+$I$&$+$O3NG'$7$F$$$J$$$N$G!"(B
  382.         $BF1$8%G!<%?$,(B2$B$D$G$-$J$$$h$&$K$7$F$/$@$5$$!#(B
  383. </DD>
  384. </DL>
  385.  
  386.  
  387. <HR><H3>$B@_DjNc(B</H3>
  388.  
  389. <PRE>
  390. + auto/alias.plm
  391. auto.alias.file: alias.txt;jis,euc
  392. auto.alias.get: $B%(%$%j%"%9(B
  393. auto.alias.add: $B%(%$%j%"%9DI2C(B
  394. auto.alias.remove: $B%(%$%j%"%9:o=|(B
  395. auto.alias.change: $B%(%$%j%"%9JQ99(B
  396. </PRE>
  397.  
  398. $B!V%(%$%j%"%9!W$H$$$&H/8@$,$"$k$H!"H/8@$7$??M$N%(%$%j%"%9$rH/8@$7$^$9!#(B
  399. $B%(%$%j%"%9$O!V(Balias.txt$B!W$H$$$&%U%!%$%k$+$iFI$_9~$_$^$9!#(B
  400. alias.txt$B$O4A;z%3!<%I$,!V(Bjis$B!W$+!V(Beuc$B!W$G=q$+$l$F$$$kI,MW$,$"$j$^$9$,!"(B
  401. IRC$B>e$+$i%(%$%j%"%9$NJQ99$r9T$C$?>l9g$O(Bjis$B$GJ]B8$5$l$^$9!#(B
  402. $B$^$?!"!V%(%$%j%"%9(B name $B$W$i$`!W$N$h$&$KH/8@$9$k$H!"(B
  403. $B%?%$%W$,!V(Bname$B!W$G!"%G!<%?$,!V$W$i$`!W$H$$$&?M$N%(%$%j%"%9$rJV$7$^$9!#(B
  404.  
  405. <BR><BR>
  406.  
  407. $B%(%$%j%"%9$rDI2C$9$k$?$a$K$O!"(B
  408. $B!V%(%$%j%"%9DI2C(B user *!*plum@*.plum.gr.jp$B!W$N$h$&$KH/8@$7$^$9!#(B
  409. $B$3$N>l9g$G$O%?%$%W$,!V(Buser$B!W$G!"%G!<%?$,!V(B*!*plum@*.plum.gr.jp$B!W(B
  410. $B$H$$$&%(%$%j%"%9$r!"H/8@$7$??M$N%(%$%j%"%9$KDI2C$7$^$9!#(B
  411.  
  412. <BR><BR>
  413.  
  414. $B%(%$%j%"%9$r:o=|$9$k$?$a$K$O!"(B
  415. $B!V%(%$%j%"%9:o=|(B name $B$W$i$`$A$c$s!W$N$h$&$KH/8@$7$^$9!#(B
  416. $B$3$N>l9g$G$O%?%$%W$,!V(Bname$B!W$G!"%G!<%?$,!V$W$i$`$A$c$s!W$H$$$&%(%$%j%"%9$,!"(B
  417. $BH/8@$7$??M$N%(%$%j%"%9$KB8:_$9$l$P!"$=$l$r:o=|$7$^$9!#(B
  418. $B;XDj$7$?%G!<%?$,H/8@$7$??M$N%(%$%j%"%9$KB8:_$7$J$$>l9g$OL5;k$5$l$^$9!#(B
  419. $B$^$?!"%?%$%W$,!V(Bnick$B!W$N%G!<%?$r$9$Y$F:o=|$7$?>l9g$O!"(B
  420. $B$=$N?M$N%(%$%j%"%9$OA4$F:o=|$5$l$^$9!#(B
  421.  
  422. <BR><BR>
  423.  
  424. $B%(%$%j%"%9$rJQ99$9$k$?$a$K$O!"(B
  425. $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
  426. $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
  427. $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
  428. $B;XDj$7$?%G!<%?$,H/8@$7$??M$N%(%$%j%"%9$KB8:_$7$J$$>l9g$OL5;k$5$l$^$9!#(B
  429.  
  430. </BODY></HTML>
  431.