#!/usr/bin/perl -w

use DBI;
use CGI;
use Encode;

# MySQLのmy_dbデータベースのbbsテーブルの構成
# ---------------------------
# フィールド	属性
# id			INT NOT NULL AUTO_INCREMENT PRIMARY KEY
# name			VARCHAR(16) NOT NULL
# message		VARCHAR(200) NOT NULL
# date			TIMESTAMP(14)

# データベースの認証設定
# ---------------------------
my ($dsn, $user, $password);
$dsn = "DBI:mysql:my_db:localhost";
$user = "foo";
$password = "password";

# $nameと$messageの制限文字数
# ---------------------------
my ($max_name, $max_message);
$max_name = 16;
$max_message = 200;

# フォームから値を取り出す
# ---------------------------
my $cgi = new CGI;
my ($name, $message, $mode);
if ($cgi->param('mode')) {
	$mode = $cgi->param('mode');	# モード
	$name = $cgi->param('name');	# 名前欄の値
	$message = $cgi->param('message');	# メッセージ欄の値
}
else {
	$mode = "";
	$name = "";
	$message = "";
}

# 各モードの処理
# ---------------------------

# $modeが空ならば、一覧モード
if (!$mode) {
	&get_header;	# HTMLヘッダーを出力
	&get_form;		# 入力フォームを出力
	&get_db;		# DBから取得したデータをHTMLに生成して出力
	&get_footer;	# HTMLフッターを出力
}

# 確認モード
elsif ($mode eq "confirm") {
	&get_header;
	# 制限文字数とタグのチェック
	my $error_log = "";
	if (!&check_var(\$name, \$message, \$error_log)) {
		&get_confirm;	# 確認画面を出力
	}
	else {
		&get_error($error_log); # エラー表示を出力
		&get_form;
	}
	&get_footer;
}

# 修正モード
elsif ($mode eq "modify") {
	&get_header;
	my $error_log = "";
	if (!&check_var(\$name, \$message, \$error_log)) {
		&replace_br(\$message);	# エスケープされた<br />を改行に置換
		&get_form;
	}
	else {
		&get_error($error_log);
		&replace_br(\$message);
		&get_form;
	}
	&get_footer;
}

# 書き込みモード
elsif ($mode eq "write") {
	my $error_log = "";
	if (!&check_var(\$name, \$message, \$error_log)) {
		&write_db;
	}
	else {
		&get_header;
		&get_error($error_log);
		&get_footer;
	}
}

# 正常なモード以外のアクセス
else {
	&get_header;
	&get_error("<p>不正なアクセスです。</p>");
	&get_footer;
}

# サブルーチン
# ---------------------------

# 文字数制限とタグのエスケープ
sub check_var {
	my ($nm, $nm_restore, $msg, $msg_restore, $err_log, $err);
	$nm = $_[0]; # $nameのreference
	$msg = $_[1]; # $messageのreference
	$err_log = $_[2]; # $error_logのreference
	$nm_restore = $$nm;
	&restore_tag(\$nm_restore);
	$msg_restore = $$msg;
	&restore_tag(\$msg_restore);
	$nm_length = length(decode('utf-8', $nm_restore));
	$msg_length = length(decode('utf-8', $msg_restore));

	# $nameを処理する
	if ($nm_length == 0) {
		${$err_log} .= "<p>名前を記入してください。</p>\n";
		$err += 1;
	}
	elsif ($nm_length > $max_name) {
		${$err_log} .= "<p>名前が制限文字数を超えています。</p>\n";
		${$nm} = "";
		$err += 1;
	}
	else {
		&delete_crlf($nm); # 改行を許可しない
		&escape_tag($nm);
	}

	# $messageを処理する
	if ($msg_length == 0) {
		${$err_log} .= "<p>メッセージを記入してください。</p>\n";
		$err += 1;
	}
	elsif ($msg_length > $max_message) {
		${$err_log} .= "<p>メッセージが制限文字数を超えています。</p>\n";
		${$msg} = "";
		$err += 1;
	}
	else {
		&escape_tag($msg);
		&replace_crlf($msg);
	}
	return $err;
}

