#!/usr/local/bin/perl

# (c) 2001 Yasukazu Yokoi
# Date: 10/10/00

require 5.004;
use strict;
use vars qw(
$VERSION $param %param $chattitle $homeurl $maxlines
$bgcolor $textcolor $titlecolor $promptcolor $linkcolor
$vlinkcolor $alinkcolor
%colorlabels $defaultcolor %intervallabels $defaultinterval
%imagelabels $defaultimage $imageurl $iwidth $iheight
$chatprompt $abbrev
$usereadonlymembers $useimages
);
require 'jcode.pl';
use CGI::Carp qw(fatalsToBrowser);

( $VERSION ) = '$Revision: 1.21 $ ' =~ /\$Revision:\s+([^\s]+)/;

sub initialize_core_globals {
# タイトル
$chattitle = 'Yokochin\'s Chat Room';
# ホームページ
$homeurl = 'http://www.yokochin.com/';
# ログブックファイルの保存行数 (単位: 行)
$maxlines = 40;
# 背景色
$bgcolor = '#ffffff';
# 文字色
$textcolor = '#000000';
# タイトル文字色
$titlecolor = '#b00f0f';
# 入退室と日付の文字色
$promptcolor = '#80808';
# リンク文字色
$linkcolor = '#0000ff';
# リンク済の文字色
$vlinkcolor = '#000080';
# リンク中の文字色
$alinkcolor = '#ff0000';
# アイコン画像を表示(する 1, しない 0)
$useimages = 0;
# 参加者を表示(する 1, しない 0)
$usereadonlymembers = 1;
# 入退室行のプロンプト
$chatprompt = '■';
# CGIスクリプトの略称
$abbrev = 'yokchat';
}

sub initialize_color_globals {
# 文字色リスト
%colorlabels = (
'#000000' => '黒',
'#000080' => 'ネイビー',
'#0000cd' => '青',
'#008000' => '緑',
'#008080' => '青緑',
'#1e90ff' => '水色',
'#800000' => '栗色',
'#800080' => '紫',
'#808000' => 'オリーブ',
'#dc143c' => '赤',
'#ff6347' => 'オレンジ',
'#ff69b4' => 'ピンク',
);
# 文字色の初期値
$defaultcolor = '#000000';
}

sub initialize_interval_globals {
# リロード間隔リスト
%intervallabels = (
0 => '手動',
30 => '30秒',
60 => '60秒',
90 => '90秒',
);
# リロード間隔の初期値 (単位: 秒)
$defaultinterval = 60;
}

sub initialize_image_globals {
# アイコン画像リスト
%imagelabels = (
'chat0.gif' => 'にこにこ',
'chat1.gif' => 'あれあれ',
'chat2.gif' => 'ふふん',
'chat3.gif' => 'とほほ',
'chat4.gif' => 'おやおや',
'chat5.gif' => 'ふむふむ',
'chat6.gif' => 'へへん',
'chat7.gif' => 'ぷいぷい',
'chat8.gif' => 'むかむか',
);
# アイコン画像の初期値
$defaultimage = '';
# アイコン画像のURL
$imageurl = 'http://www.yokochin.com/chat/images/';
# アイコン画像の横幅(単位: ドット)
$iwidth = 24;
# アイコン画像の縦幅(単位: ドット)
$iheight = 24;
}

sub initialize_line_globals {
}

## Mainroutine

initialize_core_globals();
initialize_color_globals();
initialize_interval_globals();
initialize_image_globals() if $useimages;

set_parameters();

unless ($param) {
display_frameset();
exit 0;
}

reset_parameters();

if ($param{get}) {
display_logbook();
} elsif ($param{boot}) {
display_login();
} elsif ($param{put}) {
write_message() if $param{message} ne '';
display_logbook();
} elsif ($param{enter}) {
write_message();
display_prompt();
} elsif ($param{exit} or $param{delete}) {
write_message();
display_logout();
} elsif ($param{back}) {
display_redirect($homeurl);
} else {
display_frameset();
}

