#!/usr/local/bin/perl
#
######################################################################
###
###
###  CGI辞書システム T-Dictionary Ver.0.90
###     [3/8] 管理 (tdpadm.cgi)
###                                 (c) 1996-2002 Takahiro Nishida
###                                 http://www.mytools.net/
###
###
######################################################################
#
### 変数設定部 （詳細は上記ページをご覧下さい） ######################

$password = "TDictionary090";

### 変数設定部 （ここまで）###########################################

require './tdllib.pl';
require './tdlout.pl';
require './tdlprs.pl';
require './tdlchr.pl';

# Global変数
# @ERR_IMG_NOENTRY = ();
# @ERR_IMG_NOFILE = ();
# @ERR_FILE_NOENTRY = ();
# @ERR_FILE_NOFILE = ();

&main;

sub main{
	&tdllib'lock;
	&init_variables;
	&check_input;
	&open_datafile;
	&exec_action;
	&update_datafile;
	&tdllib'unlock;
	&show_html;
	&tdllib'cleanup_tmpfile;
}



########## 変数の初期化
sub init_variables{
	$errmsg = "<FONT COLOR=\"#000099\"><B>【！エラー！】</B></FONT>";
}



########## 入力のチェック
sub check_input{
	&tdllib'parseform;
	
	### 主要なものだけ
	$pwd = $tdllib'F{'pwd'};
	$mode = $tdllib'F{'mode'};
}



########## データファイルのオープンとリハッシュ
sub open_datafile{
	&tdllib'openfile($tdllib'datdic, *dics);
	&tdllib'openfile($tdllib'datgnr, *gnrs);
	&tdlprs'sort_genre(*gnrs);
	&tdllib'openfile($tdllib'datreg, *regs);
	&tdllib'openfile($tdllib'datusr, *usrs);
	&tdllib'openfile($tdllib'datcom, *coms);

}