# &、<、>、"を実体参照に置換
sub escape_tag {
	my $var = $_[0]; # reference
	${$var} =~ s/&/&amp;/g;
	${$var} =~ s/</&lt;/g;
	${$var} =~ s/>/&gt;/g;
	${$var} =~ s/"/&quot;/g;
}

# 実体参照を元に戻す
sub restore_tag {
	my $var = $_[0]; # reference
	${$var} =~ s/&amp;/&/g;
	${$var} =~ s/&lt;/</g;
	${$var} =~ s/&gt;/>/g;
	${$var} =~ s/&quot;/"/g;
}

# 改行文字を<br />に置換
sub replace_crlf {
	my $var = $_[0]; # reference
	${$var} =~ s/\x0D\x0A/<br \/>/g;
	${$var} =~ s/\x0D/<br \/>/g;
	${$var} =~ s/\x0A/<br \/>/g;
}

# <br />だけをエスケープする際に使用
sub escape_br {
	my $var = $_[0]; # reference
	${$var} =~ s/<br \/>/&lt;br \/&gt;/g;
}

# ダブルクォートをエスケープ
sub escape_quote {
	my $var = $_[0]; # reference
	${$var} =~ s/"/\\"/g;
}

# バックスラッシュをエスケープ
sub escape_backslash {
	my $var = $_[0]; # reference
	${$var} =~ s/\\/\\\\/g;
}

# エスケープされた<br />を元に戻す
sub restore_br {
	my $var = $_[0]; # reference
	${$var} =~ s/&lt;br \/&gt;/<br \/>/g;
}

# エスケープされた<br />を改行文字に置換
sub replace_br {
	my $var = $_[0]; # reference
	${$var} =~ s/&lt;br \/&gt;/\n/g;
}

# 改行文字を除去
sub delete_crlf {
	my $var = $_[0]; # reference
	${$var} =~ s/\x0D\x0A//g;
	${$var} =~ s/\x0D//g;
	${$var} =~ s/\x0A//g;
}

# フォームのHTMLを出力
sub get_form {
	print <<"HTML";
<div class="section">
<form action="/bbs/bbs.pl" method="POST">
<fieldset>
<table>
	<tr>
		<td class="right">Name</td>
		<td><input id="name" name="name" type="text" maxlength="$max_name" value="$name" /></td>
	</tr>
	<tr>
		<td class="right">Message</td>
		<td><textarea id="message" name="message" maxlength="$max_message">$message</textarea></td>
	</tr>
	<tr>
		<td colspan="2" class="right"><input type="submit" value="Check" /></td>
	</tr>
</table>
<input type="hidden" name="mode" value="confirm" />
</fieldset>
</form>
</div>

HTML
}

# 確認画面のHTMLを出力
sub get_confirm {
	my ($name_value, $message_value);
	$name_value = $name;
	$message_value = $message;
	&escape_br(\$message_value);

	print <<"HTML";
<div class="section">
<h2>確認</h2>

<p>以下の内容でよろしいでしょうか？</p>

<form action="/bbs/bbs.pl" method="POST">
<input type="submit" value="Modify" /> <input type="button" value="Cancel" onclick="location.href='/bbs/bbs.pl'" />
<input type="hidden" name="name" value="$name_value" />
<input type="hidden" name="message" value="$message_value" />
<input type="hidden" name="mode" value="modify" />
</form>

<form action="/bbs/bbs.pl" method="POST">
<input type="submit" value="Post" />
<input type="hidden" name="name" value="$name_value" />
<input type="hidden" name="message" value="$message_value" />
<input type="hidden" name="mode" value="write" />
</form>
</div>

<div class="section">
<h2>$name</h2>

<p>$message</p>
</div>

HTML
}

