imported http://mrmt.net/src/keitairc/keitairc r1.6

diff --git a/keitairc b/keitairc
index 907eed5..458722e 100755 (executable)
--- a/keitairc
+++ b/keitairc
@@ -1,6 +1,6 @@
 #!/usr/bin/perl
 # keitairc
-# $Id: keitairc,v 1.5 2004-03-21 11:02:14 morimoto Exp $
+# $Id: keitairc,v 1.6 2004-03-21 11:02:27 morimoto Exp $
 #
 # Copyright (c) 2003 Jun Morimoto <morimoto@xantia.citroen.org>
 # This program is covered by the GNU General Public License 2
@@ -8,6 +8,9 @@
 # Depends: libjcode-pm-perl, libpoe-component-irc-perl,
 #   liburi-perl, libwww-perl, libappconfig-perl
 
+my $rcsid = q$Id: keitairc,v 1.6 2004-03-21 11:02:27 morimoto Exp $;
+my ($version) = $rcsid =~ m#,v ([0-9.]+)#;
+
 use strict;
 use Jcode;
 use POE;
@@ -27,7 +30,7 @@ my $config = AppConfig->new(
                            },
                            qw(irc_nick irc_username irc_desc
                               irc_server irc_port irc_password
-                              web_port web_title web_lines
+                              web_port web_title web_lines web_root
                               web_username web_password)
                            );
 
@@ -35,7 +38,19 @@ $config->file('/etc/keitairc');
 $config->file($ENV{'HOME'} . '/.keitairc');
 $config->args;
 
-my (%channels, %buffer, %atime, %mtime);
+my $docroot = '/';
+if(defined $config->web_root){
+    $docroot = $config->web_root;
+}
+
+# join \e$B$7$F$$$k%A%c%M%k$NL>>N$r5-O?$9$k%O%C%7%e\e(B
+my %channel_name;
+
+# \e$B%A%c%M%k$N2qOCFbMF$r5-O?$9$k%O%C%7%e\e(B
+my %channel_buffer;
+
+# \e$B3F%A%c%M%k$N:G=*%"%/%;%9;~9o!":G?7H/8@;~9o\e(B
+my (%atime, %mtime);
 
 # irc component
 POE::Component::IRC->new('keitairc');
