#!/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/&/&/gos; $toencode =~ s//>/gos; $toencode =~ s/"/"/gos; return $toencode; } # フレーム設定ページ sub display_frameset { print < $chattitle <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)iモードチャットに入る.</a></p> <p><a href="${abbrev}n.cgi" target="_top" accesskey="2">(2)フレームなしモードチャットに入る.</a></p> </body> EOF } # ログインページ sub display_login { print < $chattitle EOF retrieve_cookies(); print <


お名前  EOF print_interval_menu(); print_color_menu(); if ($useimages) { print "
\n"; print_image_menu(); } print "
\n"; print_end_html(); } # プロンプトページ sub display_prompt { print < $chattitle EOF print < function autoclear() { document.formprompt.message.value = ""; document.formprompt.message.focus(); }
EOF print <
EOF print < EOF print <
発 言 

EOF print_interval_menu(); print_color_menu(); if ($useimages) { print "
\n"; print_image_menu(); } print "
\n"; print <
EOF print < EOF print <
EOF print_end_html(); } # ログアウトページ sub display_logout { create_cookies(); print < $chattitle


ご利用いただき、ありがとうございました!

ホームページその他のページへの移動は下のナビゲーション・バーをご利用ください。 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 < $chattitle EOF print_members($activemembers_ref, $readonlymembers_num); print_logbook($readlines_ref); print_end_html(); } # リダイレクションヘッダ sub display_redirect { my $page = shift; command_members(1); print <  リロード間隔 \n\n"; } # 文字色リストの表示 sub print_color_menu { print "  文字色 \n\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 "\"$imagelabels{$key}\"\n"; $j++; last if $j == $k; if ($i > 6) { $i = 0; print "
\n"; } else { $i++; } } } # ラジオボタンの表示 sub print_radio_group { my ($name, $value) = @_; print "\n"; } # エンドタグの表示 sub print_end_html { my $rcsrev = $VERSION || '0.0'; print < 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 = ; 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, "\n$mname"); } else { push(@activemembers, "$mname"); } } 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, "\n$eHname"); } else { push(@activemembers, "$eHname"); } } 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 "
【現在の参加者"; 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人】"; } elsif ($readonlymembers == 1) { print ": ルームメイトが1人】"; } } } else { print ": \n", $$activemembers[0]; print " 】"; } } else { print ": なし】"; } print "
\n"; } # ログの読み込み sub command_logbook { open LOGBOOK, "$abbrev.log" or die "$abbrev.log: $!"; my @readlines = ; 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 "\n"; } print "$lname 【$ldate】
「$lmessage」
"; } else { print "$lname 【$ldate】 $lmessage"; } print "
\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("", escapeHTML($param{name}), 'さんが入室しました。')); } elsif ($param{exit}) { $insertline = join("\t", $insertline, $chatprompt, join("", escapeHTML($param{name}), 'さんが退室しました。')); } else { # $param{delete} $insertline = join("\t", $insertline, $chatprompt, join("", escapeHTML($param{name}), 'さんが発言を削除して退室しました。')); } open LOGBOOK, "+<$abbrev.log" or die "$abbrev.log: $!"; flock LOGBOOK, 2; my @baselines = ; 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