# データベースへの書き込み
sub write_db  {
	my $dbh = DBI->connect($dsn, $user, $password);
	if (!$dbh) {
		&get_error("<p>データベースに接続できません。</p>");
		return;
	}

	&restore_tag(\$name);
	&escape_backslash(\$name);
	&escape_quote(\$name);
	&replace_br(\$message);
	&restore_tag(\$message);
	&escape_backslash(\$message);
	&escape_quote(\$message);

	$dbh->do("SET NAMES utf8");
	my $query = "INSERT INTO bbs SET name=\"" . $name . "\", message=\"" . $message . "\"";
	$dbh->do($query);
	$dbh->disconnect();
	print $cgi->redirect('/bbs/bbs.pl');
}

# データベースからの読み出し
sub get_db {
	my $dbh = DBI->connect($dsn, $user, $password);
	if (!$dbh) {
		&get_error("<p>データベースに接続できません。</p>");
		return;
	}
	my $rows = $dbh->selectrow_array("SELECT COUNT(*) FROM bbs");
	if(!$rows) {
		&get_error("<p>データベースが空です。</p>");
		return;
	}
	else {
		$dbh->do("SET NAMES utf8");
		my ($query, $sth, @row);
		$query = "SELECT id, name, message, date FROM bbs ORDER BY id DESC";
		$sth = $dbh->prepare($query);
		$sth->execute();
		while(@row = $sth->fetchrow_array) {
		my ($name, $message, $date);
		$name = $row[1];
		$message = $row[2];
		$date = $row[3];

		&escape_tag(\$name);
		&escape_tag(\$message);
		&replace_crlf(\$message);

		print <<"HTML";
<div class="section">
<h2>$name</h2>

<p>$message</p>

<address>$date</address>
</div>

HTML
		}
		$sth->finish();
	}
	$dbh->disconnect();
}

# エラー表示用のHTMLを出力
sub get_error {
	print <<"HTML"
<div class="section">
<h2 class="error">エラー</h2>

$_[0]
</div>

HTML
}

# HTMLヘッダーを出力
sub get_header {
	print <<"HTML";
Content-Type:text/html

<?xml version="1.0" encoding="utf-8"?>
<!DOCTYPE html
	PUBLIC "-//W3C//DTD XHTML 1.0 Strict//EN"
	"http://www.w3.org/TR/xhtml1/DTD/xhtml1-strict.dtd">
<html xmlns="http://www.w3.org/1999/xhtml" xml:lang="ja" lang="ja">
<head>
<meta http-equiv="Content-Type" content="text/html; charset=UTF-8" />
<meta name="keywords" content="BBS" />
<meta name="description" content="掲示板" />
<meta name="robots" content="noarchive" />
<link href="/css/main.css" type="text/css" rel="stylesheet" />
<link href="/bbs/css/bbs.css" type="text/css" rel="stylesheet" />
<script src="/js/main.js" type="text/javascript"></script>
<title>Poturi : BBS</title>
</head>

<body>
<h1><img alt="Poturi" src="/img/logo.gif" width="47px" height="15px" /></h1>

<ul id="nav" class="clearfix">
<li><a href="/">Home</a></li>
<li><a href="/stylesheet/">CSS</a></li>
<li><a href="/javascript/">JavaScript</a></li>
<li><a href="/perl/">Perl</a></li>
<li><a href="/mysql/">MySQL</a></li>
<li><a href="/svg/">SVG</a></li>
<li><strong><a href="/bbs/bbs.pl">BBS</a></strong></li>
</ul>

HTML
}

# HTMLフッターを出力
sub get_footer {
	print <<"HTML";
<address class="footer">
Copyright &copy; 2007 Poturi All rights reserved.<br />
Email: <a href="mailto:admin\@poturi.net">admin\@poturi.net</a>
</address>

<script src="http://www.google-analytics.com/urchin.js" type="text/javascript">
</script>
<script type="text/javascript">
_uacct = "UA-2139084-1";
urchinTracker();
</script>
</body>
</html>
HTML
}