#!/usr/local/bin/perl

########## 設置方法 ##########
# まずダウンロードした「diary.txt（このファイル）」の拡張子を.cgiに変更し、
# １行目のPerlのパスをプロバイダに合わせて書き換える。
# そして、下にある各種設定項目を設定する。
# てゆうか最初は設定を変更せずに設置してみて、動作を確認する事を
# おすすめするなあと思った。
# 
# 設定項目は最低限パスワードぐらいは変更したほうがいいなあと思った。
# 
# 設定の変更は、それぞれ
# $pref{'xxx'} = 'yyyyy';
# のyyyyyの部分を好みに応じて書き換える感じで。
# yyyyyが「'」で囲まれているものは「'」で消したらダメであり、
# さらにその内部に「'」を使用したい場合は「\'」としねえとダメとす。
# あと「'」で囲まれていない設定項目は、半角数字（全角は却下）しか使用不可とす。
# 
# 以下のファイルを適当なディレクトリ（パーミッションは777あるいは755か701）にアップロード。
# diary.cgi [755 or 700]
# jcode.pl [644 or 600]
# （[]内はパーミッション。）
# これでだいたいオッケーと言えましょう。
########## 設置方法ここまで ##########

########## 設定 ##########
my %pref = ();

### 基本設定
# 管理者モード用パスワード
$pref{'password'} = 'sairen';

# １ページの表示数
$pref{'page_max'} = 1;

# データ保存数（0に設定するとすべてのデータを保存し続けると思った。）
$pref{'data_max'} = 0;

# レス機能 [0: オフ, 1: オン]
$pref{'res'} = 0;

# タイトル（ブラウザのタイトルバーの表示）
$pref{'title'} = 'pict';

# 見出し（タグ使用可能）
$pref{'title_str'} = '<font size="-1"><B>* pict</B></font>';

# ホームページアドレス（右肩）
$pref{'home_url'} = 'http://kawaii-nekochan.com/';

# ホームページリンク文字列（右肩）
$pref{'home_str'} = 'kawaii-nekochan.comにもどる';

# 新規投稿ボタン文字列
$pref{'button_new'} = '新規投稿';

# レス投稿ボタン文字列
$pref{'button_res'} = 'レス';

# リモートホスト表示 [0: 非表示, 1: コメント内表示]
$pref{'remote_host'} = 0;

# ブラウザ情報表示 [0: 非表示, 1: コメント内表示]
$pref{'user_agent'} = 0;


### レイアウト
# 全体の横幅
$pref{'width'} = 580;
# 枠とテキストの間の余白
$pref{'space'} = 0;


### 色（#ffffffの形式でもwhiteというような名前指定でもヲウケイ）
# 背景（BODYタグ要素）
$pref{'color_bgcolor'} = '#ffffff';
# テキスト（BODYタグ要素）
$pref{'color_bodytext'} = '#999999';
# リンク（BODYタグ要素）
$pref{'color_link'} = '#33cce9';
# 訪問済みリンク（BODYタグ要素）
$pref{'color_vlink'} = '#3399cc';
# アクティブなリンク（BODYタグ要素）
$pref{'color_alink'} = '#ffffff';
# 枠
$pref{'color_table'} = '#ffffff';
# タイトル、投稿者名、フォームラベル等
$pref{'color_subject'} = '#e9e9e9';
# 注釈
$pref{'color_note'} = '#ffffff';
# 本文
$pref{'color_text'} = '#999999';
# レス（奇数行）
$pref{'color_res_odd'} = '#999999';
# レス（偶数行）
$pref{'color_res_even'} = '#ffffff';


### 許可タグリスト
$pref{'tags'} = ['A', 'B', 'FONT', 'IMG', ];


### URL自動認識 [0: オフ, 1: オン]
$pref{'auto_url'} = 1;
# 文中のURLやメールアドレスを自動で認識して<A>タグを付加する機能であり割と便利。


### 上級者向け（割とCGIとかに詳しいヒトは割といじったりすればいいです。）
# jcode.plのパスおよびファイル名
$pref{'jcode'} = './jcode.pl';

# このファイルのファイル名
$pref{'this_file'} = 'diary.cgi';

# ログファイル等が保存されるディレクトリのパス
$pref{'file_path'} = './data/';


########## 設定ここまで ##########
# ここより下でも、自信があれば好きなように改造していけばいいなあと思った。
# 改造したら拙者にメール（kataribe@zannnenempire.com）か、あるいは
# 残念帝国CGIコーナーの掲示板に書き込むなどして知らせると
# とてもナイスだと思った。
# あと、出来たら右下の残念帝国へのリンクは消さねいでほしいなあと思った。

########## MAIN ##########

### 前処理
-r $pref{'jcode'} or &error('jcode.plが読み込めません。');

umask 000;
-d $pref{'file_path'} or mkdir($pref{'file_path'}, 0777) or &error('設置ディレクトリのパーミッションを777に変更して下さい。');

# 変数宣言
my %input = ();
my %output = ();
my %cookie = ();
my %query = ();
my $now = time;

&get_cookie;
&get_query;

my $action = &set_query("./$pref{'this_file'}", \%query);

### メイン分岐
if ($ENV{'REQUEST_METHOD'} eq 'POST') {
	&decode;
	if ($input{'mode'} eq 'new') {&register(0);}
	if ($input{'mode'} eq 'res') {&register(1);}
	if ($input{'mode'} eq 'login') {&login;}
	if ($input{'mode'} eq 'edit') {&edit;}
	if ($input{'mode'} eq 'delete') {&delete;}
} else {
	&list;
}