exit 0;

## Subroutines

# パラメータの読み込み
sub set_parameters {
my ($key, $val);

if (uc $ENV{'REQUEST_METHOD'} eq 'POST') {
read STDIN, $param, $ENV{'CONTENT_LENGTH'};
} else {
$param = $ENV{'QUERY_STRING'};
}

foreach my $pair (split /&/, $param) {
($key, $val) = split /=/, $pair;
$key = unescape($key);
$val = unescape($val);
jcode::convert(\$val, 'sjis', '', 'z');
$val =~ tr/ \n\r\t\f/ /s;
$param{$key} = $val;
}
}

# パラメータに初期値を代入
sub reset_parameters {
$param{name} = $ENV{'REMOTE_ADDR'} if $param{name} eq '';
$param{interval} = $defaultinterval if !$intervallabels{$param{interval}};
$param{color} = $defaultcolor if !$colorlabels{$param{color}};
if ($useimages) {
$param{image} = $defaultimage if !$imagelabels{$param{image}};
}
}

# クッキーを読み込んでパラメータに代入
sub retrieve_cookies {
my (%cookie, $key, $val);

foreach my $pair (split(/; ?/, $ENV{HTTP_COOKIE} || $ENV{COOKIE})) {
$pair =~ s/\s*(.*?)\s*/$1/;
($key, $val) = split /=/, $pair;

if ($key eq $abbrev) {
$key = unescape($key);
my @values = map unescape($_), split /&/, $val;

for (my $i = 0; $i < $#values; $i += 2) {
$cookie{$values[$i]} = $values[$i+1];
}
}
}

$param{name} = $cookie{name};
$param{interval} = $cookie{interval} if $intervallabels{$cookie{interval}};
$param{color} = $cookie{color} if $colorlabels{$cookie{color}};
if ($useimages) {
$param{image} = $cookie{image} if $imagelabels{$cookie{image}};
}
}

# パラメータをクッキーに代入して書き込み
sub create_cookies {
my (%cookie, @cookie);

$cookie{name} = $param{name};
$cookie{interval} = $param{interval};
$cookie{color} = $param{color};
$cookie{image} = $param{image} if $useimages;

while (my ($key, $val) = each %cookie) {
push @cookie, escape($key), escape($val);
}

my $path = $ENV{'SCRIPT_NAME'};
$path =~ s|/\w*\.cgi$|/|;

print "Set-Cookie: ", escape($abbrev), "=", join("&", @cookie), ";",
 " expires=", get_expires_date(30),
 " ; path=$path\n";
}

# 有効期限を取得
sub get_expires_date {
my $days = shift;

my @month = qw(Jan Feb Mar Apr May Jun Jul Aug Sep Oct Nov Dec);
my @week  = qw(Sun Mon Tue Wed Thu Fri Sat);

my ($sec, $min, $hour, $mday, $mon, $year, $wday) =
gmtime(time + $days*24*60*60);
$year += 1900;
return sprintf("%s, %02d-%s-%04d %02d:%02d GMT",
$week[$wday], $mday, $month[$mon], $year, $hour, $min);
}

# URI-デコード
sub unescape {
my $todecode = shift;

return undef unless defined $todecode;
$todecode =~ tr/+/ /;
$todecode =~ s/%([0-9a-fA-F]{2})/chr hex $1/eg;
return $todecode;
}

# URI-エンコード
sub escape {
my $toencode = shift;

return undef unless defined $toencode;
$toencode=~s/([^a-zA-Z_0-9.-])/uc sprintf "%%%02x", ord $1/eg;
return $toencode;
}

# HTML-エンコード
sub escapeHTML {
my $toencode = shift;

return undef unless defined $toencode;
$toencode =~ s/&/&amp;/gos;
$toencode =~ s/</&lt;/gos;
$toencode =~ s/>/&gt;/gos;
$toencode =~ s/"/&quot;/gos;
return $toencode;
}

