#!/usr/bin/perl
# keitairc
-# $Id: keitairc,v 1.4 2004-03-21 11:01:50 morimoto Exp $
+# $Id: keitairc,v 1.16 2004-03-23 16:12:56 ishikawa Exp $
#
# Copyright (c) 2003 Jun Morimoto <morimoto@xantia.citroen.org>
# This program is covered by the GNU General Public License 2
# Depends: libjcode-pm-perl, libpoe-component-irc-perl,
# liburi-perl, libwww-perl, libappconfig-perl
+my $rcsid = q$Id: keitairc,v 1.16 2004-03-23 16:12:56 ishikawa Exp $;
+my ($version) = $rcsid =~ m#,v ([0-9.]+)#;
+
use strict;
use Jcode;
use POE;
use POE::Component::Server::TCP;
-use POE::Component::IRC;
use POE::Filter::HTTPD;
+use POE::Component::IRC;
use URI::Escape;
use HTTP::Response;
use AppConfig qw(:argcount);
},
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)
);
$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, %channel_recent);
+
+# \e$B3F%A%c%M%k$N:G=*%"%/%;%9;~9o!":G?7H/8@;~9o\e(B
+my %mtime;
+
+# unread lines
+my %unread;
+
+# chk
+my ($send_chk, $update_chk);
# irc component
POE::Component::IRC->new('keitairc');
################################################################
sub on_irc_join{
my ($kernel, $who, $channel) = @_[KERNEL, ARG0, ARG1];
- $channel = Jcode->new($channel)->euc;
- $channels{$channel}++;
+ $channel_name{$channel}++;
}
################################################################
sub on_irc_part{
my ($kernel, $who, $channel) = @_[KERNEL, ARG0, ARG1];
+ $who =~ s/!.*//;
# chop off after the gap (bug workaround of POE::Filter::IRC)
$channel =~ s/ .*//;
- $channel = Jcode->new($channel)->euc;
- delete $channels{$channel};
+ if ($who eq $config->irc_nick) {
+ delete $channel_name{$channel};
+ } else {
+ &add_message($channel, 'SYSOP', $who . ' leaves');
+ }
}
################################################################
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);
}
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);
}
sub add_message{
my($channel, $who, $msg) = @_;
- $channel = Jcode->new($channel)->euc;
+ my $message = sprintf('%s %s> %s', &now, $who, $msg);
+
+ my @tmp = split("\n", $channel_buffer{$channel});
+ push @tmp, $message;
- my @tmp = split("\n", $buffer{$channel});
- push @tmp, sprintf('%s %s> %s', &now, $who, $msg);
+ my @tmp2 = split("\n", $channel_recent{$channel});
+ push @tmp2, $message;
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);
+ }
+
+ if(@tmp2 > $config->web_lines){
+ $channel_recent{$channel} =
+ join("\n", splice(@tmp2, -$config->web_lines));
+ }else{
+ $channel_recent{$channel} = join("\n", @tmp2);
}
$mtime{$channel} = time;
+
+ # unread lines
+ $unread{$channel} = @tmp2;
+
+ if ($unread{$channel} > $config->web_lines) {
+ $unread{$channel} = $config->web_lines;
+ }
}
################################################################
}
################################################################
+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})){
- $buf .= &compact_channel_name($channel);
- }else{
- if($accesskey < 10){
- $buf .= sprintf('<a accesskey="%1d" href="/%s">%s</a>',
- $accesskey,
+ if($accesskey < 10){
+ $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>',
+ }else{
+ $buf .= sprintf('<a href="%s%s">%s</a>',
+ $docroot,
uri_escape($channel),
&compact_channel_name($channel));
- }
}
$accesskey++;
- if($atime{$channel} < $mtime{$channel}){
- $buf .= '*';
+ # \e$BL$FI9T?t\e(B
+ if($unread{$channel} > 0){
+ $buf .= sprintf(' <a href="%s%s.update">%d</a>',
+ $docroot,
+ uri_escape($channel),
+ $unread{$channel});
}
-
$buf .= '<br>';
}
- $buf .= '<a href="/" accesskey="0">';
-
+ $buf .= qq(0 <a href="$docroot" accesskey="0">refresh list</a><br>);
+ $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/\@$//;
+
$_;
}
my $uri = $request->uri;
my $content = '<html><head>';
+ $content .= '<meta http-equiv="Cache-Control" content="max-age=0" />';
# POST \e$B$5$l$F$-$?$b$N$OH/8@\e(B
if($request->method =~ /POST/i){
'privmsg',
Jcode->new($channel)->jis,
Jcode->new($message)->jis);
- &add_message($channel, $config->irc_nick, $message);
+ &add_message($channel, $config->irc_nick,
+ Jcode->new($message)->euc);
+
+ # set flag for "send message"
+ $send_chk = 1;
}
}
if($uri eq '/'){
$content .= '<title>' . $config->web_title . '</title>';
+ $content .= '</head>';
$content .= '<body>';
$content .= &index_page;
}else{
$uri =~ s|^/||;
+
+ $update_chk = ($uri =~ /.*.update/);
+ if ($update_chk eq 1) {
+ $uri =~ s/.update//;
+ }
+
my $channel = uri_unescape($uri);
- $content .= '<title>' . $config->web_title . ': $channel</title>';
+ $content .= '<title>' . $config->web_title . ": $channel</title>";
+ $content .= '</head>';
$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="聆">';
+ $content .= '<input type="submit" accesskey="1" value="OK[1]">';
+ $content .= qq(<a accesskey="8" href="$docroot">back[8]</a><br>);
+ # $content .= '<input type="submit" accesskey="1" value="聆">';
$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 .= '<a accesskey="9" href="#2"></a>';
- $content .= &render($buffer{$channel});
+ if (($update_chk eq 1)||($send_chk eq 1)) {
+ $content .= &render($channel_recent{$channel});
+ $content .= sprintf('<a accesskey="5" href="%s%s">
+ ..more[5]</a>', $docroot, uri_escape($channel));
+ } else {
+ $content .= &render($channel_buffer{$channel});
+ }
$content .= '<a name="2"></a>';
}else{
$content .= 'no message here yet';
$content .= "no such channel";
}
- $atime{$channel} = time;
+ # clear check flags
+ $send_chk = 0;
+
+ # clear unread counter
+ $unread{$channel} = 0;
+
+ # clear recent messages buffer
+ $channel_recent{$channel} = '';
}
$content .= '</body></html>';
OSDN Git Service