########## SUB ##########

sub list {
	%output = %cookie;
	&html_list;
}

sub register {
	my $mode = shift;
	
	### タグ関連処理
	foreach (keys %input) {
		if (!$mode and $_ eq 'content') {
			&tag_filter(\$input{$_}, $pref{'tags'}, '<BR>');
		} else {
			&tag_filter(\$input{$_});
		}
	}
	if ($pref{'auto_url'}) {&url_filter(\$input{'content'});}
	
	### 入力チェック
	if ($mode) {
		foreach ('name', 'content') {
			if (!$input{$_}) {
				&error('name, contentはすべて記入してください。');
			}
		}
	} else {
		if ($cookie{'password'} ne $pref{'password'}) {&error('不正アクセス');}
		foreach ('subject', 'content') {
			if (!$input{$_}) {
				&error('subject, contentはすべて記入してください。');
			}
		}
	}
	
	### ロック
	&lock('LOCK', "$pref{'file_path'}lock");
	
	### 二重投稿チェック
	open(RECENT, "$pref{'file_path'}recent");
	my @recent = <RECENT>;
	close(RECENT);
	foreach (0 .. $#recent) {
		my $recent = $recent[$_];
		chomp $recent;
		my %data = split(/<>/, $recent, -1);
		if ($data{'content'} eq $input{'content'} and $data{'remote_host'} eq $ENV{'REMOTE_HOST'}) {
			%output = %cookie;
			&html_list;
		}
	}
	
	my $no = '';
	if ($mode) {
		$no = $input{'no'};
	} else {
		### 新番号取得
		open(LIST, "$pref{'file_path'}list");
		my @list = <LIST>;
		close(LIST);
		if (scalar(@list)) {
			chomp $list[-1];
			$no = (split(/,/, $list[-1]))[0] + 1;
		} else {
			$no = 1;
		}
	}
	
	### 書き込みデータ作成
	my %data_new = ();
	if ($mode) {$data_new{'name'} = $input{'name'};}
	if (!$mode) {$data_new{'subject'} = $input{'subject'};}
	$data_new{'content'} = $input{'content'};
	$data_new{'date'} = $now;
	$data_new{'remote_host'} = $ENV{'REMOTE_HOST'};
	$data_new{'user_agent'} = $ENV{'HTTP_USER_AGENT'};
	my $data_new = join("<>", %data_new);
	
	### データ書き込み
	# $no汚染解除
	$no =~ /^(\d+)$/ or die "no is not num ($no)";
	$no = $1;
	open(DATA, ">> $pref{'file_path'}$no");
	print DATA $data_new, "\n";
	close(DATA);
	
	### list更新
	if ($mode) {
		open(LIST, "$pref{'file_path'}list");
		my @list = <LIST>;
		close(LIST);
		foreach (0 .. $#list) {
			my $line = $list[$_];
			chomp $line;
			my ($n, $date, $date_res) = split(/,/, $line);
			if ($n == $no) {
				$list[$_] = qq($n,$date,$now\n);
				last;
			}
		}
		if ($pref{'data_max'}) {
			while (scalar(@list) > $pref{'data_max'}) {
				my $line = shift(@list);
				chomp $line;
				my ($n, $date, $date_res) = split(/,/, $line);
				unlink("$pref{'file_path'}$n");
			}
		}
		open(LIST, "> $pref{'file_path'}list");
		print LIST @list;
		close(LIST);
	} else {
		open(LIST, "$pref{'file_path'}list");
		my @list = <LIST>;
		close(LIST);
		push(@list, qq($no,$now,$now\n));
		if ($pref{'data_max'}) {
			while (scalar(@list) > $pref{'data_max'}) {
				my $line = shift(@list);
				chomp $line;
				my ($n, $date, $date_res) = split(/,/, $line);
				unlink("$pref{'file_path'}$n");
			}
		}
		open(LIST, "> $pref{'file_path'}list");
		print LIST @list;
		close(LIST);
	}
	
	### recent更新
	my %recent_new = ();
	$recent_new{'content'} = $input{'content'};
	$recent_new{'remote_host'} = $ENV{'REMOTE_HOST'};
	my $recent_new = join("<>", %recent_new);
	push(@recent, qq($recent_new\n));
	while (scalar(@recent) > 5) {shift(@recent);}
	open(RECENT, "> $pref{'file_path'}recent");
	print RECENT @recent;
	close(RECENT);
	
	### Cookie
	if ($mode) {&set_cookie('name', $input{'name'}, 30); $cookie{'name'} = $input{'name'};}
	
	### 表示
	&list;
}

sub login {
	### パスワードクッキー一時発行
	&set_cookie('password', $input{'password'});
	$cookie{'password'} = $input{'password'};
	&list;
}

