BBSの基本的な動作は、
１．普通にブラウザから呼び出されたとき（閲覧時）はログを表示する。
２．投稿があった場合は投稿記事の保存等の処理を行う。
の二つです。
多機能なBBSであれば、閲覧処理と投稿処理を別々のCGIに分けますが、簡易BBSなので一つのCGIで全ての処理を行います。
簡単なBBSとはいえ、クライアント（投稿者）の文字コードがShift_JISに限られていました。通常は、複数の日本語コードに対応するのが当然であり、「クエリ（入力情報）の取得」の項目に、他の文字コードをShift_JISに変換する処理を加えました。この処理がない場合、他の文字コードを使用するPCからの書き込みが文字化けします。
#!/usr/bin/perl
#------------------#
# 簡易一行掲示板 #
#------------------#
require "./jcode.pl";
#----------------#
# 初期変数設定 #
#----------------#
# 掲示板の名前
my $title = "Simple BBS";
# CSSファイルパス
my $css = "./style.css";
# ログファイル
my $logfile = "./logs.cgi";
# ロックファイル名
my $lockfile = "./lock";
# 記事の最大保存数
my $maxComment = 50;
#--------------#
# メイン処理 #
#--------------#
# クエリを取得する
my (%in) = &Get_Query;
# 出力するファイルタイプを記述
print "Content-type: text/html\n\n";
# サブルーチン「Header」を呼び出す
&Header($title, $css);
if ($in{'mode'} eq "send") {
# 書き込みがされた場合は保存ルーチンへ
$in{'lock'} = $lockfile;
$in{'logs'} = $logfile;
$in{'max'} = $maxComment;
&Reg_Data(%in);
} else {
# それ以外は記事の表示へ
&Main_Window($title, $logfile);
}
&Footer;
#--------------#
# メイン画面 #
#--------------#
sub Main_Window {
my ($title, $logfile) = @_;
# H1タグを使ってタイトルを記述
print "<h1>$title</h1>";
# サブルーチン「Comment_Form」を呼び出す
&Comment_Form;
# とりあえず線でも引いておく
print "<hr />\n";
# ログを展開して記事を表示する
&Draw_Column($logfile);
# 著作権表示も入れておく
&Copyright;
}
#--------------------------#
# HTMLヘッダーを記述する #
#--------------------------#
sub Header {
my ($title, $css) = @_;
print <<"EOF";
<?xml version="1.0" encoding="Shift_JIS"?>
<!DOCTYPE html PUBLIC "-//W3C//DTD XHTML 1.1//EN" "http://www.w3.org/TR/xhtml11/DTD/xhtml11.dtd">
<html xmlns="http://www.w3.org/1999/xhtml" xml:lang="ja">
<head>
EOF
if ($css) {
print "<link rel=\"stylesheet\" type=\"text/css\" href=\"$css\" \/>\n";
}
print <<"EOF";
<title>$title</title>
</head>
<body>
EOF
}
#--------------------------#
# HTMLフッターを記述する #
#--------------------------#
sub Footer {
print <<"EOF";
</body>
</html>
EOF
exit;
}
#--------------------------#
# 投稿フォームを作成する #
#--------------------------#
sub Comment_Form {
# Formタグのactionにはファイル名を記述
print <<"EOF";
<form action="./simplebbs.cgi" method="post">
<table class="FormTable" summary="Comment Form">
<tr>
<td>Name</td>
<td><input type="text" value="" name="writer" maxlength="12" size="20" tabindex="1" accesskey="n" class="Name" /></td>
</tr>
<tr>
<td>Message</td>
<td><input type="text" value="" name="message" maxlength="100" size="50" tabindex="2" accesskey="m" class="Mess" /></td>
</tr>
<tr>
<td colspan="2">
<input type="submit" value="Submit" tabindex="3" accesskey="s" class="Submit" />
<input type="hidden" value="send" name="mode" />
</td>
</tr>
</table>
</form>
EOF
}
#--------------#
# 記事の展開 #
#--------------#
sub Draw_Column {
my $logfile = $_[0];
my ($top, @logs, @temp);
# ログファイルを開く
open(FH, $logfile) or &error("Not Found Log File");
@logs = <FH>;
close(FH);
# 最初の一行は記事以外のデータなので退避させる
$top = shift(@logs);
# 記事の表示
foreach(@logs) {
# 記事を一件ずつ取り出して項目ごとに分割
@temp = split(/<>/);
print <<"EOF";
<table class="MessTable" summary="Message Table">
<tr>
<td colspan="3" class="Mess">$temp[1]</td>
</tr>
<tr>
<td class="Name">$temp[0]</td><td class="Time">$temp[2]</td><td class="IP">$temp[3]</td>
</tr>
</table>
<hr />
EOF
}
}
#--------------#
# 記事の保存 #
#--------------#
sub Reg_Data {
my (%in) = @_;
my ($comment, $top, $time, $Host, $i, @logs, @temp);
# 入力項目が未入力の際のエラー処理
if (!$in{'writer'} && !$in{'message'}) {
&error("名前が入力されていません<br />メッセージが入力されていません");
} else {
if (!$in{'writer'}) {
&error("名前が入力されていません");
} else {
if (!$in{'message'}) {
&error("メッセージが入力されていません");
}
}
}
# ログファイルを開く
open(FH, $in{'logs'}) or &error("Not Found Log File");
@logs = <FH>;
close(FH);
# 最初の一行は記事以外のデータを書き込むので退避させる
$top = shift(@logs);
@temp = split(/<>/, $top);
if ($temp[0] < $in{'max'}) {
$temp[0]++;
}
($Host, $temp[1]) = &Get_IP;
$time = &Get_Time;
$top = "$temp[0]<>$temp[1]<>\n";
$comment = "$in{'writer'}<>$in{'message'}<>$time<>$Host<>\n";
# 保存最大数を超えている場合は古い記事を削除
if (@logs >= $in{'max'}) {
pop(@logs);
}
# ログに投稿記事を追加する
unshift(@logs, $comment);
# ログに記事件数などのデータを追加する
unshift(@logs, $top);
# 簡易ファイルロック（mkdir方式）
&file_lock($in{'lock'});
# 記事の保存
open(FH, ">$in{'logs'}") or &error("Not Write Log Data");
print FH @logs;
close(FH);
&file_unlock($in{'lock'});
print <<"EOF";
<h1>Success!!</h1>
<p><a href="./simplebbs.cgi">掲示板へ戻る</a></p>
EOF
}
#--------------#
# 時間の取得 #
#--------------#
sub Get_Time {
my $ntime = time;
my ($sec, $min, $hour ,$mday, $mon, $year, $wday) = localtime($ntime);
# 西暦は1900年を0とするため1900を足す
$year += 1900;
# 取得した時間のフォーマット
my ($Date) = sprintf("%04d/%02d/%02d %02d:%02d:%02d", $year, $mon+1, $mday, $hour, $min, $sec);
return $Date;
}
#--------------------#
# IPアドレスの取得 #
#--------------------#
sub Get_IP {
my ($IP, $Host, $IPac);
// IPアドレスを取得
$IP = $ENV{'REMOTE_ADDR'};
// IPアドレスをホスト名に変換
$IPac = pack("C4", split(/\./, $IP));
$Host = gethostbyaddr($IPac, 2);
if (!$Host) {
$Host = $IP;
}
return ($Host, $IP);
}
#----------------------------#
# クエリ（入力情報）の取得 #
#----------------------------#
sub Get_Query {
my ($query, $key, $val, %in);
if ($ENV{'REQUEST_METHOD'} eq "POST") {
read(STDIN, $query, $ENV{'CONTENT_LENGTH'});
} else {
$query = $ENV{'QUERY_STRING'};
}
foreach (split(/\&/, $query)) {
($key, $val) = split(/=/);
$val =~ tr/+/ /;
$val =~ s/%([a-fA-F0-9][a-fA-F0-9])/pack("C", hex($1))/eg;
// 文字コードをShift_JISにコンバート
&jcode'convert(*val, "sjis");
$in{$key} = $val;
}
return %in;
}
#--------------#
# エラー処理 #
#--------------#
sub error {
my ($err) = $_[0];
print <<"EOF";
<h1>Error!!</h1>
<h2>$err</h2>
<p><a href="javascript:history.back()">戻る</a></p>
EOF
&Footer;
}
#------------------#
# ファイルロック #
#------------------#
sub file_lock {
my $lockfile = $_[0];
my ($ltime);
my $rep = 5;
if (-e $lockfile) {
$ltime = (stat($lockfile))[9];
if ($ltime < time - 60) {
&file_unlock($lockfile);
}
}
while (!mkdir($lockfile, 0755)) {
if (--$rep <= 0) {
&error("System Busy");
}
sleep(1);
}
}
sub file_unlock {
my $lockfile = $_[0];
rmdir($lockfile);
}
#--------------#
# 著作権表示 #
#--------------#
sub Copyright {
print <<"EOF";
<address>Copyright © 2004 Simple BBS</address>
EOF
}
*サーバーが落ちている場合が多々あります。