#!/usr/local/bin/perl # chat v0.1 by 1999 Deihaz require 'jcode.pl'; # 設定 $title = 'Ｗｅｂチャット'; $homepage = 'http://www.biwa.ne.jp/~bighair/'; $max = 25; $method = 'POST'; $script = 'chat.cgi'; $logfile = 'chat.log'; # 設定終わり if ($ENV{'REQUEST_METHOD'} eq 'POST') { read(STDIN, $buffer, $ENV{'CONTENT_LENGTH'}); } else { $buffer = $ENV{'QUERY_STRING'}; } &decode; if ($form{'mode'} eq 'init') { &initform; } elsif ($form{'mode'} eq 'enter') { &msgform; } elsif (($form{'mode'} eq 'msg') and $form{'comment'}) { ®ist; } elsif ($form{'mode'} eq 'leave') { &finish; } &viewlog; sub initform { &header1; &header2; print <<"EOH";

$title

お名前（タグ可）

EOH exit; } sub msgform { ®ist('in'); &header1; print <<"EOH"; EOH &header2; print <<"EOH";

$title

台詞：
リロード：

EOH exit; } sub viewlog { open LOG, "$logfile" or &error('Logfile cannot be opened'); @lines = ; close LOG; &header1; if ($form{'reload'} != 0) { print qq(\n); } &header2; print qq(
リロード：); if ($form{'reload'} == 0) { print qq(手動); } else { print qq($form{'reload'}秒); } print qq(\n
\n); foreach $line (@lines) { ($date, $name, $comm) = split(/\"/, $line); print qq(［$name］ $comm \($date\)
\n); } print qq(\n\n); exit; } sub regist { ($sec, $min, $hour, $mday, $mon, $year) = localtime(time); $mon++; if ($hour < 10) { $hour= "0$hour"; } if ($min < 10) { $min = "0$min"; } if ($sec < 10) { $sec = "0$sec"; } $date = "$mon/$mday\ $hour:$min:$sec"; if ($_[0] eq 'in') { $form{'comment'} = "$form{'name'}さんが来ました"; $logname = '謎の声'; } elsif ($_[0] eq 'fin') { $form{'comment'} = "$form{'name'}さんは去りました"; $logname = '謎の声'; } else { $logname = "$form{'name'}"; } open LOG, "$logfile" or &error('Logfile cannot be opened'); @lines = ; close LOG; @newlines = @lines; unshift (@newlines, "$date\"$logname\"$form{'comment'}\"$ENV{'REMOTE_HOST'}\n"); if (@newlines > $max) { pop (@newlines); } open LOG, ">$logfile" or &error('Logfile cannot be written'); eval 'flock(LOG, 2);'; print LOG @newlines; close LOG; } sub finish { ®ist('fin'); &header1; &header2; print qq(

$form{'name'}さん、また来て下さい。

\n); print qq(

ホームページへ

\n); print qq(\n\n); exit; } sub header1 { print qq(Content-type: text/html\n\n); print qq(\n\n); } sub header2 { print qq(\n); print qq(\n); } sub decode { @pairs = split(/&/, $buffer); foreach $pair (@pairs) { ($name, $value) = split(/=/, $pair); $value =~ tr/+/ /; $value =~ s/%([a-fA-F0-9][a-fA-F0-9])/pack("C", hex($1))/eg; $value =~ s/\"//g; $value =~ s///g; $value =~ s///ig; $value =~ s///ig; $value =~ s///ig; $value =~ s///ig; $value =~ s///ig; $value =~ s///ig; $value =~ s/\r\n//g; $value =~ s/\r|\n//g; &jcode'convert(*value, 'sjis'); $form{$name} = $value; } if ($form{'name'} eq '') { $form{'name'} = '？？？'; } } sub error { &header1; &header2; print qq(

システムエラーが発生しました！

\n); print qq(

$_[0]

\n); print qq(\n\n); exit; }