########## メイン
sub exec_action{
	if($pwd ne $password){
		($pwd) && ($resultmsg = "$errmsg パスワードが違います。");
		$mode = "top";
		return;
	}
	
	# back に値があったら管理トップに戻る
	($tdllib'F{'back'}) && ($mode = "top");
	
	### mode に応じた処理
	if($mode eq 'check'){
		($tdllib'F{'checkexec'}) && &exec_check;
	}
	elsif($mode eq 'word'){
		($tdllib'F{'wordexec'}) && &exec_word;
	}
	elsif($mode eq 'com'){
		($tdllib'F{'comexec'}) && &exec_com;
	}
	elsif($mode eq 'genre'){
		($tdllib'F{'genreexec'}) && &exec_genre;
	}
	elsif($mode eq 'user'){
		($tdllib'F{'userexec'}) && &exec_user;
	}
	elsif($mode eq "status"){
		($tdllib'F{'statusexec'}) && &exec_status;
	}
	elsif($mode eq 'sort'){
		&exec_wordsort;
		$resultmsg = "辞書データを再ソートしました。";
		$mode = 'top';
	}
	elsif($mode eq 'update'){
		&tdlout'update_allpage();
		$resultmsg = "全ページを最新の状態にしました。";
		$mode = 'top';
	}
	else{
		$resultmsg = "$errmsg 作業が選択されていません。";
		$mode = 'top';
	}
}



########## 単語登録
sub exec_word{
	local($wmode, $wdel);
	
	### 入力受け取り
	$wword = $tdllib'F{'wword'};
	$wid = $tdllib'F{'wid'};
	$wmode = $tdllib'F{'wmode'};
	$wdel = $tdllib'F{'wdel'};
	

	### チェックとラインつくり
	$b_meanlist = &tdlprs'check_word_mean();
	$b_filelist = &tdlprs'check_word_file();
	$newline = &tdlprs'check_word($b_meanlist, $b_filelist);
	
	### 更新
	&tdlprs'update_dictionary(*dics, $newline);
	### フラグ
	$upflag_dics = 1;
	
	### 後始末
	$resultmsg = "単語「$wword」を";
	### 修正
	if($wmode eq 'fix' && !$wdel){
		$resultmsg .= "修正しました。";
		### 単語再表示
		$tdllib'F{'wnid'} = "($wid)";
		### フォームは単語修正
		$tdllib'F{'wread'} = 1;
	}
	### 新規、削除
	else{
		$resultmsg .= ($wdel) ? "削除しました。" : "新規登録しました。";
		### フォームは新規
		$tdllib'F{'wread'} = 0;
	}
}



########## コメント削除
sub exec_com{
	local($cdelid);
	local(@bufs);
	
	$cdelid = "," . $tdllib'F{'cdelid'};
	
	foreach(@coms){
		&tdlprs'parse_line_com($_, *CP);
		($cdelid =~ /,$CP{'cid'},/) && next;
		unshift(@bufs, $_);
	}
	@coms = @bufs;
	
	### 後始末
	$resultmsg = "コメントを削除しました。";
	$upflag_coms = 1;
}



########## 分類登録
sub exec_genre{
	local($gmode, $gid, $gname, $gpid, $gsno, $gcom);
	
	### 入力受け取り
	$gmode = $tdllib'F{'gmode'};
	$gid = $tdllib'F{'gid'};
	$gsno = $tdllib'F{'gsno'};
	$gname = &tdllib'decode($tdllib'F{'gname'});
	$gpid = $tdllib'F{'gpid'};
	$gcom = &tdllib'decode($tdllib'F{'gcom'});
	$gdel = $tdllib'F{'gdel'};
	
	### チェック
	($gid =~ /^\d+$/) || &tdllib'error("PA-1001", 0, "入力エラー：分類ＩＤが不正です：$gid");
	($gname) || &tdllib'error("PA-1002", 0, "入力エラー：分類名が入力されていません：$gname");
	($gpid =~ /^\d+$/) || &tdllib'error("PA-1003", 0, "入力エラー：親分類ＩＤが不正です：$gpid");
	($gsno =~ /^\d+$/) || &tdllib'error("PA-1004", 0, "入力エラー：順番が不正です：$gsno");
	($gid != $gpid) || &tdllib'error("PA-1005", 0, "入力エラー：自分を親とすることはできません：$gpid");
	
	### 現在の情報を取り出す
	$line = &tdlprs'hash_genre_gid($gid);
	### 新規の場合
	($gmode eq "new") && ($line) && &tdllib'error("PA-1006", 0, "分類ＩＤ $gid は既に登録されています。");
	### 修正、削除の場合
	($gmode eq "fix") && (!$line) && &tdllib'error("PA-1007", 0, "分類ＩＤ $gid が見つかりません。");
	
	### 修正の場合とりあえず消す
	if($gmode eq "fix"){
		$i = -1;
		foreach(@gnrs){
			$i++;
			if(/^$gid\t/){
				splice(@gnrs, $i, 1);
				last;
			}
		}
	}
	
	### 行作成
	$CP{'gid'} = $gid;
	$CP{'gpid'} = $gpid;
	$CP{'gname'} = $gname;
	$CP{'gcom'} = $gcom;
	
	### 削除以外の場合再挿入
	unless($gdel){
		### 挿入
		$flag = 0;
		$i = 0;
		foreach(@gnrs){
			&tdlprs'parse_line_genre($_, *C);
			if(($C{'gpid'} == $gpid) && (++$nno >= $gsno)){
				$CP{'gsno'} = $gsno;
				$flag = 1;
				last;
			}
			$i++;
		}
		### まだだったら順番は一番最後
		($flag) || ($CP{'gsno'} = ++$nno);
		### 行を構築
		$newline = &tdlprs'join_line_genre(*CP);
		### 挿入
		splice(@gnrs, $i, 0, $newline);
		### 後始末：分類再表示
		$tdllib'F{'gnid'} = $gid;
		### 後始末：フォーム、新規→新規、修正→修正
		$tdllib'F{'gread'} = ($gmode eq 'fix') ? 1 : 0;
	}
	else{
		### 辞書から分類を消す
		$i = 0;
		foreach(@dics){
			&tdlprs'parse_line_dic($_, *CP);
			$CP{'gids'} =~ s/$gid,?//g;
			$dics[$i++] = &tdlprs'join_line_dic(*CP);
		}
		$upflag_dics = 1;
		### そいつを親としてたものは全てルートへ
		$i = 0;
		foreach(@gnrs){
			&tdlprs'parse_line_genre($_, *CP);
			if($CP{'gpid'} == $gid){
				$CP{'gpid'} = 0;
				$gnrs[$i] = &tdlprs'join_line_genre(*CP);
			}
			$i++;
		}
		### フォームは新規作成
		$tdllib'F{'gread'} = 0;
	}
	### リハッシュ
	&tdlprs'make_hash_genre_gid(*gnrs);
	### 再ソートしてループしていないか調査
	&tdlprs'sort_genre(*gnrs);
	### 更新フラグ
	$upflag_gnrs = 1;
	
	### メッセージ
	($gmode eq 'new') && ($resultmsg = "分類「<FONT COLOR=\"#FF0000\"><B>$gname</B></FONT>」を新規登録しました。");
	($gmode eq 'fix') && ($resultmsg = "分類「<FONT COLOR=\"#FF0000\"><B>$gname</B></FONT>」を修正しました。");
	($gdel) && ($resultmsg = "分類「<FONT COLOR=\"#FF0000\"><B>$gname</B></FONT>」を削除しました。");
}




########## ユーザ登録
sub exec_user{
	local($umode, $uid, $udel);
	
	&tdlprs'update_user(*usrs);
	
	### 必要な分だけとる
	$udel = $tdllib'F{'udel'};
	$umode = $tdllib'F{'umode'};
	$uid = $tdllib'F{'uid'};
	
	### 後始末：ユーザ再表示
	$tdllib'F{'unid'} = $uid;
	### 後始末：フォーム、修正→修正、それ以外→新規
	$tdllib'F{'uread'} = ($umode eq 'fix' && !$udel) ? 1 : 0;
		
	### 更新フラグ
	$upflag_usrs = 1;
	
	### メッセージ
	($udel) && ($resultmsg = "ユーザＩＤ「<FONT COLOR=\"#FF0000\"><B>$uid</B></FONT>」を削除しました。");
	($umode eq 'new') && ($resultmsg = "ユーザＩＤ「<FONT COLOR=\"#FF0000\"><B>$uid</B></FONT>」を新規登録しました。");
	($umode eq 'fix') && ($resultmsg = "ユーザＩＤ「<FONT COLOR=\"#FF0000\"><B>$uid</B></FONT>」を修正しました。");
}




########## 登録依頼を正式採用する
sub exec_check{
	local($m_cid);
	local($b_actid, $b_target, $b_mode, $b_wid, $b_targetid);
	local($addno, $dispno, $keepno, $line, $regline);
	local(@newlines, @dellines, @keeps, @subs);
	local(%CP, %RP, %OP, %FIXLINES);
	
	### 許可、却下、保留件数
	$addno = 0;
	$dispno = 0;
	$keepno = 0;
	
	foreach $regline(@regs){
		### 入力行をパース（第一段階）
		&tdlprs'parse_line_reg($regline, *CP);
		$b_actid = $CP{'actid'};
		$b_wid = $CP{'wid'};
		$m_cid = $tdllib'F{$b_actid};
		$b_target = $CP{'target'};
		$b_mode = $CP{'mode'};
		
		### 1なら採用
		if($m_cid == 1){
			##### 「単語」の場合
			if($b_target eq 'W'){
				### 「単語＞新規」
				if($b_mode eq 'N'){
					push(@newlines, $CP{'newline'});
				}
				### 「単語＞修正」
				elsif($b_mode eq 'F'){
					### 対象行を取得
					$line = $FIXLINES{$b_wid} || &tdlprs'hash_dic_wid($b_wid);
					($line) || &tdllib'error("PA-1011", 0, "作業対象の単語が見つかりません($b_wid)。この依頼は却下してください。");
					### 対象行をパース
					&tdlprs'parse_line_dic($line, *OP);
					### 登録行をパース
					&tdlprs'parse_line_dic($CP{'newline'}, *RP);
					### meanlist, filelist だけ残して置き換え
					$RP{'meanlist'} = $OP{'meanlist'};
					$RP{'filelist'} = $OP{'filelist'};
					### 再セット
					$FIXLINES{$b_wid} = &tdlprs'join_line_dic(*RP);
				}
				### 「単語＞削除」
				elsif($b_mode eq 'D'){
					push(@dellines, $CP{'newline'});
				}
			}
			##### 「意味」の場合
			elsif($b_target eq 'M'){
				### 入力行をパース
				&tdlprs'parse_line_dic_mean($CP{'newline'}, *RP);
				### 対象行を取得
				$line = $FIXLINES{$b_wid} || &tdlprs'hash_dic_wid($b_wid);
				($line) || &tdllib'error("PA-1012", 0, "作業対象の単語が見つかりません($b_wid)。この依頼(は却下してください。");
				### 同じmidを取り出す
				&tdlprs'parse_line_dic($line, *OP);
				&tdlprs'array_dic_meanlist($OP{'meanlist'}, *subs);
				### 一旦カラに
				$OP{'meanlist'} = "";
				### 組み直し
				$flag = 0;
				foreach $listbuf(@subs){
					&tdlprs'parse_line_dic_mean($listbuf, *OPP);
					if($OPP{'mid'} == $RP{'mid'}){
						$flag = 1;
						### 「意味＞削除」なら飛ばすだけ
						($b_mode eq 'D') && next;
						### 「意味＞修正」なら入れ替え
						if($b_mode eq 'F'){
							$OPP{'mtime'} = $RP{'mtime'};
							$OPP{'muid'} = $RP{'muid'};
							$OPP{'mean'} = $RP{'mean'};
						}
					}
					### 再構築
					$OP{'meanlist'} .= &tdlprs'join_line_dic_mean(*OPP);
				}
				
				### 「意味＞新規」
				if($b_mode eq 'N'){
					### 更新したのに新規ならエラー
					($flag) && &tdllib'error("PA-1013", 0, "意味ID $RP{'mid'} は既に存在しています。この依頼は却下してください。");
					$OP{'meanlist'} .= &tdlprs'join_line_dic_mean(*RP);
				}
				else{
					### 更新してないのに修正or削除ならエラー
					($flag) || &tdllib'error("PA-1014", 0, "意味ID $RP{'mid'} が存在しません。この依頼は却下してください。");
				}
				### 更新日時
				$OP{'stime'} = &tdllib'get_time(0, 4);
				### 再セット（辞書）
				$FIXLINES{$b_wid} = &tdlprs'join_line_dic(*OP);
#			       &tdllib'error("PA-9998", 0, $FIXLINES{$b_wid});
			}
			##### 「ファイル」の場合
			elsif($b_target eq 'F'){
				### 入力行をパース
				&tdlprs'parse_line_dic_file($CP{'newline'}, *RP);
				### 対象行を取得
				$line = $FIXLINES{$b_wid} || &tdlprs'hash_dic_wid($b_wid);
				($line) || &tdllib'error("PA-1012", 0, "作業対象の単語が見つかりません($b_wid)。この依頼は却下してください。");
				### 同じfidを取り出す
				&tdlprs'parse_line_dic($line, *OP);
				&tdlprs'array_dic_filelist($OP{'filelist'}, *subs);
				### 一旦カラに
				$OP{'filelist'} = "";
				### 組み直し
				$flag = 0;
				foreach $listbuf(@subs){
					&tdlprs'parse_line_dic_file($listbuf, *OPP);
					if($OPP{'fid'} == $RP{'fid'}){
						$flag = 1;
						### 「ファイル＞削除」なら飛ばすだけ
						($b_mode eq 'D') && next;
						### 「ファイル＞修正」なら入れ替え
						if($b_mode eq 'F'){
							$OPP{'ftime'} = $RP{'ftime'};
							$OPP{'fuid'} = $RP{'fuid'};
							$OPP{'fname'} = $RP{'fname'};
							$OPP{'fsize'} = $RP{'fsize'};
							$OPP{'ftitle'} = $RP{'ftitle'};
						}
					}
					### 再構築
					$OP{'filelist'} .= &tdlprs'join_line_dic_file(*OPP);
				}
				
				# 仮登録ファイル名
				$tfname = "$tdllib'filedir/TMP_${b_actid}_$RP{'fid'}_$RP{'fname'}";
				# 新しいファイル名
				$nfname = "$tdllib'filedir/$b_wid/$RP{'fname'}";
				# 登録中のファイル名
				$ofname = "$tdllib'filedir/$b_wid/$OPP{'fname'}";
				
				### 「ファイル＞新規」
				if($b_mode eq 'N'){
					### 更新したのに新規ならエラー
					($flag) && &tdllib'error("PA-1015", 0, "ファイルID $RP{'fid'} は既に存在しています。この依頼は却下してください。");
					$OP{'filelist'} .= &tdlprs'join_line_dic_file(*RP);
#				       &tdllib'error("PA-9998", 0, "\n$OP{'filelist'}\n");
					&tdllib'add_filelist($tfname, $nfname);
				}
				else{
					### 更新してないのに修正or削除ならエラー
					($flag) || &tdllib'error("PA-1016", 0, "ファイルID $RP{'fid'} が存在しません。この依頼は却下してください。");
					&tdllib'add_filelist_to_delete($ofname);
					($b_mode eq 'F') && &tdllib'add_filelist($tfname, $nfname);
				}
				### 更新日時
				$OP{'stime'} = &tdllib'get_time(0, 4);
				### 再セット（辞書）
				$FIXLINES{$b_wid} = &tdlprs'join_line_dic(*OP);
			}
			$addno++;
		}
		### 2なら却下
		elsif($m_cid == 2){
			if($b_target eq 'F'){
				### 入力行をパース
				&tdlprs'parse_line_dic_file($CP{'newline'}, *RP);
				### 仮登録ファイル名
				$tfname = "$tdllib'filedir/TMP_${b_actid}_$RP{'fid'}_$RP{'fname'}";
				### 仮登録ファイルを削除
				(-f $tfname) && &tdllib'add_filelist_to_delete($tfname);
#			       &tdllib'error("LL-9999", 1, "TFNAME:$tfname");
			}
			$dispno++;
		}
		### それ以外は保留
		else{
			push(@keeps, $regline);
			$keepno++;
		}
	}
	
	### 新規物
	$tdllib'F{'wmode'} = "new";
	foreach $line(@newlines){
		&tdlprs'update_dictionary(*dics, $line);
	}
	### 修正物
	$tdllib'F{'wmode'} = "fix";
	while(($key, $line) = each(%FIXLINES)){
		&tdlprs'update_dictionary(*dics, $line);
	}
	### 削除物
	$tdllib'F{'wdel'} = "1";
	foreach $line(@dellines){
		&tdlprs'update_dictionary(*dics, $line);
	}
	
	### 後始末：保留分を戻す
	@regs = @keeps;
	
	# 更新フラグ
	$upflag_regs = 1; 
	$upflag_dics = 1;
	
	$resultmsg = "$addno 件を許可、$dispno 件を却下、$keepno 件を保留しました。";
}



########## 整合性を回復する
sub exec_status{
	local(%HFD);
	
	### 仮登録項目が残っていたらエラー
	(@regs) && &tdllib'error("PA-1031", 0, "仮登録依頼が残っているため整合性回復ができません。先に依頼を片付けて下さい。");
	### 整合性チェック
	&check_status();
	
	### 画像エントリ削除
	$tdllib'F{'wmode'} = "fix";
	foreach(@ERR_IMG_NOFILE){
		undef(%CP);
		($b_wid, $b_imgext) = split(",");
		# パース
		$line = &tdlprs'hash_dic_wid($b_wid);
		&tdlprs'parse_line_dic($line, *CP);
#	       &tdllib'error("PA-9999", 1, "OK", join("<BR>", @ERR_IMG_NOFILE));
		# 画像エントリ部だけカラにする
		$CP{'imgext'} = "";
		$CP{'imgx'} = "";
		$CP{'imgy'} = "";
		# 再構築
		$newline = &tdlprs'join_line_dic(*CP);
#	       ($b_wid == 10023875464101) && &tdllib'error("PA-9999", 1, "OK", "$newline");
		&tdlprs'update_dictionary(*dics, $newline);
		# ファイル側でも修正する場合
		$HFD{$b_wid} = $newline;
	}
	
	### ファイルエントリ削除
	foreach(@ERR_FILE_NOFILE){
		undef(%CP);
		($b_wid, $b_fid, $b_fname, $b_ftitle) = split(",");
		# パース
		$line = $HFD{$b_wid} || &tdlprs'hash_dic_wid($b_wid);
		&tdlprs'parse_line_dic($line, *CP);
		&tdlprs'array_dic_filelist($CP{'filelist'}, *subs);
#	       &tdllib'error("PA-9999", 1, "OK", join("<BR>", @ERR_FILE_NOFILE) . "<P>" . join("<BR>", @subs));
		# 一旦カラに
		$CP{'filelist'} = "";
		# ファイル部再構築
		foreach $listbuf(@subs){
			undef(%CCP);
			&tdlprs'parse_line_dic_file($listbuf, *CCP);
			# 削除対象だったら飛ばす
			($CCP{'fid'} == $b_fid) && next;
			$CP{'filelist'} .= &tdlprs'join_line_dic_file(*CCP);
		}
		# 再構築
		$newline = &tdlprs'join_line_dic(*CP);
		&tdlprs'update_dictionary(*dics, $newline);
	}
	
	### 画像削除
	foreach(@ERR_IMG_NOENTRY){
		&tdllib'add_filelist_to_delete("$tdllib'imgdir/$_", 1);
	}
	
	### ファイル削除
	foreach(@ERR_FILE_NOENTRY){
		&tdllib'add_filelist_to_delete("$tdllib'filedir/$_");
	}
	
	### ディレクトリ削除
	foreach(@ERR_DIR_EMPTY){
		&tdllib'add_filelist_to_dir_delete("$tdllib'filedir/$_");
	}
	
	### 後始末：更新フラグ
	$upflag_dics = 1;
	
	$resultmsg = "回復を実行しました。";
}



########## ファイルの整合性をチェックする
sub check_status{
	local($flag);
	local(%CP, %HI, %HF);
	
	### リセット
	@ERR_IMG_NOFILE = ();
	@ERR_FILE_NOFILE = ();
	@ERR_IMG_NOENTRY = ();
	@ERR_FILE_NOENTRY = ();
	@ERR_DIR_EMPTY = ();
	undef(%HI);
	undef(%HF);
	
	##### その１：エントリがあるのにファイルがないもの
	foreach(@dics){
		&tdlprs'parse_line_dic($_, *CP);
		$b_imgext = $CP{'imgext'};
		$b_wid = $CP{'wid'};
		### 画像
		if($b_imgext){
			$HI{"$b_wid.$b_imgext"} = 1;
			$b_imgpath = "$tdllib'imgdir/$b_wid.$b_imgext";
			(-f $b_imgpath) || push(@ERR_IMG_NOFILE, "$b_wid,$b_imgext");
		}
		### ファイル
		&tdlprs'array_dic_filelist($CP{'filelist'}, *subs);
		foreach(@subs){
			&tdlprs'parse_line_dic_file($_, *CCP);
			$b_fname = $CCP{'fname'};
			$b_fid = $CCP{'fid'};
			$b_ftitle = $CCP{'ftitle'};
			$HF{"$b_wid/$b_fname"} = 1;
			$b_filepath = "$tdllib'filedir/$b_wid/$b_fname";
			(-f $b_filepath) || push(@ERR_FILE_NOFILE, "$b_wid,$b_fid,$b_fname,$b_ftitle");
		}
	}
	
	##### その２：エントリがないのにファイルがあるもの
	### 画像
	opendir(DIR, $tdllib'imgdir) || &tdllib'error("PA-1021", 1, "画像ディレクトリが開けません：$tdllib'imgdir");
	while($file = readdir(DIR)){
		($file =~ /^\./) && next;
		($HI{$file}) || push(@ERR_IMG_NOENTRY, $file);
	}
	closedir(DIR);
	
	### ファイル
	opendir(DIR, $tdllib'filedir) || &tdllib'error("PA-1022", 1, "ファイルディレクトリが開けません：$tdllib'filedir");
	while($wdir = readdir(DIR)){
		($wdir  =~ /^\./) && next;
		if(-d "$tdllib'filedir/$wdir"){
			$flag = 0;
			opendir(WDIR, "$tdllib'filedir/$wdir") || &tdllib'error("PA-1023", 1, "単語ファイルディレクトリが開けません：$tdllib'filedir/$wdir");
			while($file = readdir(WDIR)){
				($file  =~ /^\./) && next;
				$flag = 1;
				($HF{"$wdir/$file"}) || push(@ERR_FILE_NOENTRY, "$wdir/$file");
			}
			closedir(WDIR);
			### その３：空のディレクトリ
			($flag) || (push(@ERR_DIR_EMPTY, $wdir));
		}
	}
	closedir(DIR);
	
#       &tdllib'error("PA-9999", 0, "IMGERR IS:<P>" . join("<BR>", @ERR_IMG_NOENTRY));
#       &tdllib'error("PA-9999", 0, "FILEERR IS:<P>" . join("<BR>", @ERR_FILE_NOENTRY));
#       &tdllib'error("PA-9999", 0, "DIRERR IS:<P>" . join("<BR>", @ERR_DIR_EMPTY));
	
}



########## 全単語再ソート（つくりかけ）
sub exec_wordsort{
	local($b_decs, $newline);
	local(%CP);
	local(@org_dics);
	
	### 退避（逆にしたほうが再挿入時にふりがな比較の回数が減る。
	###       但し同音異義語番号が全部逆転するのが難点。２回やれば戻る。）
	@org_dics = reverse(@dics);
	@dics = ();
	
	$tdllib'F{'wmode'} = "new";
	
	foreach(@org_dics){
		### 分解
		&tdlprs'parse_line_dic($_, *CP);
		# ふりがな関連のみ更新
		# 10進化
		$b_decs = &tdlchr'RubyToDecs($CP{'ruby'});
		# 先頭
		$CP{'idxdec'} = &tdlchr'DecsToIdxDec($b_decs);
		# 頭２つ
		$CP{'h2dec'} = &tdlchr'DecsToH2Dec($b_decs);
		### ライン再構築
		$newline = &tdlprs'join_line_dic(*CP);
		### 更新
		&tdlprs'update_dictionary(*dics, $newline);
	}
	
	### フラグ
	$upflag_dics = 1;
}



########## ファイルを更新する
sub update_datafile{
	&tdllib'exec_filelist();
	($upflag_dics) && (&tdllib'updatefile($tdllib'datdic, *dics));
	($upflag_gnrs) && (&tdllib'updatefile($tdllib'datgnr, *gnrs));
	($upflag_usrs) && (&tdllib'updatefile($tdllib'datusr, *usrs));
	($upflag_regs) && (&tdllib'updatefile($tdllib'datreg, *regs));
	($upflag_coms) && (&tdllib'updatefile($tdllib'datcom, *coms));
}

################################### 表示関数 ###################################

########## メイン
sub show_html{
	### 改めてハッシュするため全てクリア
	&tdlprs'clear_all_hash();
	
	### テンプレートパーツ読込
	defined(%PT_ADM) || &tdlout'read_template_parts($tdllib'tpladm, *PT_ADM);
	
	if($mode eq 'check'){
		&html_checklist;
		$defaultmsg = "登録依頼されているＵＲＬ一覧を表\示しています。";
	}
	elsif($mode eq 'word'){
		&html_word;
		$defaultmsg = "単語登録／修正／削除用フォームを表\示しています。";
	}
	elsif($mode eq 'com'){
		&html_comment;
		$defaultmsg = "コメント削除用フォームを表\示しています。";
	}
	elsif($mode eq 'genre'){
		&html_genre;
		$defaultmsg = "分野登録／編集／削除用フォームを表\示しています。";
	}
	elsif($mode eq 'user'){
		&html_user;
		$defaultmsg = "ユーザ登録／編集／削除用フォームを表\示しています。";
	}
	elsif($mode eq 'status'){
		&html_status;
		$defaultmsg = "データファイルの整合性情報を表\示しています。";
	}
	elsif($mode eq 'top'){
		&html_top;
		$defaultmsg = "作業とパスワードを入力して「作業実行」を押してください。";
	}
	
	($resultmsg) || ($resultmsg = $defaultmsg);
	
	# 表示用ハッシュ
	$C{'pwd'} = $pwd;
	$C{'regno'} = @regs;
	$C{'msg'} = $resultmsg;
	$C{'htmlurl'} = $tdllib'htmlurl;
	$C{'copyright'} = &tdllib'copyright;
	
	print "Content-type: text/html\n\n";
	&tdlout'merge_template($tdllib'tpladm, $mode, '', *C);
}