# フレーム設定ページ
sub display_frameset {
print <<EOF;
Content-Type: text/html; charset=Shift_JIS

<!DOCTYPE HTML PUBLIC "-//W3C//DTD HTML 4.01 Frameset//EN"
"http://www.w3.org/TR/html4/frameset.dtd">
<html lang="ja"><head><title>$chattitle</title>
</head>
<frameset rows="96,4,*" frameborder="no" border=0>
<frame src="$abbrev.cgi?boot=on" name="frameinput" scrolling="no">
<frame name="dev" src="../chat/dev_b.html" scrolling="no">
<frame src="$abbrev.cgi?get=on" name="frameoutput">
<noframes>
<body bgcolor="$bgcolor" text="$textcolor" link="$linkcolor" vlink="$vlinkcolor" alink="$alinkcolor">
<h1 align="center"><font color="$titlecolor">$chattitle</font></h1>
<p><a href="${abbrev}i.cgi" target="_top" accesskey="1">(1)ｉモードチャットに入る．</a></p>
<p><a href="${abbrev}n.cgi" target="_top" accesskey="2">(2)フレームなしモードチャットに入る．</a></p>
</body>
</noframes>
</frameset>
</html>
EOF
}

# ログインページ
sub display_login {
print <<EOF;
Content-Type: text/html; charset=Shift_JIS

<!DOCTYPE HTML PUBLIC "-//W3C//DTD HTML 4.01 Transitional//EN">
<html lang="ja"><head><title>$chattitle</title>
EOF

retrieve_cookies();

print <<EOF;
</head>
<body background="../images/stars.jpg" text="$textcolor" bgcolor="$bgcolor" link="$linkcolor" vlink="$vlinkcolor" alink="$alinkcolor" leftmargin=0 topmargin=8 marginwidth=0 marginheight=8 onLoad="document.formlogin.name.focus();">
<center><img src="../images/logo_yok.gif" vspace=2><br><br>
<form method="post" action="$abbrev.cgi" name="formlogin" target="frameinput">
<input type="hidden" name="enter" value="on">
<font size=2 color=#dcdcdc><b>お名前　</b></font>
<input type="text" size=40 name="name" value="$param{name}">
<input type="submit" value="入 室">
EOF

print_interval_menu();
print_color_menu();
if ($useimages) {
print "<br>\n";
print_image_menu();
}
print "</form>\n";
print_end_html();
}

# プロンプトページ
sub display_prompt {
print <<EOF;
Content-Type: text/html; charset=Shift_JIS

<!DOCTYPE HTML PUBLIC "-//W3C//DTD HTML 4.01 Transitional//EN">
<html lang="ja"><head><title>$chattitle</title>
EOF

print <<EOF;
<script>
function autoclear() {
document.formprompt.message.value = "";
document.formprompt.message.focus();
}
</script>
</head>
<body background="../images/stars.jpg" text="$textcolor" bgcolor="$bgcolor" link="$linkcolor" vlink="$vlinkcolor" alink="$alinkcolor" leftmargin=0 topmargin=8 marginwidth=0 marginheight=8 onLoad="document.formprompt.message.focus();">
<center><img src="../images/logo_yok.gif" vspace=2>
<table><td align=right><form method="post" action="$abbrev.cgi" onSubmit="window.setTimeout('autoclear()',20);" name="formprompt" target="frameoutput">
<input type="hidden" name="put" value="on">
<input type="hidden" name="name" value="$param{name}">
<font size=2 color=#dcdcdc><b>発 言　</b></font>
<input type="text" size=60 name="message" value="">
<input type="submit" value="書き込み"><br>
<img src="../images/space2x2.gif" vspace=2><br>
EOF

print_interval_menu();
print_color_menu();
if ($useimages) {
print "<br>\n";
print_image_menu();
}
print "</form>\n";

print <<EOF;
</td><td valign=top><form method="post" action="$abbrev.cgi" target="frameinput">
<input type="hidden" name="exit" value="on">
<input type="hidden" name="name" value="$param{name}">
<input type="hidden" name="interval" value="$param{interval}">
<input type="hidden" name="color" value="$param{color}">
EOF

print <<EOF if $useimages;
<input type="hidden" name="image" value="$param{image}">
EOF

print <<EOF;
<input type="submit" value="退 室">
</form></td>
EOF

print <<EOF;
<td valign=top><form method="post" action="$abbrev.cgi" onSubmit="return confirm('発言を削除して退室しますか？');" target="frameinput">
<input type="hidden" name="delete" value="on">
<input type="hidden" name="name" value="$param{name}">
<input type="hidden" name="interval" value="$param{interval}">
<input type="hidden" name="color" value="$param{color}">
EOF

print <<EOF if $useimages;
<input type="hidden" name="image" value="$param{image}">
EOF

print <<EOF;
<input type="submit" value="削除と退室">
</form></td></table>
EOF

print_end_html();
}