sub edit {
	if ($cookie{'password'} ne $pref{'password'}) {&error('不正アクセス');}
	if (!$input{'content'} or !$input{'subject'}) {
		%output = %input;
		&html_edit;
	}
	
	### タグ関連処理
	&tag_filter(\$input{'subject'});
	&tag_filter(\$input{'content'}, $pref{'tags'}, '<BR>');
	if ($pref{'auto_url'}) {&url_filter(\$input{'content'});}
	
	&lock('LOCK', "$pref{'file_path'}lock");
	
	# $no汚染解除
	my $no = $input{no};
	$no =~ /^(\d+)$/ or die "no is not num ($no)";
	$no = $1;
	
	open(DATA, "$pref{'file_path'}$no");
	my @data = <DATA>;
	close(DATA);
	
	chomp $data[0];
	my %data = split(/<>/, $data[0], -1);
	$data{'subject'} = $input{'subject'};
	$data{'content'} = $input{'content'};
	my $data = join("<>", %data);
	
	$data[0] = qq($data\n);
	
	open(DATA, "> $pref{'file_path'}$no");
	print DATA @data;
	close(DATA);
	
	&unlock('LOCK');
	
	&list;
}

sub delete {
	if ($cookie{'password'} ne $pref{'password'}) {&error('不正アクセス');}
	
	&lock('LOCK', "$pref{'file_path'}lock");
	
	my $no = $input{no};
	
	# $no汚染解除
	$no =~ /^(\d+)$/ or die "no is not num ($no)";
	$no = $1;
	
	if ($input{'res_no'}) { # レス削除
		open(DATA, "$pref{'file_path'}$no");
		my @data = <DATA>;
		close(DATA);
		
		if ($#data >= $input{'res_no'}) {splice(@data, $input{'res_no'}, 1);}
		
		open(DATA, "> $pref{'file_path'}$no");
		print DATA @data;
		close(DATA);
	} else { # 日記削除
		unlink("$pref{'file_path'}$no");
		# list更新
		open(LIST, "$pref{'file_path'}list");
		my @list = <LIST>;
		close(LIST);
		foreach (0 .. $#list) {
			my $line = $list[$_];
			chomp $line;
			my ($n, $date, $date_res) = split(/,/, $line);
			if ($n == $input{'no'}) {
				splice(@list, $_, 1);
				last;
			}
		}
		if ($pref{'data_max'}) {
			while (scalar(@list) > $pref{'data_max'}) {
				my $line = shift(@list);
				chomp $line;
				my ($n, $date, $date_res) = split(/,/, $line);
				unlink("$pref{'file_path'}$n");
			}
		}
		open(LIST, "> $pref{'file_path'}list");
		print LIST @list;
		close(LIST);
	}
	
	&unlock('LOCK');
	
	&list;
}

########## HTML ##########

sub html_list {
	if ($query{'mode'} eq 'admin') {
		if ($cookie{'password'} ne $pref{'password'}) {&html_login;}
	}
	
	&html_head;
	
	### ロック
	&lock('LOCK', "$pref{'file_path'}lock");
	
	### リスト読み込み
	open(LIST, "$pref{'file_path'}list");
	my @list_all = <LIST>;
	close(LIST);
	foreach (@list_all) {chomp;}
	
	### リスト並べ替え
	if ($query{'sort'} eq 'update') {
		@list_all = sort {(split(/,/, $b))[2] <=> (split(/,/, $a))[2]} @list_all;
	} else {
		@list_all = sort {(split(/,/, $b))[1] <=> (split(/,/, $a))[1]} @list_all;
	}
	
	### リスト分割
	my @list = ();
	while (scalar(@list_all)) {
		push(@list, [splice(@list_all, 0, $pref{'page_max'})]);
	}
	
	
	
	### メインパネル表示
	print <<"_HTML_";
<TABLE BORDER="0" CELLPADDING="12" CELLSPACING="0" BGCOLOR="$pref{'color_table'}" WIDTH="$pref{'width'}">
_HTML_
	
	# メインメニュー
	$main_menu = '';
	if ($query{'mode'} eq 'admin') {
		my %query_to_user = %query;
		delete $query_to_user{'mode'};
		my $to_user = &set_query("./$pref{'this_file'}", \%query_to_user);
		$main_menu = qq(| <A HREF="$to_user">一般ユーザモード</A> );
	} else {
		my %query_to_admin = %query;
		$query_to_admin{'mode'} = 'admin';
		my $to_admin = &set_query("./$pref{'this_file'}", \%query_to_admin);
		$main_menu = qq(| <A HREF="$to_admin">Ｘ</A> );
	}
	print <<"_HTML_";
<TR><TD ALIGN="right" COLSPAN="3"><FONT COLOR="$pref{'color_subject'}" SIZE="-1">$main_menu| <A HREF="$pref{'home_url'}">$pref{'home_str'}</A> |</FONT></TD></TR>
_HTML_
	
	# メインブロック開始
	print <<"_HTML_";
<TR><TD WIDTH="10%"><BR></TD><TD WIDTH="80%">
<TABLE BORDER="0" CELLPADDING="0" CELLSPACING="0">
_HTML_
	
	# タイトル
	print <<"_HTML_";
<TR><TD COLSPAN="2"><FONT COLOR="$pref{'color_subject'}">$pref{'title_str'}</FONT></TD></TR>
<TR><TD COLSPAN="2"><BR></TD></TR>
_HTML_
	
	# フォーム
	if ($query{'mode'} eq 'admin') {
		my $tag_str = '使用可能タグ: ';
		if (scalar(@{$pref{'tags'}})) {
			my @tags = ();
			foreach (@{$pref{'tags'}}) {
				push(@tags, qq(&lt;$_&gt;));
			}
			$tag_str .= join(', ', @tags);
		} else {
			$tag_str .= '無し'
		}
		
		my %query_action_new = %query;
		delete $query_action_new{'page'};
		my $action_new = &set_query("./$pref{'this_file'}", \%query_action_new);
		
		print <<"_HTML_";
<FORM ACTION="$action_new" METHOD="POST">
<INPUT TYPE="hidden" NAME="mode" VALUE="new">
<TR><TD NOWRAP ALIGN="right" VALIGN="middle"><FONT COLOR="$pref{'color_subject'}"><B>subject: </B></FONT></TD><TD VALIGN="middle"><INPUT TYPE="text" NAME="subject" SIZE="48"></TD></TR>
<TR><TD NOWRAP ALIGN="right" VALIGN="top"><FONT COLOR="$pref{'color_subject'}"><B>content: </B></FONT></TD><TD VALIGN="middle"><TEXTAREA NAME="content" ROWS="12" COLS="60" WRAP="off"></TEXTAREA></TD></TR>
<TR><TD><BR></TD><TD VALIGN="middle"><FONT SIZE="-2" COLOR="$pref{'color_note'}">$tag_str</FONT></TD></TR>
<TR><TD COLSPAN="2"><BR></TD></TR>
<TR><TD><BR></TD><TD VALIGN="middle"><INPUT TYPE="submit" VALUE="$pref{'button_new'}"></TD></TR>
</FORM>
_HTML_
	}
	
	# メインブロック終了
	print <<"_HTML_";
</TABLE>
</TD><TD WIDTH="10%"><BR></TD></TR>
_HTML_
	
	# 表示順メニュー
	if ($pref{'res'}) {
		my $sort_menu = '';
		if ($query{'sort'} eq 'update') {
			my %query_by_no = %query;
			delete $query_by_no{'sort'};
			delete $query_by_no{'page'};
			my $by_no = &set_query("./$pref{'this_file'}", \%query_by_no);
			$sort_menu = qq(| <A HREF="$by_no">最新日記順表示</A> |);
		} else {
			my %query_by_update = %query;
			$query_by_update{'sort'} = 'update';
			delete $query_by_update{'page'};
			my $by_update = &set_query("./$pref{'this_file'}", \%query_by_update);
			$sort_menu = qq(| <A HREF="$by_update">最新レス順表示</A> |);
		}
		print <<"_HTML_";
<TR><TD ALIGN="right" COLSPAN="3"><FONT COLOR="$pref{'color_subject'}" SIZE="-1">$sort_menu</FONT></TD></TR>
_HTML_
	} else {
		print <<"_HTML_";
<TR><TD COLSPAN="3"><BR></TD></TR>
_HTML_
	}
	
	# メインパネル終了
	print <<"_HTML_";
</TABLE>


_HTML_
	
	
	
	### データ表示
	if (scalar(@list)) {
		my $page = 0;
		if ($query{'page'}) {$page = $query{'page'};}
		foreach (@{$list[$page]}) {
			my $no = (split(/,/, $_))[0];
			open(DATA, "$pref{'file_path'}$no");
			my @data = <DATA>;
			close(DATA);
			
			print <<"_HTML_";
<TABLE BORDER="0" CELLPADDING="$pref{'space'}" CELLSPACING="0" BGCOLOR="$pref{'color_table'}" WIDTH="200">
_HTML_
			
			my $res = '';
			
			foreach (0 .. $#data) {
				my $line = $_;
				my $data = $data[$line];
				chomp $data;
				my %data = split(/<>/, $data, -1);
				
				### 日付け処理
				my $date = &date($data{'date'});
				
				if ($line) {
					### レス
					if ($pref{'remote_host'}) {
						$data{'content'} .= qq(<!-- $data{'remote_host'} -->);
					}
					if ($pref{'ruser_agent'}) {
						$data{'content'} .= qq(<!-- $data{'user_agent'} -->);
					}
					if ($line % 2) {
						$res .= qq(<TR><TD VALIGN="top" NOWRAP><FONT COLOR="$pref{'color_res_odd'}" SIZE="-1"><B>$data{'name'}</B>　</FONT></TD><TD VALIGN="top" NOWRAP><FONT COLOR="$pref{'color_res_odd'}" SIZE="-1">$date　</FONT></TD><TD VALIGN="top"><FONT COLOR="$pref{'color_res_odd'}" SIZE="-1">$data{'content'}</FONT></TD>);
						
						if ($query{'mode'} eq 'admin') {
							$res .= qq(<FORM ACTION="$action" METHOD="POST" onSubmit="return confirm('本当に削除してもよろしいですか？')"><INPUT TYPE="hidden" NAME="mode" VALUE="delete"><INPUT TYPE="hidden" NAME="no" VALUE="$no"><INPUT TYPE="hidden" NAME="res_no" VALUE="$line"><TD ALIGN="right"><INPUT TYPE="submit" VALUE="削除"></TD></FORM>);
						}
						
						$res .= qq(</TR>);
					} else {
						$res .= qq(<TR><TD VALIGN="top" NOWRAP><FONT COLOR="$pref{'color_res_even'}" SIZE="-1"><B>$data{'name'}</B>　</FONT></TD><TD VALIGN="top" NOWRAP><FONT COLOR="$pref{'color_res_even'}" SIZE="-1">$date　</FONT></TD><TD VALIGN="top"><FONT COLOR="$pref{'color_res_even'}" SIZE="-1">$data{'content'}</FONT></TD>);
						
						if ($query{'mode'} eq 'admin') {
							$res .= qq(<FORM ACTION="$action" METHOD="POST" onSubmit="return confirm('本当に削除してもよろしいですか？')"><INPUT TYPE="hidden" NAME="mode" VALUE="delete"><INPUT TYPE="hidden" NAME="no" VALUE="$no"><INPUT TYPE="hidden" NAME="res_no" VALUE="$line"><TD ALIGN="right"><INPUT TYPE="submit" VALUE="削除"></TD></FORM>);
						}
						
						$res .= qq(</TR>);
					}
				} else {
					### 本投稿
					if ($pref{'remote_host'}) {
						$data{'content'} .= qq(<!-- $data{'remote_host'} -->);
					}
					if ($pref{'ruser_agent'}) {
						$data{'content'} .= qq(<!-- $data{'user_agent'} -->);
					}
					print <<"_HTML_";
<TR><TD>
<!--日付を削除
<FONT COLOR="#ffffff">[$no]　<B>$data{'subject'}</B>　　<FONT SIZE="-1">$date</FONT></FONT><BR>
//日付を削除終了 -->
<FONT COLOR="$pref{'color_text'}" SIZE="-1">$data{'content'}</FONT></TD></TR>
_HTML_
					if ($query{'mode'} eq 'admin') {
						print <<"_HTML_";
<TR><TD><TABLE BORDER="0" CELLPADDING="0" CELLSPACING="0" WIDTH="100%"><TR><FORM ACTION="$action" METHOD="POST"><INPUT TYPE="hidden" NAME="mode" VALUE="edit"><INPUT TYPE="hidden" NAME="no" VALUE="$no"><TD><INPUT TYPE="submit" VALUE="編集"></TD></FORM><FORM ACTION="$action" METHOD="POST" onSubmit="return confirm('本当に削除してもよろしいですか？')"><INPUT TYPE="hidden" NAME="mode" VALUE="delete"><INPUT TYPE="hidden" NAME="no" VALUE="$no"><TD ALIGN="right"><INPUT TYPE="submit" VALUE="削除"></TD></FORM></TR></TABLE></TD></TR>
_HTML_
					}
				}
			}
			
			if ($res) {
				print <<"_HTML_";
<TR><TD><TABLE BORDER="0" CELLPADDING="0" CELLSPACING="0">$res</TABLE></TD></TR>
_HTML_
			}
			
			if ($pref{'res'} and $query{'mode'} ne 'admin') {
				### レスフォーム
				print <<"_HTML_";
<TR><TD>
<TABLE BORDER="0" CELLPADDING="0" CELLSPACING="0"><FORM ACTION="$action" METHOD="POST"><INPUT TYPE="hidden" NAME="mode" VALUE="res"><INPUT TYPE="hidden" NAME="no" VALUE="$no">
<TR><TD NOWRAP ALIGN="right" VALIGN="middle"><FONT COLOR="$pref{'color_subject'}"><B>name: </B></FONT></TD><TD><INPUT TYPE="text" NAME="name" SIZE="12" VALUE="$output{'name'}"> <INPUT TYPE="submit" VALUE="$pref{'button_res'}"></TD></TR>
<TR><TD NOWRAP ALIGN="right" VALIGN="middle"><FONT COLOR="$pref{'color_subject'}"><B>content: </B></FONT></TD><TD><INPUT TYPE="text" NAME="content" SIZE="48"></TD></TR>
</FORM></TABLE>
</TD></TR>
_HTML_
			}
			
			print <<"_HTML_";
</TABLE>




_HTML_
		}
	}
	
	
	
	### ページ移動パネル表示
	if (scalar(@list) > 1) {
		# １ページ毎
		my $arrow_new = '';
		if ($query{'page'} > 0) {
			my %query_to_new = %query;
			$query_to_new{'page'} = $query{'page'} - 1;
			if (!$query_to_new{'page'}) {delete $query_to_new{'page'};}
			my $to_new = &set_query("./$pref{'this_file'}", \%query_to_new);
			
			$arrow_new =  qq(<A HREF="$to_new"><font size="-2" color="#bbbbbb">未来</font></A>);
		}
		my $arrow_old = '';
		if ($query{'page'} < $#list) {
			my %query_to_old = %query;
			$query_to_old{'page'} = $query{'page'} + 1;
			my $to_old = &set_query("./$pref{'this_file'}", \%query_to_old);
			
			$arrow_old = qq(<A HREF="$to_old"><font size="-2" color="#33cce9">　過去←</font></A>);
		}
		my $arrows = '';
		if ($arrow_new and $arrow_old) {
			$arrows = qq($arrow_old　$arrow_new);
		} elsif ($arrow_new) {
			$arrows = $arrow_new;
		} elsif ($arrow_old) {
			$arrows = $arrow_old;
		}
		
		# プルダウンメニュー
		my $options = '';
		if (scalar(@list)) {
			foreach (0 .. $#list) {
				my %query_option = %query;
				if ($_) {
					$query_option{'page'} = $_;
				} else {
					delete $query_option{'page'};
				}
				my $option = &set_query("./$pref{'this_file'}", \%query_option);
				
				my $label = '';
				if ($query{'sort'} eq 'update') {
					my ($mday, $mon, $year) = (localtime((split(/,/, $list[$_][0]))[2]))[3,4,5];
					$mday = sprintf("%02d", $mday);
					$mon = sprintf("%02d", $mon + 1);
					$year = sprintf("%02d", $year + 1900);
					my $date = qq($year/$mon/$mday);
					$label = qq($date →);
				} else {
					my ($mday, $mon, $year) = (localtime((split(/,/, $list[$_][0]))[1]))[3,4,5];
					$mday = sprintf("%02d", $mday);
					$mon = sprintf("%02d", $mon + 1);
					$year = sprintf("%02d", $year + 1900);
					my $date = qq($year/$mon/$mday);
					$label = qq($date →);
				}
				
				if ($_ == $query{'page'}) {
					$options .= qq(<OPTION VALUE="$option" SELECTED>$label</OPTION>);
				} else {
					$options .= qq(<OPTION VALUE="$option">$label</OPTION>);
				}
			}
		}
		
		print <<"_HTML_";
<TABLE BORDER="0" CELLPADDING="0" CELLSPACING="0" BGCOLOR="#e9e9e9" WIDTH="$pref{'width'}"><TR><TD VALIGN="middle"><FONT COLOR="$pref{'color_subject'}">$arrows</FONT></TD><FORM><TD ALIGN="right" VALIGN="middle"> </TD></FORM></TR></TABLE>

_HTML_
	}
	
	
	
	### ロック解除
	&unlock('LOCK');
	
	&html_foot;
}

sub html_login {
	my $str = '<BR>';
	if ($cookie{'password'}) {
		$str = '<B>パスワードエラー。</B>';
	}
	
	&html_head;
	
	print <<"_HTML_";
<TABLE WIDTH="100%" HEIGHT="50%"><TR><TD ALIGN="center" VALIGN="middle">
<TABLE>
<FORM ACTION="$action" METHOD="POST">
<INPUT TYPE="hidden" NAME="mode" VALUE="login">
<TR><TD VALIGN="middle"><INPUT TYPE="password" NAME="password" SIZE="16"><INPUT TYPE="submit" VALUE="login"></TD></TR>
<TR><TD VALIGN="middle">$str</TD></TR>
</FORM>
</TABLE>
</TD></TR></TABLE>

_HTML_
	
	&html_foot;
}

sub html_edit {
	&lock('LOCK', "$pref{'file_path'}lock");
	open(DATA, "$pref{'file_path'}$output{'no'}");
	my @data = <DATA>;
	close(DATA);
	&unlock('LOCK');
	chomp $data[0];
	my %data = split(/<>/, $data[0], -1);
	
	$data{'subject'} =~ s/&/&amp;/g;
	$data{'subject'} =~ s/"/&quot;/g;
	$data{'subject'} =~ s/</&lt;/g;
	$data{'subject'} =~ s/>/&gt;/g;
	
	$data{'content'} =~ s/<BR>/\n/g;
	$data{'content'} =~ s/&/&amp;/g;
	$data{'content'} =~ s/"/&quot;/g;
	$data{'content'} =~ s/</&lt;/g;
	$data{'content'} =~ s/>/&gt;/g;
	
	&html_head;
	
	print <<"_HTML_";
<TABLE WIDTH="100%" HEIGHT="100%"><TR><TD ALIGN="center" VALIGN="middle">
<TABLE>
<FORM ACTION="$action" METHOD="POST">
<INPUT TYPE="hidden" NAME="mode" VALUE="edit">
<INPUT TYPE="hidden" NAME="no" VALUE="$output{'no'}">
<TR><TD NOWRAP ALIGN="right" VALIGN="middle"><B>subject: </B></TD><TD VALIGN="middle"><INPUT TYPE="text" NAME="subject" SIZE="48" VALUE="$data{'subject'}"></TD></TR>
<TR><TD NOWRAP ALIGN="right" VALIGN="top"><B>content: </B></TD><TD><TEXTAREA NAME="content" ROWS="12" COLS="60">$data{'content'}</TEXTAREA></TD></TR>
<TR><TD><BR></TD><TD VALIGN="middle"><INPUT TYPE="submit" VALUE="変更"></TD></TR>
</FORM>
</TABLE>
</TD></TR></TABLE>

_HTML_
	
	&html_foot;
}

########## HTML PARTS ##########

sub html_head {
	&http_header;
	
	print <<"_HTML_";
<HTML>
<HEAD>
<TITLE>$pref{'title'}</TITLE>
<STYLE TYPE="text/css">
<!--
A { text-decoration: none; }
A:hover { text-decoration: underline; }
-->
</STYLE>
</HEAD>
<BODY BGCOLOR="$pref{'color_bgcolor'}" TEXT="$pref{'color_bodytext'}" LINK="$pref{'color_link'}" VLINK="$pref{'color_vlink'}" ALINK="$pref{'color_alink'}">

<DIV ALIGN="center">

_HTML_
}

sub html_foot {
	print <<"_HTML_";
<TABLE BORDER="0" CELLPADDING="4" CELLSPACING="0" BGCOLOR="$pref{'color_table'}" WIDTH="$pref{'width'}"><TR><TD ALIGN="right"><FONT COLOR="$pref{'color_subject'}" SIZE="-1"><A HREF="http://www.zannenempire.com/" TARGET="_blank">曰言己 1.15 [by 残念帝国]</A></FONT></TD></TR></TABLE>

</DIV>

</BODY>
</HTML>

_HTML_
	exit;
}

########## ERROR ##########

sub error {
	my $str = shift;
	
	&html_head;
	
	print <<"_HTML_";
<TABLE WIDTH="100%" HEIGHT="50%"><TR><TD ALIGN="center" VALIGN="middle"><B>$str</B></TD></TR></TABLE>

_HTML_
	
	&html_foot;
}

########## HTTP HEADER ##########

sub http_header {
	print <<"_HTML_";
Content-Type: text/html; charset=euc-jp

_HTML_
}

########## DATE ##########

sub date {
	my ($sec,$min,$hour,$mday,$mon,$year,$wday) = localtime(shift);
	$sec = sprintf("%02d", $sec);
	$min = sprintf("%02d", $min);
	$hour = sprintf("%02d", $hour);
	$mon += 1;
	$year += 1900;
	$wday = ('日', '月', '火', '水', '木', '金', '土')[$wday];
	return "$year/$mon/$mday ($wday) $hour:$min:$sec";
}

sub date_gm {
	my($sec,$min,$hour,$mday,$mon,$year,$wday) = gmtime(shift);
	$sec = sprintf("%02d", $sec);
	$min = sprintf("%02d", $min);
	$hour = sprintf("%02d", $hour);
	$mday = sprintf("%02d", $mday);
	$mon = ('Jan', 'Feb', 'Mar', 'Apr', 'May', 'Jun', 'Jul', 'Aug', 'Sep', 'Oct', 'Nov', 'Dec')[$mon];
	$year += 1900;
	$wday = ('Sun', 'Mon', 'Tue', 'Wed', 'Thu', 'Fri', 'Sat')[$wday];
	return "$wday, $mday $mon $year $hour:$min:$sec GMT";
}

########## DECODE INPUT ##########

sub decode {
	require $pref{'jcode'};
	my $input = '';
	read(STDIN, $input, $ENV{'CONTENT_LENGTH'});
	my $pair = '';
	foreach $pair (split(/&/, $input)) {
		my ($key, $value) = split(/=/, $pair);
		$value =~ tr/+/ /;
		$value =~ s/%([0-9A-Fa-f][0-9A-Fa-f])/chr(hex($1))/eg;
		$value =~ tr/\t/ /;
		if ($input{$key}) {
			$input{$key} .= ',' . $value;
		} else {
			$input{$key} = $value;
		}
	}
	$input = join("\t", %input);
	&jcode::convert(\$input, 'euc');
	$input =~ s/\x0D\x0A/\n/g;
	$input =~ tr/\x0D\x0A/\n\n/;
	%input = split(/\t/, $input);
}

########## COOKIE ##########

sub get_cookie {
	foreach (split(/; /, $ENV{'HTTP_COOKIE'})) {
		my ($key, $value) = split /=/;
		$value =~ s/%([0-9A-Fa-f][0-9A-Fa-f])/chr(hex($1))/eg;
		$cookie{$key} = $value;
	}
}

sub set_cookie {
	my $name = shift;
	my $value = shift;
	my $expire_days = shift;
	
	if (!$value) {$expire_days = -1;}
	
	$value =~ s/(\W)/sprintf("%%%02X", ord($1))/eg;
	
	if ($expire_days) {
		my $expires = &date_gm($now + $expire_days *24*60*60);
		print qq(Set-Cookie: $name=$value; expires=$expires;\n);
	} else {
		print qq(Set-Cookie: $name=$value;\n);
	}
}

########## QUERY ##########

sub get_query {
	foreach (split(/&/, $ENV{'QUERY_STRING'})) {
		my ($key, $value) = split(/=/, $_);
		$query{$key} = $value;
	}
}

sub set_query {
	my $file = shift;
	my $rf_querys = shift;
	
	my @query = ();
	foreach (sort keys %{$rf_querys}) {
		push(@query, qq($_=$rf_querys->{$_}));
	}
	my $query = join('&', @query);
	if ($query) {
		return $file . '?' . $query;
	} else {
		return $file;
	}
}

########## FILTER ##########

sub tag_filter {
	my ($rstr, $rtags, $newline) = @_;
	
	my $str = $$rstr;
	$$rstr = '';
	
	my $tags = '';
	if (ref $rtags eq 'ARRAY') {$tags = join('|', @$rtags);}
	
	my $tag_regex = q(<[^"'>]*(?:"[^"]*"[^"'>]*|'[^']*'[^"'>]*)*>);
	
	while ($str) {
		my $text_tmp = '';
		my $tag_tmp = '';
		if ($str =~ /(.*?)($tag_regex)(.*)/so) {$text_tmp = $1; $tag_tmp = $2; $str = $3;}
		else {$text_tmp = $str; $str = '';}
		
		### text
		$text_tmp =~ s/</&lt;/g;
		$text_tmp =~ s/>/&gt;/g;
		$text_tmp =~ s/\n/$newline/g;
		$$rstr .= $text_tmp;
		
		### tag
		if ($tags and $tag_tmp =~ /^<\/?($tags)(?![0-9A-Za-z])/i) {$tag_tmp =~ s/\n/ /g;}
		else {$tag_tmp =~ s/</&lt;/g; $tag_tmp =~ s/>/&gt;/g; $tag_tmp =~ s/\n/$newline/g;}
		$$rstr .= $tag_tmp;
	}
}

sub url_filter {
	my ($rstr) = @_;
	
	my $str = $$rstr;
	$$rstr = '';
	
	my $tag_regex = q(<[^"'>]*(?:"[^"]*"[^"'>]*|'[^']*'[^"'>]*)*>);
	
	my $http_URL_regex = q(\b(?:https?|shttp)://(?:(?:[a-zA-Z0-9](?:[-a-zA-Z0-9]*[a-zA-Z0-9])?\.)*[a-zA-Z](?:[-a-zA-Z0-9]*[a-zA-Z0-9])?\.?|[0-9]+\.[0-9]+\.[0-9]+\.[0-9]+)(?::[0-9]*)?(?:/(?:[-_.!~*'()a-zA-Z0-9:@&=+$,]|%[0-9A-Fa-f][0-9A-Fa-f])*(?:;(?:[-_.!~*'()a-zA-Z0-9:@&=+$,]|%[0-9A-Fa-f][0-9A-Fa-f])*)*(?:/(?:[-_.!~*'()a-zA-Z0-9:@&=+$,]|%[0-9A-Fa-f][0-9A-Fa-f])*(?:;(?:[-_.!~*'()a-zA-Z0-9:@&=+$,]|%[0-9A-Fa-f][0-9A-Fa-f])*)*)*(?:\?(?:[-_.!~*'()a-zA-Z0-9;/?:@&=+$,]|%[0-9A-Fa-f][0-9A-Fa-f])*)?)?(?:#(?:[-_.!~*'()a-zA-Z0-9;/?:@&=+$,]|%[0-9A-Fa-f][0-9A-Fa-f])*)?(?![-_.!~*'()a-zA-Z0-9;/?:@&=+$,#]));
	my $ftp_URL_regex = q(\bftp://(?:(?:[-a-zA-Z0-9_.!*'();&=~]|%[0-9A-Fa-f][0-9A-Fa-f])*(?::(?:[-a-zA-Z0-9_.!*'();&=~]|%[0-9A-Fa-f][0-9A-Fa-f])*)?@)?(?:(?:[a-zA-Z0-9](?:(?:[a-zA-Z0-9]|-)*[a-zA-Z0-9])?\.)*[a-zA-Z](?:(?:[a-zA-Z0-9]|-)*[a-zA-Z0-9])?|[0-9]+\.[0-9]+\.[0-9]+\.[0-9]+)(?::[0-9]*)?(?:/(?:[-a-zA-Z0-9_.!*'():@&=~]|%[0-9A-Fa-f][0-9A-Fa-f])*(?:/(?:[-a-zA-Z0-9_.!*'():@&=~]|%[0-9A-Fa-f][0-9A-Fa-f])*)?(?:;type=[AIDaid])?)?(?![-a-zA-Z0-9_.!*'():@&=~/]));
	my $mail_regex = q((?:[^(\040)<>@,;:".\\\[\]\000-\037\x80-\xff]+(?![^(\040)<>@,;:".\\\[\]\000-\037\x80-\xff])|"[^\\\x80-\xff\n\015"]*(?:\\[^\x80-\xff][^\\\x80-\xff\n\015"]*)*")(?:\.(?:[^(\040)<>@,;:".\\\[\]\000-\037\x80-\xff]+(?![^(\040)<>@,;:".\\\[\]\000-\037\x80-\xff])|"[^\\\x80-\\xff\n\015"]*(?:\\[^\x80-\xff][^\\\x80-\xff\n\015"]*)*"))*@(?:[^(\040)<>@,;:".\\\[\]\000-\037\x80-\xff]+(?![^(\040)<>@,;:".\\\[\]\000-\037\x80-\xff])|\[(?:[^\\\x80-\xff\n\015\[\]]|\\[^\x80-\xff])*\])(?:\.(?:[^(\040)<>@,;:".\\\[\]\000-\037\x80-\xff]+(?![^(\040)<>@,;:".\\\[\]\000-\037\x80-\xff])|\[(?:[^\\\x80-\xff\n\015\[\]]|\\[^\x80-\xff])*\]))*);
	
	my $skip = 0;
	while ($str) {
		my $text_tmp = '';
		my $tag_tmp = '';
		if ($str =~ /(.*?)($tag_regex)(.*)/so) {$text_tmp = $1; $tag_tmp = $2; $str = $3;}
		else {$text_tmp = $str; $str = '';}
		
		if ($skip) {
			$$rstr .= $text_tmp . $tag_tmp;
			if ($tag_tmp =~ /^<\/[aA](?![0-9A-Za-z])/) {$skip = 0;}
		}
		else {
			$text_tmp =~ s/($http_URL_regex)/<A HREF="$1">$1<\/A>/go;
			$text_tmp =~ s/($ftp_URL_regex)/<A HREF="$1">$1<\/A>/go;
			$text_tmp =~ s/($mail_regex)/<A HREF="mailto:$1">$1<\/A>/go;
			$$rstr .= $text_tmp . $tag_tmp;
			if ($tag_tmp =~ /^<[aA](?![0-9A-Za-z])/) {$skip = 1;}
		}
	}
}

########## LOCK ##########

sub lock {
	my $filehandle = shift;
	my $file = shift;
	$file .= '.lock';
	$filehandle .= '_LOCK';
	
	if (!(-e $file)) {
		open($filehandle, "> $file");
		print $filehandle 'dummy';
		close($filehandle);
	}
	
	open($filehandle,">> $file");
	flock($filehandle, 2);
}

sub unlock {
	my $filehandle = shift;
	$filehandle .= '_LOCK';
	close($filehandle);
}