plum 2.33.1-10 / usr / share / plum / module / auto / answer.plm

# $Id: answer.plm,v 2.31 1999/01/21 17:16:20 hasegawa Exp $
# copyright (c)1997-1999 Yoshinori Hasegawa <hasegawa@madoka.org>

package auto_answer;

$_ = 'auto_answer';

sub ss_privmsg {
  local($serverno, $prefix, $cmd, @params) = @_;
  local($userno, $nick, %alias, $to, $str, $answer);
  $userno = $'userno[$serverno];
  $nick = &'prefix($prefix);
  %alias = &get_alias_user($userno, $prefix);
  $alias{'nick.now'} = $nick;
  if (&'channel($params[0])) {
    $alias{'channel'} = $params[0];
    $to = $params[0];
  } else {
    $to = $nick;
  }
  foreach $reply (&'property($userno, 'reply')) {
    ($str, $answer) = split(/\s+/, $reply, 2);
    next unless $str eq $params[1];
    &privmsg($serverno, $to, &'format($answer, %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_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/answer.plm</TITLE></HEAD><BODY>

$B%*%s%i%$%s%I%-%e%a%s%H(B


<HR><H3>$BL>A0(B</H3>

auto/answer.plm - $BFCDj$NH/8@$KH?1~$7$FBP1~$9$kH/8@$r$9$k(B


<HR><H3>$B@bL@(B</H3>

$BFCDj$NJ8;zNs$,H/8@$5$l$k$H!"$=$l$KBP1~$9$kJ8;zNs$rH/8@$7$^$9!#(B
$B$9$Y$F$NH/8@$KH?1~$9$k$?$a!"F1$8H/8@$r2?EY$b7+$jJV$92DG=@-$,(B
$B$"$k$N$GCm0U$7$F2<$5$$!#(B


<HR><H3>$B%W%m%Q%F%#(B</H3>

<DL>
<DT>  auto.answer.alias $B%U%!%$%kL>(B[;({jis|euc|sjis})]
</DT>
<DD>    $B%f!<%6L>$N%(%$%j%"%9$rDj5A$9$k%U%!%$%k$r;XDj$7$^$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.answer.reply* $BJ8;zNs(B $B%U%)!<%^%C%H(B
</DT>
<DD>    $BH?1~$9$kH/8@$H!"$=$l$KBP$9$kJV;v$r;XDj$7$^$9!#H?1~$9$kH/8@$K$O(B
        $B6uGr$r4^$a$k$3$H$O$G$-$^$;$s!#JV;v$K(B#(nick)$B$N$h$&$K=q$/$3$H$G!"(B
        $B%(%$%j%"%9$NBP1~$9$k%G!<%?$GCV$-49$($k$3$H$,$G$-$^$9!#(B
        $B$^$?!"%(%$%j%"%90J30$K$b(B#(nick.now)$B$G8=:_$N%K%C%/%M!<%`$K!"(B
        #(channel)$B$GH/8@$N$"$C$?%A%c%s%M%kL>$KCV49$7$^$9!#(B
        $B$^$?!"3g8LFb$r!V(B|$B!W$G6h@Z$C$FJ#?t;XDj$7$?>l9g!"(B
        $B:G=i$KDj5A$5$l$F$$$kCM$GCV$-49$($^$9!#(B
</DD>
</DL>


<HR><H3>$B@_DjNc(B</H3>

<PRE>
+ auto/answer.plm
auto.answer.alias: alias.txt
auto.answer.reply: $B$3$s$K$A$O(B $B$3$s$K$A$O!A!y(B
auto.answer.reply: $B$3$s$P$s$O(B #(name|nick|nick.now)$B$5$s!"$3$s$P$s$O!A!y(B
</PRE>

$B!V$3$s$K$A$O!W$H$$$&H/8@$,$"$C$?$H$-$K!V$3$s$K$A$O!A!y!W$HH/8@$7$^$9!#(B
$B$^$?!"!V$3$s$P$s$O!W$H$$$&H/8@$,$"$C$?$H$-$K!"(B
$BH/8@$7$??M$N%(%$%j%"%9$r!V(Balias.txt$B!W$+$i;2>H$7$F!"(B
$BNc$($P!V$W$i$`$5$s!"$3$s$P$s$o!A!y!W$N$h$&$KH/8@$7$^$9!#(B

<PRE>
+ auto/answer.plm
auto.answer.reply: $B$X$k$W(B $BEA8@5!G=$H>.Jq5!G=$N%X%k%W$G$9(B
auto.answer.reply: $B$X$k$W(B $B$G$s$4$s(B nick message : nick$B08$K%a%C%;!<%8$rFO$1$^$9(B
auto.answer.reply: $B$X$k$W(B $B$3$E$D$_(B nick message : nick$B08$K%U%!%$%k$rFO$1$^$9(B
auto.answer.reply: $B$3$E$D$_$X$k$W(B DCC$B$rAw$C$F$+$i08@h$r65$($F2<$5$$$M(B
</PRE>

$B!V$X$k$W!W$HH/8@$9$k$H!"(B3$B9T$K$o$?$k%X%k%W%a%C%;!<%8$rH/8@$7$^$9!#(B
$B$^$?!"!V$3$E$D$_$X$k$W!W$HH/8@$9$k$H!"(B
$B!V(BDCC$B$r@h$KAw$C$F$+$i08@h$r65$($F2<$5$$$M!W$HH/8@$7$^$9!#(B

</BODY></HTML>