# ログアウトページ
sub display_logout {
create_cookies();

print <<EOF;
Content-Type: text/html; charset=Shift_JIS

<!DOCTYPE HTML PUBLIC "-//W3C//DTD HTML 4.01 Transitional//EN">
<html lang="ja"><head><title>$chattitle</title></head>
<body background="../images/stars.jpg" text="$textcolor" bgcolor="$bgcolor" link="$linkcolor" vlink="$vlinkcolor" alink="$alinkcolor" leftmargin=0 topmargin=8 marginwidth=0 marginheight=8>
<center><img src="../images/logo_yok.gif" vspace=2><br>
<img src="../images/space2x2.gif" vspace=6><br>
<font size=3 color=#dcdcdc><b>ご利用いただき、ありがとうございました！</b></font><br>
<img src="../images/space2x2.gif" vspace=4><br>
<font size=1 color=#ffebcd>ホームページその他のページへの移動は下のナビゲーション･バーをご利用ください。</font>
EOF

print_end_html();
}

# ログブックページ
sub display_logbook {
my ($activemembers_ref, $readonlymembers_num) = command_members(0);
my $readlines_ref = command_logbook();

if ($param{interval}) {
print "Refresh: $param{interval}; URL=$abbrev.cgi";
if ($param{get}) {
print '?get=on';
} else {		# $param{put}
print '?put=on&name=', escape($param{name}), '&interval=',
$param{interval}, '&color=', escape($param{color});
print '&image=', $param{image} if $useimages;
}
print "\n";
}
print <<EOF;
Content-Type: text/html; charset=Shift_JIS

<!DOCTYPE HTML PUBLIC "-//W3C//DTD HTML 4.01 Transitional//EN">
<html lang="ja"><head><title>$chattitle</title>
</head><body background="../chat/images/marble31.jpg" text="$promptcolor" bgcolor="$bgcolor" link="$linkcolor" vlink="$vlinkcolor" alink="$alinkcolor">
EOF

print_members($activemembers_ref, $readonlymembers_num);
print_logbook($readlines_ref);
print_end_html();
}

# リダイレクションヘッダ
sub display_redirect {
my $page = shift;
command_members(1);
print <<EOF;
Status: 302 Moved
Location: $page

EOF
}

# リロード間隔リストの表示
sub print_interval_menu {
print "<font size=2 color=#dcdcdc><b>　　リロード間隔　</b></font>\n<select name=\"interval\">\n";
foreach my $key (sort { $a <=> $b } keys %intervallabels) {
print "<option";
print " selected" if $key eq $param{interval};
print " value=\"$key\">$intervallabels{$key}\n";
}
print "</select>\n";
}