##### トップページ用
sub html_top{
	local($uout, $udic, $ucom, $ugnr, $empcol, $norcol);

	### 更新時間の取得
	$uout = (stat($tdlout'outidx))[9];
	$udic = (stat($tdllib'datdic))[9];
	$ucom = (stat($tdllib'datcom))[9];
	$ugnr = (stat($tdllib'datgnr))[9];
	
	### 色で警告
	$empcol = "#FF0000";
	$norcol = "#0000FF";
	($C{'diccol'}) = ($uout < $udic) ? $empcol : $norcol;
	($C{'comcol'}) = ($uout < $ucom) ? $empcol : $norcol;
	($C{'gnrcol'}) = ($uout < $ugnr) ? $empcol : $norcol;
	
	### 更新時間表示用
	$C{'outup'} = &tdllib'get_time($uout, 5);
	$C{'dicup'} = &tdllib'get_time($udic, 5);
	$C{'comup'} = &tdllib'get_time($ucom, 5);
	$C{'gnrup'} = &tdllib'get_time($ugnr, 5);
	
	### ステータス
	$C{'pagestatus'} = (($uout < $udic)||($uout < $ucom)||($uout < $ugnr)) ? "<FONT COLOR=\"#FF0000\">更新が必要</FONT>" : "<FONT COLOR=\"#0000FF\">最新</FONT>";
}



##### 単語修正用フォーム
sub html_word{
	local($buf, $nid, $line);
	local(@checked, @subs);
	local(%CP);
	
	$CP{'mcnt'} = 1;
	$CP{'fcnt'} = 1;
	
	### 修正
	if($tdllib'F{'wread'}){
		$C{'wmode'} = "fix";
		$CP{'mstatus'} = "修正";
		$CP{'fstatus'} = "修正";
		
		### 入力チェック
		$nid = &tdllib'decode($tdllib'F{'wnid'});
		($nid) || &tdllib'error("PA-1051", 0, "入力エラー：単語が入力されていません。");
		### 検索
		$buf = &tdlprs'search_word($nid);
		### パース
		&tdlprs'parse_line_dic($buf, *C);
		### タイトル
		$C{'whead'} = "「$C{'word'}」 修正";
		### 更新日
		$C{'wdate'} = &tdllib'get_time($C{'stime'}, 3);
		### 画像サイズ
		if($C{'imgext'}){
			$C{'imglink'} = "<A HREF=\"$tdllib'imgurl/$C{'wid'}.$C{'imgext'}\" TARGET=\"_blank\">image</A>(X$C{'imgx'}xY$C{'imgy'})";
		}
		
		### 関連単語一覧
		&tdlprs'array_dic_rnos($C{'rnos'}, *subs);
		foreach(@subs){
			$line = &tdlprs'hash_dic_wid($_);
			&tdlprs'parse_line_dic($line, *CP);
			$buf = ($CP{'hno'}) ? "($CP{'hno'})" : "";
			$C{'wrelruby'} .= "$CP{'ruby'}$buf,";
		}
		### 意味
		&tdlprs'array_dic_meanlist($C{'meanlist'}, *subs);
		foreach(@subs){
			&tdlprs'parse_line_dic_mean($_, *CP);
			$CP{'mdate'} = &tdllib'get_time($CP{'mtime'}, 3);
			$CP{'mean'} = &tdllib'tag_to_return($CP{'mean'});
			$C{'wmeans'} .= &tdlout'merge_template_parts($PT_ADM{'wmeans'}, *CP);
			$CP{'mcnt'}++;
		}
		### ファイル
		&tdlprs'array_dic_filelist($C{'filelist'}, *subs);
		foreach(@subs){
			&tdlprs'parse_line_dic_file($_, *CP);
			$CP{'mdate'} = &tdllib'get_time($CP{'mtime'}, 3);
			$CP{'ofile'} = "(<A HREF=\"$tdllib'fileurl/$C{'wid'}/$CP{'fname'}\">現在：$CP{'fname'} ($CP{'fsize'}KB)</A>)";
			$C{'wfiles'} .= &tdlout'merge_template_parts($PT_ADM{'wfiles'}, *CP);
			$CP{'fcnt'}++;
		}
		
		### 選択済みジャンル
		@checked = &tdlprs'array_dic_gids($C{'gids'});
#	       $C{'wgenres'} = &tdlout'form_select_genre(*gnrs, *checked);
		$C{'wgenres'} = &tdlout'form_checkbox_genre("wgids", *gnrs, *checked);
		
		($resultmsg) || ($resultmsg = "単語「$C{'word'}（$C{'ruby'} $C{'hno'}）」を表\示しています。");
	}
	### 新規
	else{
		$C{'whead'} = "新規登録";
		$C{'wid'} = &tdllib'make_new_id;
		$C{'wmode'} = "new";
		$C{'stime'} = &tdllib'get_time(0, 4);
		$C{'wdate'} = &tdllib'get_time($C{'stime'}, 3);
		$C{'wdcs'} = "<!--";
		$C{'wdce'} = "-->";
		$C{'wgenres'} = &tdlout'form_checkbox_genre("wgids", *gnrs, *checked);
	}
	
	### 新規フォーム
	$mbuf = $CP{'mcnt'};
	$fbuf = $CP{'fcnt'};
	
	# いったんクリアして値を入れなおす
	undef(%CP);
	
	### 新規意味フォーム（＋３つ）
	$CP{'mtime'} = &tdllib'get_time(0, 4);
	$CP{'mdate'} = &tdllib'get_time($CP{'mtime'}, 3);
	$CP{'mstatus'} = "新規";
	$CP{'mdcs'} = "<!--";
	$CP{'mdce'} = "-->";
	for(0..2){
		$CP{'mcnt'} = $mbuf + $_;
		$CP{'mid'} = &tdllib'make_new_id();
		$C{'wmeans'} .= &tdlout'merge_template_parts($PT_ADM{'wmeans'}, *CP);
	}
	
	### 新規ファイルフォーム（＋１つ）
	$CP{'ftime'} = &tdllib'get_time(0, 4);
	$CP{'fdate'} = &tdllib'get_time($CP{'mtime'}, 3);
	$CP{'fname'} = "";
	$CP{'fstatus'} = "新規";
	$CP{'fdcs'} = "<!--";
	$CP{'fdce'} = "-->";
	for(0..0){
		$CP{'fcnt'} = $fbuf + $_;
		$CP{'fid'} = &tdllib'make_new_id();
		$C{'wfiles'} .= &tdlout'merge_template_parts($PT_ADM{'wfiles'}, *CP);
	}
}



##### 分野修正用フォームの変数
sub html_genre{
	local($buf, $ncode, $i, @chk);
	
	### 修正
	if($tdllib'F{'gread'}){
		($gid = $tdllib'F{'gnid'}) || &tdllib'error("PA-1061", 0, "入力エラー：分類が指定されていません。");
		($gid =~ /^\d+$/) || &tdllib'error("PA-1062", 0, "入力エラー：分類が不正です。");
		($buf = &tdlprs'hash_genre_gid($gid)) || &tdllib'error("PA-1063", 0, "入力エラー：分類ＩＤ「$1」が見つかりません");
		&tdlprs'parse_line_genre($buf, *C);
		$C{'ghead'} = "分類 $C{'gname'} 修正";
		$C{'gmode'} = "fix";
		@chk = ($gid);
		$C{'gpda'} = &tdlout'form_select_genre(*gnrs, *chk);
		@chk = ($C{'gpid'}) ? ($C{'gpid'}) : ();
		$C{'gpdp'} = &tdlout'form_select_genre(*gnrs, *chk);
		
	}
	### 新規
	else{
		$C{'gid'} = &tdllib'make_new_id;
		$C{'ghead'} = "新規登録";
		$C{'gmode'} = "new";
		$C{'gname'} = "";
		$C{'gcom'} = "";
		$C{'gpda'} = &tdlout'form_select_genre(*gnrs);
		$C{'gpdp'} = &tdlout'form_select_genre(*gnrs);
		$C{'gsno'} = 999;
	}
	
	### 分類リスト
	$nlevel = -1;
	foreach(@gnrs){
		&tdlprs'parse_line_genre($_, *CP);
		### 基本クラス
		$color = "#000000";
		### 選択済みと一致したらそのレベルを記憶
		if($CP{'gid'} == $gid){
			$nlevel = $CP{'glevel'};
			$color = "#FF0000";
		}
		### 記憶中の場合、
		elsif($nlevel > -1){
			### レベルが上なら親にできない、以下になったら記憶終了
			($nlevel < $CP{'glevel'}) ? ($color = "#0000FF") : ($nlevel = -1);
		}
		### 表示
		$C{'glist'} .= "＋" x $CP{'glevel'};
		$C{'glist'} .= "<FONT COLOR=\"$color\">[$CP{'gsno'}] $CP{'gname'} <I>($CP{'gcom'})</I></FONT><BR>\n";
	}
	
}



##### ユーザ修正用フォームの変数
sub html_user{
	local($buf, $ncode, $i, @chk);
	
	### 修正
	if($tdllib'F{'uread'}){
		($uid = $tdllib'F{'unid'}) || &tdllib'error("PA-1071", 0, "入力エラー：ユーザＩＤが指定されていません。");
		($uid =~ /^([\w\-]+)$/) || &tdllib'error("PA-1072", 0, "入力エラー：ユーザＩＤが不正です：$uid");
		($buf = &tdlprs'hash_user_uid($1)) || &tdllib'error("PA-1073", 0, "入力エラー：ユーザＩＤが見つかりません：$uid");
		&tdlprs'parse_line_user($buf, *C);
		$C{'uhead'} = "ユーザ $C{'uname'} 修正";
		$C{'umode'} = "fix";
		$C{'userid'} = &tdlout'merge_template_parts($PT_ADM{'ouid'}, *C);
		$C{'upwd'} = "";
		@chk = ($uid);
		$C{'updp'} = &tdlout'form_select_user(*usrs, *chk);
	}
	### 新規
	else{
		$C{'uhead'} = "新規登録";
		$C{'umode'} = "new";
		$C{'uname'} = "";
		$C{'uurl'} = "";
		$C{'uemail'} = "";
		$C{'ucom'} = "";
		$C{'userid'} = &tdlout'merge_template_parts($PT_ADM{'nuid'});
		$C{'updp'} = &tdlout'form_select_user(*usrs, *chk);
	}
}



##### 登録依頼フォームの変数
sub html_checklist{
	local($htmlbuf, $b_target, $b_mode, $b_userinfo);
	local(%CP, %T, %A);
	
	$T{'W'} = "単語";
	$T{'M'} = "意味";
	$T{'F'} = "ファイル";
	
	$A{'N'} = "追加";
	$A{'F'} = "修正";
	$A{'D'} = "削除";
	
	foreach(@regs){
		&tdlprs'parse_line_reg($_, *CP);
	
		$b_target = $CP{'target'};
		$b_actid = $CP{'actid'};
		$b_mode = $CP{'mode'};
		$b_time = $CP{'stime'};
		$b_uid = $CP{'uid'};
		
		### ユーザIDからユーザ名を引く
		$line = &tdlprs'hash_user_uid($b_uid);
		&tdlprs'parse_line_user($line, *CCP);
		$b_userinfo = "$CCP{'uname'} ($b_uid : $CCP{'uemail'})";
		
		($b_target eq "W") && ($contbuf = &tdlout'glance_word($CP{'newline'}));
		($b_target eq "M") && ($contbuf = &tdlout'glance_word_mean($CP{'newline'}, $CP{'wid'}, 1));
		($b_target eq "F") && ($contbuf = &tdlout'glance_word_file($CP{'newline'}, $CP{'wid'}, 1, $b_actid));
		
		$htmlbuf .= "
		<TABLE WIDTH=\"80%\" BORDER=\"1\" CELLPADDING=\"\" CELLSPACING=\"\">
		<TR><TD BGCOLOR=\"#FFFFCC\"><FONT SIZE=\"2\">
		<FONT COLOR=\"#FF0000\"><B>◆ 【$T{$b_target}::$A{$b_mode}】</B></FONT>
		<FONT COLOR=\"#006600\"><B>【<INPUT TYPE=\"radio\" NAME=\"$CP{'actid'}\" VALUE=\"1\">許可
		<INPUT TYPE=\"radio\" NAME=\"$CP{'actid'}\" VALUE=\"2\">却下】</B></FONT>
		</FONT></TD></TR>
		<TR><TD BGCOLOR=\"#FFFFFF\"><FONT SIZE=\"2\">
		<FONT COLOR=\"#FFCC00\"><B>【依頼者】</B></FONT> $b_userinfo<BR>
		<FONT COLOR=\"#FFCC00\"><B>【時刻】</B></FONT> $b_time<BR>
		$contbuf
		</FONT></TD></TR>
		</TABLE><P>
		";
	}
	
	$C{'field'} = $htmlbuf;
}



##### データとファイルの整合性情報の表示
sub html_status{
	local($htmlbuf);
	
	# データファイルの情報を取得
	&check_status;
	
	# 数
	$C{'err_img_nofile_count'} = @ERR_IMG_NOFILE;
	$C{'err_file_nofile_count'} = @ERR_FILE_NOFILE;
	$C{'err_img_noentry_count'} = @ERR_IMG_NOENTRY;
	$C{'err_file_noentry_count'} = @ERR_FILE_NOENTRY;
	$C{'err_dir_empty_count'} = @ERR_DIR_EMPTY;
	
	# 表示
	foreach(@ERR_IMG_NOFILE){
		($b_wid, $b_imgext) = split(",");
		&tdlprs'parse_line_dic(&tdlprs'hash_dic_wid($b_wid), *CP);
		$b_word = $CP{'word'};
		$b_ruby = $CP{'ruby'};
		$C{'err_img_nofile'} .= "<OPTION>$b_word ($b_ruby) - $b_wid.$b_imgext\n";
	}
	
	foreach(@ERR_FILE_NOFILE){
		($b_wid, $b_fid, $b_fname, $b_ftitle) = split(",");
		&tdlprs'parse_line_dic(&tdlprs'hash_dic_wid($b_wid), *CP);
		$b_word = $CP{'word'};
		$b_ruby = $CP{'ruby'};
		$C{'err_file_nofile'} .= "<OPTION>$b_word ($b_ruby) - $b_ftitle ($b_fname)\n";
	}
	
	foreach(@ERR_IMG_NOENTRY){
		$C{'err_img_noentry'} .= "<OPTION>$_\n";
	}
	
	foreach(@ERR_FILE_NOENTRY){
		$C{'err_file_noentry'} .= "<OPTION>$_\n";
	}
	
	foreach(@ERR_DIR_EMPTY){
		$C{'err_dir_empty'} .= "<OPTION>$_\n";
	}
}



##### コメント一覧の表示
sub html_comment{
	local($htmlbuf, $wflag, $line, $b_link);
	local(@bufs);
	local(%CP);
	
	$nid = &tdllib'decode($tdllib'F{'wnid'});
	### 単語指定時
	if($nid){
		$C{'wnid'} = &tdllib'decode($nid);
		$wflag = 0;
		### 検索→単語ID確定
		$buf = &tdlprs'search_word($nid);
		&tdlprs'parse_line_dic($buf, *CP);
		$cwid = $CP{'wid'};
		### タイトル
		$C{'wordtitle'} = "「$CP{'word'}」への";
		### 単語IDでフィルタリング
		foreach(@coms){
			undef(%CP);
			&tdlprs'parse_line_com($_, *CP);
			($cwid eq $CP{'cwid'}) || next;
			push(@bufs, $_);
		}
		@coms = @bufs;
	}
	### 単語指定無し時（最新×件）
	else{
		$wflag = 1;
		### タイトル
		$C{'wordtitle'} = "最新 $tdllib'MAX_ALL_COMMENTS 件の";
		### 件数でカット
		(@coms < $tdllib'MAX_ALL_COMMENTS) || splice(@coms, $tdllib'MAX_ALL_COMMENTS, @coms);
	}
	
	### フォーム作成
	$htmlbuf = "<FONT SIZE=\"2\"><UL>\n";
	foreach(@coms){
		undef(%CP);
		$b_link = "";
		&tdlprs'parse_line_com($_, *CP);
		$b_cwid = $CP{'cwid'};
		if($wflag){
			### 単語詳細
			unless($b_link = $BBL{$b_cwid}){
				$BBL{$b_cwid} = "(単語削除済み)";
				if($line = &tdlprs'hash_dic_wid($b_cwid)){
					&tdlprs'parse_line_dic($line, *CP);
					$BBL{$b_cwid} = "（<A HREF=\"$tdllib'htmlurl/tdv$CP{'idxdec'}.html#$CP{'wid'}\">$CP{'ruby'}</A>）";
				}
				$b_link = $BBL{$b_cwid};
			}
		}
		$CP{'ctime'} = &tdllib'get_time($CP{'ctime'}, 3);
		$htmlbuf .= "
			<LI>
			<INPUT TYPE=\"checkbox\" NAME=\"cdelid\" VALUE=\"$CP{'cid'},\">
			<FONT COLOR=\"#0000FF\">[$CP{'ctime'}]</FONT>
			<FONT COLOR=\"#FF0000\"><B>$CP{'cname'}</B></FONT>
			<FONT COLOR=\"#000000\">$CP{'ccom'}</FONT>
			$b_link
		";
	}
	$htmlbuf .= "</UL></FONT>\n";
	
	$C{'field'} = $htmlbuf;
}