@@ -75,8 +90,7 @@ sub on_irc_start{
 ################################################################
 sub on_irc_join{
     my ($kernel, $who, $channel) = @_[KERNEL, ARG0, ARG1];
-    $channel = Jcode->new($channel)->euc;
-    $channels{$channel}++;
+    $channel_name{$channel}++;
 }
 
 ################################################################
@@ -86,8 +100,7 @@ sub on_irc_part{
     # chop off after the gap (bug workaround of POE::Filter::IRC)
     $channel =~ s/ .*//;
 
-    $channel = Jcode->new($channel)->euc;
-    delete $channels{$channel};
+    delete $channel_name{$channel};
 }
 
 ################################################################
@@ -95,7 +108,7 @@ sub on_irc_public{
     my ($kernel, $who, $channel, $msg) = @_[KERNEL, ARG0 .. ARG2];
     $who =~ s/!.*//;
     $channel = $channel->[0];
-    $msg = Jcode->new($msg)->euc;
+    $msg = Jcode->new($msg, 'jis')->euc;
     &add_message($channel, $who, $msg);
 }
 
@@ -104,7 +117,7 @@ sub on_irc_notice{
     my ($kernel, $who, $channel, $msg) = @_[KERNEL, ARG0 .. ARG2];
     $who =~ s/!.*//;
     $channel = $channel->[0];
-    $msg = Jcode->new($msg)->euc;
+    $msg = Jcode->new($msg, 'jis')->euc;
     &add_message($channel, $who, $msg);
 }
 
@@ -114,15 +127,13 @@ sub on_irc_notice{
 sub add_message{
     my($channel, $who, $msg) = @_;
 
-    $channel = Jcode->new($channel)->euc;
-
-    my @tmp = split("\n", $buffer{$channel});
+    my @tmp = split("\n", $channel_buffer{$channel});
     push @tmp, sprintf('%s %s> %s', &now, $who, $msg);
 
     if(@tmp > $config->web_lines){
-       $buffer{$channel} = join("\n", splice(@tmp, -$config->web_lines));
+       $channel_buffer{$channel} = join("\n", splice(@tmp, -$config->web_lines));
     }else{
-       $buffer{$channel} = join("\n", @tmp);
+       $channel_buffer{$channel} = join("\n", @tmp);
     }
 
     $mtime{$channel} = time;
@@ -144,30 +155,39 @@ sub escape{
 }
 
 ################################################################
+sub label{
+    my $accesskey = shift;
+
+    if($accesskey < 10){
+       sprintf('%d ', $accesskey);
+    }else{
+       '  ';
+    }
+}
+
+################################################################
 sub index_page{
     my $buf;
     my $accesskey = 1;
 
     for my $channel (sort {
        $mtime{$b} <=> $mtime{$a};
-    }(keys(%channels))){
+    }(keys(%channel_name))){
 
-       if($accesskey < 10){
-           $buf .= sprintf('&#%d;', 63878 + $accesskey);
-       }else{
-           $buf .= '  ';
-       }
+       $buf .= &label($accesskey);
 
-       unless(defined($buffer{$channel})){
+       unless(defined($channel_buffer{$channel})){
            $buf .= &compact_channel_name($channel);
        }else{
            if($accesskey < 10){
-               $buf .= sprintf('<a accesskey="%1d" href="/%s">%s</a>',
+               $buf .= sprintf('<a accesskey="%1d" href="%s%s">%s</a>',
                                $accesskey,
+                               $docroot,
                                uri_escape($channel),
                                &compact_channel_name($channel));
            }else{
-               $buf .= sprintf('  <a href="/%s">%s</a>',
+               $buf .= sprintf('<a href="%docroot%s">%s</a>',
+                               $docroot,
                                uri_escape($channel),
                                &compact_channel_name($channel));
            }
@@ -182,18 +202,25 @@ sub index_page{
        $buf .= '<br>';
     }
 
-    $buf .= '<a href="/" accesskey="0">';
+    $buf .= qq(<a href="$docroot" accesskey="0"></a>);
+    $buf .= qq( - keitairc $version);
 
     $buf;
 }
 
 ################################################################
+# \e$B%A%c%M%kL>>N$rC;$+$/$9$k\e(B
 sub compact_channel_name{
     local($_) = shift;
+
+    # #name:*.jp \e$B$r\e(B %name \e$B$K\e(B
     if(s/:\*\.jp$//){
        s/^#/%/;
     }
+
+    # \e$BKvHx$NC1FH$N\e(B @ \e$B$O<h$k\e(B (for multicast.plm)
     s/\@$//;
+
     $_;
 }
 
@@ -284,23 +311,25 @@ sub on_web_request{
        $uri =~ s|^/||;
        my $channel = uri_unescape($uri);
 
-       $content .= '<title>' . $config->web_title . ': $channel</title>';
+       $content .= '<title>' . $config->web_title . ": $channel</title>";
        $content .= '<body>';
 
        $content .= '<a name="1"></a>';
        $content .= '<a accesskey="7" href="#1"></a>';
 
-       $content .= sprintf('<form action="/%s" method="post">', $uri);
+       $content .= sprintf('<form action="%s%s" method="post">',
+                           $docroot, $uri);
        $content .= '<input type="text" name="m" size="10">';
-       $content .= '<input type="submit" accesskey="1" value="&#63920;">';
+       $content .= '<input type="submit" accesskey="1" value="OK">';
+       # $content .= '<input type="submit" accesskey="1" value="&#63920;">';
        $content .= '</form>';
 
-       if(defined($channels{$channel})){
-           if(defined($buffer{$channel}) &&
-              length($buffer{$channel})){
-               $content .= '<a accesskey="8" href="/"></a>';
+       if(defined($channel_name{$channel})){
+           if(defined($channel_buffer{$channel}) &&
+              length($channel_buffer{$channel})){
+               $content .= qq(<a accesskey="8" href="$docroot"></a>);
                $content .= '<a accesskey="9" href="#2"></a>';
-               $content .= &render($buffer{$channel});
+               $content .= &render($channel_buffer{$channel});
                $content .= '<a name="2"></a>';
            }else{
                $content .= 'no message here yet';