# 文字色リストの表示
sub print_color_menu {
print "<font size=2 color=#dcdcdc><b>　　文字色　</b></font>\n<select name=\"color\">\n";
foreach my $key (sort keys %colorlabels) {
print "<option";
print " selected" if $key eq $param{color};
print " value=\"$key\">$colorlabels{$key}\n";
}
print "</select>\n";
}

# アイコン画像の表示
sub print_image_menu {
my ($i, $j) = 0;
my $k = scalar keys %imagelabels;
foreach my $key (sort keys %imagelabels) {
print_radio_group('image', $key);
print "<img src=\"$imageurl$key\" alt=\"$imagelabels{$key}\" width=\"$iwidth\" height=\"$iheight\" align=\"absbottom\">\n";
$j++;
last if $j == $k;
if ($i > 6) {
$i = 0;
print "<br>\n";
} else {
$i++;
}
}
}

# ラジオボタンの表示
sub print_radio_group {
my ($name, $value) = @_;
print "<input type=\"radio\" name=\"$name\"";
print " checked" if $value eq $param{$name};
print " value=\"$value\">\n";
}

# エンドタグの表示
sub print_end_html {
my $rcsrev = $VERSION || '0.0';
print <<EOF;
</center></body></html>
EOF
}

# 参加者の読み書き
sub command_members {
my $redirect = shift;
my (@activemembers, $readonlymembers);
my ($mtimerec, $maddr, $mname, $minterval, $mcolor, $mimage);
my $timenow = time;

open MEMBERS, "+<$abbrev.mem" or die "$abbrev.mem: $!";
flock MEMBERS, 2;
my @basemembers = <MEMBERS>;

my $oaddr = $ENV{'REMOTE_ADDR'};
$oaddr =~ s/\.\d+$//;

foreach my $line (@basemembers) {
chomp $line;
($mtimerec, $maddr, $mname, $minterval, $mcolor, $mimage) =
split /\t/, $line;

my $oname = $mname;
$oname =~ s/\.\d+$//;

if ($mtimerec <
($timenow - ($minterval || $defaultinterval || 60) * 1.5)
or $maddr eq $ENV{'REMOTE_ADDR'} or $mname eq $param{name}
or $oname eq $oaddr) {
undef $line;
next;
}

$line = "$line\n";
if ($mname ne $maddr) {
if ($useimages) {
$mimage ||= $defaultimage;
push(@activemembers, "<img src=\"$imageurl$mimage\" width=\"$iwidth\" height=\"$iheight\" align=\"absbottom\">\n<font color=\"$mcolor\">$mname</font>");
} else {
push(@activemembers, "<font color=\"$mcolor\">$mname</font>");
}
} else {
$readonlymembers++;
}
}

unless ($redirect) {
push(@basemembers,
join("\t", $timenow, $ENV{'REMOTE_ADDR'}, $param{name},
$param{interval}, $param{color}, $param{image}), "\n");
if ($param{name} ne $ENV{'REMOTE_ADDR'}) {
my $eHname = escapeHTML($param{name});
if ($useimages) {
push(@activemembers, "<img src=\"$imageurl$param{image}\" width=\"$iwidth\" height=\"$iheight\" align=\"absbottom\">\n<font color=\"$param{color}\">$eHname</font>");
} else {
push(@activemembers, "<font color=\"$param{color}\">$eHname</font>");
}
} else {
$readonlymembers++;
}
}

$readonlymembers = 0 unless $usereadonlymembers;

seek MEMBERS, 0, 0;
print MEMBERS @basemembers;
truncate MEMBERS, tell MEMBERS;
close MEMBERS;

\@activemembers, $readonlymembers unless $redirect;
}

