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 >
Text File  |  1998-10-15  |  13KB  |  461 lines
  1. <!DOCTYPE HTML PUBLIC "-//IETF//DTD HTML//EN"><!-- $_ if 0; # -*- perl -*-
  2. # $Id: message.plm,v 2.31 1998/10/13 14:05:34 hasegawa Exp $
  3. # copyright (c)1998 pupu_j <hasegawa@agusa.nuie.nagoya-u.ac.jp>
  4.  
  5. package auto_message;
  6.  
  7. $FREQUENCY = 3600;
  8.  
  9. $_ = 'auto_message';
  10.  
  11. sub ss_join {
  12.   local($serverno, $prefix, $cmd, @params) = @_;
  13.   &receive($serverno, $prefix);
  14.   return ($prefix, $cmd, @params);
  15. }
  16.  
  17. sub ss_nick {
  18.   local($serverno, $prefix, $cmd, @params) = @_;
  19.   local($nick);
  20.   $nick = &'prefix($prefix);
  21.   $last{$serverno, $params[0]} = $last{$serverno, $nick};
  22.   delete($last{$serverno, $nick});
  23.   $user = $params[0] . substr($prefix, index($prefix, '!'));
  24.   &receive($serverno, $user);
  25.   return ($prefix, $cmd, @params);
  26. }
  27.  
  28. sub ss_part {
  29.   local($serverno, $prefix, $cmd, @params) = @_;
  30.   &receive($serverno, $prefix);
  31.   return ($prefix, $cmd, @params);
  32. }
  33.  
  34. sub ss_topic {
  35.   local($serverno, $prefix, $cmd, @params) = @_;
  36.   &receive($serverno, $prefix);
  37.   return ($prefix, $cmd, @params);
  38. }
  39.  
  40. sub ss_kick {
  41.   local($serverno, $prefix, $cmd, @params) = @_;
  42.   &receive($serverno, $prefix);
  43.   return ($prefix, $cmd, @params);
  44. }
  45.  
  46. sub ss_mode {
  47.   local($serverno, $prefix, $cmd, @params) = @_;
  48.   &receive($serverno, $prefix);
  49.   return ($prefix, $cmd, @params);
  50. }
  51.  
  52. sub ss_privmsg {
  53.   local($serverno, $prefix, $cmd, @params) = @_;
  54.   local($userno, $str, $to, $text, $reply, $who);
  55.   $userno = $'userno[$serverno];
  56.   &receive($serverno, $prefix);
  57.   if ($params[1]) {
  58.     foreach $get (&'property($userno, 'get')) {
  59.       next unless $params[1] eq $get;
  60.       &get($serverno, $prefix, $params[0]);
  61.       return ($prefix, $cmd, @params);
  62.     }
  63.     ($str, $to, $text) = split(/\s+/, $params[1], 3);
  64.     if ($text) {
  65.       foreach $send (&'property($userno, 'send')) {
  66.         next unless $str eq $send;
  67.         &send($serverno, $prefix, $params[0], $to, $text);
  68.         return ($prefix, $cmd, @params);
  69.       }
  70.     }
  71.   }
  72.   return ($prefix, $cmd, @params);
  73. }
  74.  
  75. sub get {
  76.   local($serverno, $prefix, $chan) = @_;
  77.   local($userno, $nick, @alias, @msg, @data, $name, $reply);
  78.   $userno = $'userno[$serverno];
  79.   $nick = &'prefix($prefix);
  80.   @alias = &read_alias($userno);
  81.   @msg = &get_msg($userno, $prefix, @alias);
  82.   if (scalar(@msg)) {
  83.     foreach $line (@msg) {
  84.       @data = split(/\s+/, $line, 6);
  85.       $name = &user_name($data[3], @alias);
  86.       $reply = substr($data[0], index($data[0], '/') + 1) . ' ' . substr($data[1], 0, rindex($data[1], ':')) . ' ' . $name . ' >> ' . $data[5];
  87.       &privmsg($serverno, $nick, $reply);
  88.     }
  89.     &delete_msg($userno, @msg);
  90.   } else {
  91.     $reply = &'property($userno, 'nothing');
  92.     &privmsg($serverno, $nick, $reply) if $reply;
  93.   }
  94. }
  95.  
  96. sub receive {
  97.   local($serverno, $prefix) = @_;
  98.   local($userno, $nick, $time, $recv, @alias, @msg);
  99.   $userno = $'userno[$serverno];
  100.   $nick = &'prefix($prefix);
  101.   @alias = &read_alias($userno);
  102.   @msg = &get_msg($userno, $prefix, @alias);
  103.   if (scalar(@msg)) {
  104.     $time = time();
  105.     $last{$serverno, $nick} = 0 unless $last{$serverno, $nick};
  106.     if ($time - $last{$serverno, $nick} > $FREQUENCY) {
  107.       $recv = &'property($userno, 'receive');
  108.       &privmsg($serverno, $nick, $recv) if $recv;
  109.     }
  110.     $last{$serverno, $nick} = $time;
  111.   } else {
  112.     $last{$serverno, $nick} = 0;
  113.   }
  114. }
  115.  
  116. sub send {
  117.   local($serverno, $prefix, $chan, $to, $text) = @_; 
  118.   local($userno, @alias, $file, $idx, $name, $code, $reply, $who, $line);
  119.   $userno = $'userno[$serverno];
  120.   @alias = &read_alias($userno);
  121.   if (&check($to, @alias)) {
  122.     $file = &'property($userno, 'file') || '';
  123.     if (($idx = rindex($file, ';')) != -1) {
  124.       $name = substr($file, 0, $idx);
  125.       $code = substr($file, $idx + 1);
  126.     } else {
  127.       $name = $file;
  128.      $code = '';
  129.     }
  130.     $name = &'expand($name);
  131.     if ($name && open(FILE, ">>$name")) {
  132.       $line = join(' ', &'date('%Y/%m/%d %H:%M:%S'), $to, $prefix, $chan, $text);
  133.       $line = &jis_code($line, $code) if $code;
  134.       print FILE $line, "\n";
  135.       close(FILE);
  136.     }
  137.     $reply = &'property($userno, 'accept');
  138.   } else {
  139.     $reply = &'property($userno, 'unknown');
  140.   }
  141.   if ($reply) {
  142.     if ($chan =~ /^[\#\&\+]/) {
  143.       $who = $chan;
  144.     } else {
  145.       $who = &'prefix($prefix);
  146.     }
  147.     &privmsg($serverno, $who, $reply) if $reply;
  148.   }
  149. }
  150.  
  151. sub privmsg {
  152.   local($serverno, $to, $msg) = @_;
  153.   &'s_print($serverno, '', 'PRIVMSG', $to, $msg);
  154.   foreach $cno (&'array($'clientlist)) {
  155.     next unless $'avail[$cno];
  156.     next unless $'server[$cno] == $serverno;
  157.     &'c_print($cno, &'user($cno), 'PRIVMSG', $to, $msg);
  158.   }
  159. }
  160.  
  161. sub get_msg {
  162.   local($userno, $prefix, @alias) = @_;
  163.   local(@list, $file, $idx, $name, $code, $line, @data);
  164.   $file = &'property($userno, 'file') || '';
  165.   if (($idx = rindex($file, ';')) != -1) {
  166.     $name = substr($file, 0, $idx);
  167.     $code = substr($file, $idx + 1);
  168.   } else {
  169.     $name = $file;
  170.     $code = '';
  171.   }
  172.   $name = &'expand($name);
  173.   if ($name && open(FILE, $name)) {
  174.     while (defined($line = <FILE>)) {
  175.       $line =~ tr/\r\n//d;
  176.       next unless $line;
  177.       $line = &code_jis($line, $code) if $code;
  178.       @data = split(/\s+/, $line, 6);
  179.       next unless &match($prefix, $data[2], @alias);
  180.       push(@list, $line);
  181.     }
  182.     close(FILE);
  183.   }
  184.   return @list;
  185. }
  186.  
  187. sub delete_msg {
  188.   local($userno, @list) = @_;
  189.   local($file, $idx, $name, $code, $list, @msg);
  190.   $file = &'property($userno, 'file') || '';
  191.   if (($idx = rindex($file, ';')) != -1) {
  192.     $name = substr($file, 0, $idx);
  193.     $code = substr($file, $idx + 1);
  194.   } else {
  195.     $name = $file;
  196.     $code = '';
  197.   }
  198.   $name = &'expand($name);
  199.   if ($name && open(FILE, $name)) {
  200.     $list = &'list(@list);
  201.     while (defined($line = <FILE>)) {
  202.       $line =~ tr/\r\n//d;
  203.       next unless $line;
  204.       next if &'exist($list, $line);
  205.       push(@msg, $line);
  206.     }
  207.     close(FILE);
  208.     if ($name && open(FILE, ">$name")) {
  209.       foreach $line (@msg) {
  210.         $line = &code_jis($line, $code) if $code;
  211.         print FILE $line, "\n";
  212.       }
  213.       close(FILE);
  214.     }
  215.   }
  216. }
  217.  
  218. sub check {
  219.   local($to, @alias) = @_;
  220.   local($i);
  221.   if ($to =~ /^[A-\}][\-\dA-\}]*$/ && length($to) <= 9) {
  222.     return 1;
  223.   } else {
  224.     for ($i = 0; $i < scalar(@alias); $i += 3) {
  225.       foreach $str (&'array($alias[$i + 1] || '')) {
  226.         return 1 if $str eq $to;
  227.       }
  228.     }
  229.     return 0;
  230.   }
  231. }
  232.  
  233. sub user_name {
  234.   local($prefix, @alias) = @_;
  235.   local($regex, $i);
  236.   for ($i = 0; $i < scalar(@alias); $i += 3) {
  237.     foreach $mask (&'array($alias[$i + 2] || '')) {
  238.       $regex = &'regex($mask);
  239.       next unless $prefix =~ /$regex/i;
  240.       return ((&'array($alias[$i + 1] || $alias[$i]))[0]);
  241.     }
  242.   }
  243.   return (&'prefix($prefix))[0];
  244. }
  245.  
  246. sub match {
  247.   local($prefix, $to, @alias) = @_;
  248.   local($i, $regex, $no, $nick);
  249.   for ($i = 0; $i < scalar(@alias); $i += 3) {
  250.     foreach $str (&'array($alias[$i])) {
  251.       next unless "\L$str\E" eq "\L$to\E";
  252.       $no = $i + 2;
  253.       last;
  254.     }
  255.     foreach $str (&'array($alias[$i + 1] || '')) {
  256.       next unless $str eq $to;
  257.       $no = $i + 2;
  258.       last;
  259.     }
  260.   }
  261.   if ($no) {
  262.     foreach $mask (&'array($alias[$no] || '')) {
  263.       $regex = &'regex($mask);
  264.       return 1 if $prefix =~ /$regex/i;
  265.     }
  266.   } else {
  267.     $nick = &'prefix($prefix);
  268.     return 1 if "\L$nick\E" eq "\L$to\E";
  269.   }
  270.   return 0;
  271. }
  272.  
  273. sub read_alias {
  274.   local($userno) = @_;
  275.   local(@alias, $file, $idx, $name, $code, $line, $var, $arg, $no);
  276.   $file = &'property($userno, 'alias') || '';
  277.   if (($idx = rindex($file, ';')) != -1) {
  278.     $name = substr($file, 0, $idx);
  279.     $code = substr($file, $idx + 1);
  280.   } else {
  281.     $name = $file;
  282.     $code = '';
  283.   }
  284.   $name = &'expand($name);
  285.   if ($name && open(FILE, $name)) {
  286.     @alias = ();
  287.     $no = -3;
  288.     while (defined($line = <FILE>)) {
  289.       $line =~ s/^\s+//;
  290.       next if $line =~ /^[\#\;]/;
  291.       $line =~ tr/\r\n//d;
  292.       next unless $line;
  293.       $line =~ s/\s+$//;
  294.       $line = &code_jis($line, $code) if $code;
  295.       $line = &read_line($userno, $line);
  296.       next unless (($var, $arg) = split(/\s*\:\s*/, $line, 2)) == 2;
  297.       if ("\L$var\E" eq 'nick') {
  298.         $no += 3;
  299.         $alias[$no] = &'list(split(/\,/, $arg));
  300.       } elsif ("\L$var\E" eq 'name') {
  301.         $alias[$no + 1] = &'add($alias[$no + 1], split(/\s+/, $arg));
  302.       } elsif ("\L$var\E" eq 'user') {
  303.         $alias[$no + 2] = &'add($alias[$no + 2], $arg);
  304.       }
  305.     }
  306.     close(FILE);
  307.   }
  308.   return @alias;
  309. }
  310.  
  311. sub code_jis {
  312.   local($line, $list) = @_;
  313.   foreach $code (split(/\,/, "\L$list\E")) {
  314.     if ($code eq 'euc') {
  315.       $line = &'euc_jis($line);
  316.     } elsif ($code eq 'jis') {
  317.       $line = &'jis_jis($line);
  318.     } elsif ($code eq 'sjis') {
  319.       $line = &'sjis_jis($line);
  320.     }
  321.   }
  322.   return $line;
  323. }
  324.  
  325. sub jis_code {
  326.   local($line, $list) = @_;
  327.   local($code);
  328.   $code = (split(/\,/, "\L$list\E"))[0];
  329.   if ($code eq 'euc') {
  330.     $line = &'jis_euc($line);
  331.   } elsif ($code eq 'jis') {
  332.     $line = &'jis_jis($line);
  333.   } elsif ($code eq 'sjis') {
  334.     $line = &'jis_sjis($line);
  335.   }
  336.   return $line;
  337. }
  338.  
  339. sub read_line {
  340.   local($userno, $line) = @_;
  341.   foreach $kanji (&'property($userno, 'kanji')) {
  342.     foreach $code (split(/\,/, "\L$kanji\E")) {
  343.       if ($code eq 'euc') {
  344.         $line = &'euc_jis($line);
  345.       } elsif ($code eq 'jis') {
  346.         $line = &'jis_jis($line);
  347.       } elsif ($code eq 'sjis') {
  348.         $line = &'sjis_jis($line);
  349.       }
  350.     }
  351.   }
  352.   return $line;
  353. }
  354.  
  355. __END__
  356. --><HTML><HEAD>
  357. <META HTTP-EQUIV="Content-Type" CONTENT="text/html; charset=ISO-2022-JP">
  358. <LINK REV="made" HREF="mailto:hasegawa@agusa.nuie.nagoya-u.ac.jp">
  359. <TITLE>auto/message.plm</TITLE></HEAD><BODY>
  360.  
  361. $B%*%s%i%$%s%I%-%e%a%s%H(B
  362.  
  363.  
  364. <HR><H3>$BL>A0(B</H3>
  365.  
  366. auto/message.plm - $B;XDj$7$??M$K%a%C%;!<%8$rFO$1$k(B
  367.  
  368.  
  369. <HR><H3>$B@bL@(B</H3>
  370.  
  371. $B;XDj$7$??M$KBP$7$F%a%C%;!<%8$rFO$1$^$9!#$$$o$f$kEA8@$G$9!#(B
  372. $B%f!<%6$,%A%c%s%M%k$KF~$C$F$-$?$H$-!"%K%C%/%M!<%`$rJQ$($?$H$-$K(B
  373. $B%a%C%;!<%8$,FO$$$F$$$k$3$H$rCN$i$;$^$9!#(B
  374. $B$=$N$?$a!"F1$8%A%c%s%M%k$KF~$i$J$$%f!<%6$KBP$7$F$O(B
  375. $B%a%C%;!<%8$rFO$1$k$3$H$,$G$-$^$;$s!#(B
  376.  
  377.  
  378. <HR><H3>$B%W%m%Q%F%#(B</H3>
  379.  
  380. <DL>
  381. <DT>  auto.message.file $B%U%!%$%kL>(B[;({jis|euc|sjis})]
  382. </DT>
  383. <DD>    $B%a%C%;!<%8$r3JG<$9$k%U%!%$%kL>$G$9!#(B
  384.         $B%U%!%$%k$O;XDj$7$?4A;z%3!<%I$GJ]B8$5$l$^$9!#(B
  385.         $B4A;z%3!<%I$rJ#?t;XDj$7$?>l9g$O!":G=i$K;XDj$7$?4A;z%3!<%I$G(B
  386.         $BJ]B8$5$l!">JN,$7$?>l9g$O!V(Bjis$B!W$r;XDj$7$?$3$H$HF1$8$G$9!#(B
  387.         $B$^$?!"!V(Beuc$B!W$H!V(Bsjis$B!W$rF1;~$K;XDj$9$k$3$H$O$G$-$^$;$s!#(B
  388. </DD>
  389. <DT>  auto.message.alias $B%U%!%$%kL>(B[;({jis|euc|sjis})]
  390. </DT>
  391. <DD>    $B%(%$%j%"%9$r;2>H$9$k%U%!%$%kL>$G$9!#(B
  392.         $B$3$N%U%!%$%k$O(Bauto/alias.plm$B$G;H$&$b$N$HF1$8$b$N$G$9!#(B
  393.         $B%U%!%$%k$O;XDj$7$?4A;z%3!<%I$GJ]B8$5$l$F$$$kI,MW$,$"$j$^$9!#(B
  394. </DD>
  395. <DT>  auto.message.get* $BJ8;zNs(B
  396. </DT>
  397. <DD>    $BFO$$$F$$$k%a%C%;!<%8$rJ9$/$?$a$NJ8;zNs$G$9!#(B
  398.         $B$3$3$G;XDj$7$?J8;zNs$HF1$8H/8@$,$"$k$H!"(B
  399.         $BH/8@$7$??M$KBP$7$FFO$$$F$$$k%a%C%;!<%8$rEA$($^$9!#(B
  400. </DD>
  401. <DT>  auto.message.send* $BJ8;zNs(B
  402. </DT>
  403. <DD>    $B%a%C%;!<%8$rFO$1$k$?$a$NJ8;zNs$G$9!#(B
  404.         $B$3$N%a%C%;!<%8$N0z?t$H$7$F%f!<%6L>$HJ8;zNs$r;XDj$9$k$3$H$G!"(B
  405.         $B$=$N?M$KBP$7$F%a%C%;!<%8$rFO$1$^$9!#(B
  406. </DD>
  407. <DT>  auto.message.accept $BJ8;zNs(B
  408. </DT>
  409. <DD>    $B%a%C%;!<%8$r>5$C$?$H$-$KH/8@$9$kJ8;zNs$G$9!#(B
  410.         $B%a%C%;!<%8$r@5$7$/<u$1<h$C$?$H$-$K$H$-$K!"(B
  411.         $B$3$3$G;XDj$7$?J8;zNs$rH/8@$7$^$9!#(B
  412. </DD>
  413. <DT>  auto.message.unknown $B%a%C%;!<%8(B
  414. </DT>
  415. <DD>    $B%a%C%;!<%8$rAw$kAj<j$,$o$+$i$J$$$H$-$KH/8@$9$kJ8;zNs$G$9!#(B
  416.         $BC/$KEA$($F$$$$$+$o$+$i$J$$>l9g$O$3$3$G;XDj$7$?J8;zNs$rH/8@$7!"(B
  417.         $B%a%C%;!<%8$rFO$1$k$3$H$,$G$-$J$$$3$H$rEA$($^$9!#(B
  418. </DD>
  419. <DT>  auto.message.receive $BJ8;zNs(B
  420. </DT>
  421. <DD>    $B%a%C%;!<%8$,FO$$$F$$$k$3$H$rEA$($kJ8;zNs$G$9!#(B
  422.         $B%A%c%s%M%k$KF~$C$F$-$?;~$d!"%K%C%/%M!<%`$rJQ99$7$?;~$K!"(B
  423.         $B$=$N?M$KBP$9$k%a%C%;!<%8$,FO$$$F$$$l$P!"(B
  424.         $B$3$3$G;XDj$7$?J8;zNs$rH/8@$7$^$9!#(B
  425. </DD>
  426. <DT>  auto.message.nothing $BJ8;zNs(B
  427. </DT>
  428. <DD>    $B%a%C%;!<%8$rJ9$$$F$-$?$H$-$K!"$=$N?M$KBP$9$k%a%C%;!<%8$,(B
  429.         $BFO$$$F$$$J$+$C$?$H$-$O!"$3$3$G;XDj$7$?J8;zNs$rH/8@$7$^$9!#(B
  430. </DD>
  431. </DL>
  432.  
  433.  
  434. <HR><H3>$B@_DjNc(B</H3>
  435.  
  436. <PRE>
  437. + auto/message.plm
  438. auto.message.file: message.txt;jis
  439. auto.message.alias: alias.txt;jis,euc
  440. auto.message.get: $BEA8@65$($F(B
  441. auto.message.send: $BEA8@(B
  442. auto.message.accept: $BEA8@$r3P$($^$7$?(B
  443. auto.message.unknown: $B08@h$,$o$+$j$^$;$s(B
  444. auto.message.receive: $BEA8@$,FO$$$F$$$^$9!#!VEA8@65$($F!W$G$*EA$($7$^$9(B
  445. auto.message.nothing: $BEA8@$O$"$j$^$;$s(B
  446. </PRE>
  447.  
  448. $B!VEA8@(B pupu_j $B$[$($[$(!W$N$h$&$KH/8@$9$k$H!"(B
  449. $B!V(Bpupu_j$B!W$H$$$&%K%C%/%M!<%`$N?M$K!V$[$($[$(!W$H$$$&%a%C%;!<%8$rEA$($^$9!#(B
  450. $B$^$?!V(Balias.txt$B!W$K;XDj$5$l$F$$$kL>A0$r;H$C$F!"(B
  451. $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
  452.  
  453. <BR><BR>
  454.  
  455. $B%a%C%;!<%8$,FO$$$F$$$k$H$-$K!"%A%c%s%M%k$KF~$C$?$j!"(B
  456. $B%K%C%/%M!<%`$rJQ99$9$k$H!"!VEA8@$,FO$$$F$$$^$9!#!VEA8@65$($F!W$G8+$i$l$^$9!W(B
  457. $B$H8@$C$FCN$i$;$^$9!#%a%C%;!<%8$,FO$$$F$$$k$H$-$K!"(B
  458. $B!VEA8@65$($F!W$HH/8@$9$k$H!"FO$$$F$$$k%a%C%;!<%8$rJ9$/$3$H$,$G$-$^$9!#(B
  459.  
  460. </BODY></HTML>
  461.