# 参加者の表示
sub print_members {
my ($activemembers, $readonlymembers) = @_;

print "<blockquote><font size=2><font color=#b00f0f><b>【現在の参加者";
if (scalar @$activemembers) {
if (scalar @$activemembers + $readonlymembers > 1) {
print '： ', scalar(@$activemembers), "とルームメイトが\n";
print join(",\n", sort @$activemembers), "\n";
if ($param{put}) {
if ($readonlymembers > 1) {
print "$readonlymembers人】</b></font>";
} elsif ($readonlymembers == 1) {
print "： ルームメイトが1人】</b></font>";
}
}
} else {
print "： \n", $$activemembers[0];
print " 】</b></font>";
}
} else {
print "： なし】</b></font>";
}
print "<hr noshade>\n";
}

# ログの読み込み
sub command_logbook {
open LOGBOOK, "$abbrev.log" or die "$abbrev.log: $!";
my @readlines = <LOGBOOK>;
close LOGBOOK;

\@readlines;
}

# ログの表示
sub print_logbook {
my $readlines = shift;
my ($ldate, $laddr, $lname, $lmessage, $lcolor, $limage);

foreach my $line (@$readlines) {
chomp $line;
($ldate, $laddr, $lname, $lmessage, $lcolor, $limage) =
split /\t/, $line;
if ($lcolor) {
if ($useimages) {
$limage ||= $defaultimage;
print "<img src=\"$imageurl$limage\" width=\"$iwidth\" height=\"$iheight\" align=\"absbottom\">\n";
}
print "<font color=\"$lcolor\"><b>$lname </b><font size=1>【$ldate】</font><br>｢$lmessage｣</font>";
} else {
print "<b>$lname </b><font size=1>【$ldate】</font> $lmessage";
}
print "<hr noshade>\n";
}
}

# メッセージの書き込み
sub write_message {
my $insertline = join("\t", get_current_date(), $ENV{'REMOTE_ADDR'});
my $remote_host = $ENV{'REMOTE_HOST'} || $ENV{'REMOTE_ADDR'} || 'NULL';

if ($param{put}) {
$insertline = join("\t", $insertline, escapeHTML($param{name}),
escapeHTML($param{message}),
$param{color}, $param{image});
} elsif ($param{enter}) {
$insertline = join("\t", $insertline, $chatprompt,
join("<!-- at $remote_host -->", escapeHTML($param{name}), 'さんが入室しました。'));
} elsif ($param{exit}) {
$insertline = join("\t", $insertline, $chatprompt,
join("<!-- at $remote_host -->", escapeHTML($param{name}), 'さんが退室しました。'));
} else {			# $param{delete}
$insertline = join("\t", $insertline, $chatprompt,
join("<!-- at $remote_host -->", escapeHTML($param{name}), 'さんが発言を削除して退室しました。'));
}

open LOGBOOK, "+<$abbrev.log" or die "$abbrev.log: $!";
flock LOGBOOK, 2;
my @baselines = <LOGBOOK>;

if ($param{delete}) {
my ($ddate, $daddr, $dname, $dmessage, $dcolor, $dimage);
foreach my $line (@baselines) {
chomp $line;
($ddate, $daddr, $dname, $dmessage, $dcolor, $dimage) = split /\t/, $line;
if ($dname ne $chatprompt and ($daddr eq $ENV{'REMOTE_ADDR'}
or $dname eq $param{name})) {
undef $line;
next;
}
$line = "$line\n";
}
}

$#baselines = $maxlines - 2;
unshift @baselines, "$insertline\n";

seek LOGBOOK, 0, 0;
print LOGBOOK @baselines;
truncate LOGBOOK, tell LOGBOOK;
close LOGBOOK;
}

# 現在時刻の取得
sub get_current_date {
my ($sec, $min, $hour, $mday, $mon, $year, $wday, $yday, $isdst) =
localtime;

$wday = ('日', '月', '火', '水', '木', '金', '土')[$wday];
return sprintf("%02d月%02d日(%s) %02d時%02d分",
$mon+1, $mday, $wday, $hour, $min);
}

# end of yokchat.cgi