package tdlprs;
#
######################################################################
###
###
###  CGI辞書システム T-Dictionary Ver.0.91
###     [8/8] データパースライブラリ (tdlprs.pl)
###                                 (c) 1996-2002 Takahiro Nishida
###                                 http://www.mytools.net/
###
###
######################################################################
#
### 変数設定部 （詳細は上記ページをご覧下さい） ######################

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





################################### パース関数 ###################################

########## 辞書 - 全体
sub parse_line_dic{
	local($buf, *C) = @_;
	($C{'wid'}, $C{'idxdec'}, $C{'h2dec'}, $C{'stime'}, $C{'uid'}, $C{'gids'}, $C{'rnos'}, $C{'imgext'}, $C{'imgx'}, $C{'imgy'}, $C{'filelist'}, $C{'url'}, $C{'hno'}, $C{'param'}, $C{'ruby'}, $C{'word'}, $C{'meanlist'}) = split("\t", $buf);
}

########## 辞書 - 意味リスト
sub parse_line_reg{
	local($buf, *C) = @_;
	($info, $C{'newline'}) = split("\t>>>>>\t", $buf);
	$C{'newline'} =~ s/\n//;
	$C{'newline'} =~ s/\r//;
	($C{'actid'}, $C{'target'}, $C{'mode'}, $C{'stime'}, $C{'uid'}, $C{'wid'}) = split("\t", $info);
}

########## 辞書 - 所属ジャンル単位
sub array_dic_gids{
	local($buf, *S) = @_;
	@S = split(",", $buf);
}

########## 辞書 - 関連単語ＩＤ単位
sub array_dic_rnos{
	local($buf, *S) = @_;
	@S = split(",", $buf);
}

########## 辞書 - 意味リスト単位
sub array_dic_meanlist{
	local($buf, *S) = @_;
	@S = split("<#>", $buf);
}

########## 辞書 - 意味リスト
sub parse_line_dic_mean{
	local($buf, *C) = @_;
	$buf =~ s/\t//;
	($C{'mid'}, $C{'mtime'}, $C{'muid'}, $C{'mean'}) = split("<>", $buf);
}

########## 辞書 - 関連ファイル単位
sub array_dic_filelist{
	local($buf, *S) = @_;
	@S = split("<#>", $buf);
}

########## 辞書 - 関連ファイル
sub parse_line_dic_file{
	local($buf, *C) = @_;
	$buf =~ s/\t//;
	($C{'fid'}, $C{'ftime'}, $C{'fuid'}, $C{'fname'}, $C{'fsize'}, $C{'ftitle'}) = split("<>", $buf);
}

########## コメント
sub parse_line_com{
	local($buf, *C) = @_;
	($C{'cid'}, $C{'cwid'}, $C{'ctime'}, $C{'cname'}, $C{'ccom'}) = split("\t", $buf);
}

########## 分類
sub parse_line_genre{
	local($buf, *C) = @_;
	($C{'gid'}, $C{'gpid'}, $C{'gcnt'}, $C{'gname'}, $C{'gcom'}, $C{'glevel'}, $C{'gsno'}) = split("\t", $buf);
}

########## ユーザ
sub parse_line_user{
	local($buf, *C) = @_;
	($C{'uid'}, $C{'uname'}, $C{'uemail'}, $C{'upwd'}, $C{'uurl'}, $C{'ucom'}) = split("\t", $buf);
}





################################### ジョイン関数 ###################################
########## 辞書
sub join_line_dic{
	local(*C) = @_;
	return "$C{'wid'}\t$C{'idxdec'}\t$C{'h2dec'}\t$C{'stime'}\t$C{'uid'}\t$C{'gids'}\t$C{'rnos'}\t$C{'imgext'}\t$C{'imgx'}\t$C{'imgy'}\t$C{'filelist'}\t$C{'url'}\t$C{'hno'}\t$C{'param'}\t$C{'ruby'}\t$C{'word'}\t$C{'meanlist'}\t\n";
}

########## 辞書 - 登録ライン
sub join_line_reg{
	local(*C) = @_;
	### join_line_die から来た場合既に改行がついているので取り除く
	$C{'newline'} =~ s/\t\n$//;
	return "$C{'actid'}\t$C{'target'}\t$C{'mode'}\t$C{'stime'}\t$C{'uid'}\t$C{'wid'}\t>>>>>\t$C{'newline'}\t\n";
}

########## 辞書 - 意味リスト
sub join_line_dic_mean{
	local(*C) = @_;
	return "$C{'mid'}<>$C{'mtime'}<>$C{'muid'}<>$C{'mean'}<#>";
}

########## 辞書 - 関連ファイル
sub join_line_dic_file{
	local(*C) = @_;
	return "$C{'fid'}<>$C{'ftime'}<>$C{'fuid'}<>$C{'fname'}<>$C{'fsize'}<>$C{'ftitle'}<#>";
}

########## コメント
sub join_line_com{
	local(*C) = @_;
	return "$C{'cid'}\t$C{'cwid'}\t$C{'ctime'}\t$C{'cname'}\t$C{'ccom'}\t\n";
}

########## 分類
sub join_line_genre{
	local(*C) = @_;
	return "$C{'gid'}\t$C{'gpid'}\t$C{'gcnt'}\t$C{'gname'}\t$C{'gcom'}\t$C{'glevel'}\t$C{'gsno'}\t\n";
}

########## ユーザ
sub join_line_user{
	local(*C) = @_;
	return "$C{'uid'}\t$C{'uname'}\t$C{'uemail'}\t$C{'upwd'}\t$C{'uurl'}\t$C{'ucom'}\t\n";
}






################################### ハッシュ生成関数 ###################################

########## 全ハッシュのクリア
sub clear_all_hash{
	undef %HS_USR;
	undef %HS_GNR;
	undef %HS_DRB;
	undef %HS_DID;
}

########## 単語 - Key:ID
sub hash_dic_wid{
	local($key) = @_;
	### 未定義なら作成
	defined(%HS_DID) || &make_hash_dic_wid();
	### 値を返す
	$HS_DID{$key};
}
sub make_hash_dic_wid{
	local(*dics) = @_;
	local(%CB, $b_key);
	undef %HS_DID;
	(@_) || &tdllib'openfile($tdllib'datdic, *dics);
	foreach(@dics){
		&parse_line_dic($_, *CB);
		$b_key = $CB{'wid'};
		$HS_DID{$b_key} = $_;
	}
}



########## 単語 - Key:ふりがな(識別)
sub hash_dic_ruby{
	local($key) = @_;
	### 未定義なら作成
	defined(%HS_DRB) || &make_hash_dic_ruby();
	### 値を返す
	&jcode'convert(*key, "euc");
	$HS_DRB{$key};
}
sub make_hash_dic_ruby{
	local(*dics) = @_;
	local(%CB, $b_key);
	undef %HS_DRB;
	(@_) || &tdllib'openfile($tdllib'datdic, *dics);
	foreach(@dics){
		&parse_line_dic($_, *CB);
		$b_key = $CB{'ruby'};
		&jcode'convert(*b_key, "euc");
		($HS_DRB{$b_key}) && ($b_key .= "($CB{'hno'})");
		$HS_DRB{$b_key} = $_;
	}
}



########## 分類 - Key:ID
sub hash_genre_gid{
	local($key) = @_;
	### 未定義なら作成
	defined(%HS_GNR) || &make_hash_genre_gid();
	### 値を返す
	$HS_GNR{$key};
}
sub make_hash_genre_gid{
	local(*gnrs) = @_;
	local(%CB, $b_key);
	undef %HS_GNR;
	(@_) || &tdllib'openfile($tdllib'datgnr, *gnrs);
	foreach(@gnrs){
		&parse_line_genre($_, *CB);
		$b_key = $CB{'gid'};
		$HS_GNR{$b_key} = $_;
	}
}



########## ユーザ - Key:ID
sub hash_user_uid{
	local($key) = @_;
	### 未定義なら作成
	defined(%HS_USR) || &make_hash_user_uid();
	### 値を返す
	$HS_USR{$key};
}
sub make_hash_user_uid{
	local(*usrs) = @_;
	local(@usrs, %CB, $b_key);
	undef %HS_USR;
	(@_) || &tdllib'openfile($tdllib'datusr, *usrs);
	foreach(@usrs){
		&parse_line_user($_, *CB);
		$b_key = $CB{'uid'};
		$HS_USR{$b_key} = $_;
	}
}





################################### 検索関数 ###################################

########## 単語検索（ＩＤまたはよみがな）
sub search_word{
	local($wid) = @_;
	local($line);
	
	if($wid =~ /^\((\d+)\)$/){
		$line = &hash_dic_wid($1);
	}
	elsif(&tdlprs'check_ruby($wid) > 0){
		$line = &hash_dic_ruby($wid);
	}
	else{
		&tdllib'error("LP-0201", 0, "単語の入力が不正です（$wid）。よみがな又は(単語ID)を入力して下さい。");
	}
	($line) || &tdllib'error("LP-0202", 0, "単語「$wid」が見つかりません。");
	
	$line;
}





################################### 配列生成関数 ###################################

########## コメント（配列にして返す）
sub array_com{
	local($key, *S) = @_;
	
	### 未定義なら作成
	defined(%HS_COM) || &make_hash_com();
	### 値を返す
	@S = split("\0", $HS_COM{$key});
}
sub make_hash_com{
	local(@coms, %CB, $b_key);
	&tdllib'openfile($tdllib'datcom, *coms);
	foreach(@coms){
		(/\t/) || next;
		&parse_line_com($_, *CB);
		$b_key = $CB{'cwid'};
		$HS_COM{$b_key} .= $_ . "\0";
	}
}

########## 分類（ソートしてレベル付けして返す）
sub sort_genre{
	local(*gnrs) = @_;
	local($b_gpid, $b_top, $level, $sno);
	local(@lvs, @gss);
	local(%C, %PR);
	
	@gss = ();
	
	### 親子関係をまとめる
	foreach(@gnrs){
		&tdlprs'parse_line_genre($_, *C);
		$b_gpid = $C{'gpid'};
		$b_gid = $C{'gid'};
		($b_gpid) ? ($PR{$b_gpid} .= "$b_gid\0") : ($b_top .= "$b_gid\0");
	}
	
	
	### 階層化して出力
	$level = 0;
	&level($b_top);
	
	### 再帰サブルーチン
	sub level{
		local(@lvs) = split("\0", $_[0]);
		local($sno);
		($level < 50) || &tdllib'error("LP-0203", 1, "致命的エラー", "分類の親子関係が無限ループ：$tdllib'datgnr: ");
		$sno = 1;
		foreach(@lvs){
			&parse_line_genre(&hash_genre_gid($_), *C);
			$line = "$C{'gid'}\t$C{'gpid'}\t$C{'gcnt'}\t$C{'gname'}\t$C{'gcom'}\t$level\t$sno\t\n";
			push(@gss, $line);
			$level++;
			&level($PR{$_});
			$level--;
			$sno++;
		}
	}
	
	(@gnrs == @gss) || &tdllib'error("LP-0204", 0, "親子関係が不正です。親になれないものを選択していませんか？");
	
	@gnrs = @gss;
}


################################### 妥当性チェック関数 ###################################

########### よみがな（識別）
sub check_ruby{
	local($ruby) = @_;
	
	# 半角カッコは同音異義語
	if($ruby =~ /\((\d+)\)$/){
		($ruby) = split('\(', $ruby);
	}
	
	return &tdlchr'RubyToDecs($ruby);
}






################################### データ更新関数 ###################################

########## ユーザ登録
sub update_user{
	local(*usrs) = @_;
	local($umode, $uid, $uname, $uurl, $uemail, $ucom, $upwd, $udel);
	local($line, $i);
	local($CP);
	
	### 入力
	$umode = $tdllib'F{'umode'};
	$uid = &tdllib'decode($tdllib'F{'uid'});
	$uname = &tdllib'decode($tdllib'F{'uname'});
	$uurl = &tdllib'decode($tdllib'F{'uurl'});
	$uemail = &tdllib'decode($tdllib'F{'uemail'});
	$ucom = &tdllib'decode($tdllib'F{'ucom'});
	$upwd = &tdllib'decode($tdllib'F{'upwd'});
	$udel = $tdllib'F{'udel'};
	
	### チェック
	(!$upwd) || ($upwd =~ /^[\w\-]+$/) || &tdllib'error("LP-0211", 0, "入力エラー：パスワードが入力されていないか不正です");
	($uid =~ /^[\w\-]+$/) || &tdllib'error("LP-0212", 0, "入力エラー：ユーザＩＤが入力されていないか不正です");
	($uname) || &tdllib'error("LP-0213", 0, "入力エラー：名前が入力されていません");
	(!$uurl) || ($uurl =~ /^http:\/\//) || &tdllib'error("LP-0214", 0, "入力エラー：URLが入力されていないか不正です");
	(!$uemail) || ($uemail =~ /^[\w\-\.]+\@[\w\-\.]+/) || &tdllib'error("LP-0215", 0, "入力エラー：EMailが入力されていないか不正です");
	
	### 現在の情報を取り出す
	$line = &tdlprs'hash_user_uid($uid);
	### 新規の場合
	if($umode eq "new"){
		($line) && &tdllib'error("LP-0216", 0, "ユーザＩＤ $uid は既に登録されています。");
		($upwd) || &tdllib'error("LP-0217", 0, "ユーザ新規登録時はパスワードが必須です。");
		$upwd = crypt($upwd, $tdllib'CRYPT_SALT);
	}
	### 修正、削除の場合
	else{
		(!$line) && &tdllib'error("LP-0218", 0, "ユーザＩＤ $uid が見つかりません。");
		### 新パスワードがあれば変更
		if($upwd){
			$upwd = crypt($upwd, $tdllib'CRYPT_SALT);
		}
		### なければ昔のを使う
		else{
			&tdlprs'parse_line_user($line, *CP);
			$upwd = $CP{'upwd'};
		}
	}
	
	### とりあえず消す
	$i = -1;
	foreach(@usrs){
		$i++;
		if(/^$uid\t/){
			splice(@usrs, $i, 1);
			last;
		}
	}
	
	### 行作成
	$CP{'uid'} = $uid;
	$CP{'uname'} = $uname;
	$CP{'upwd'} = $upwd;
	$CP{'uurl'} = $uurl;
	$CP{'uemail'} = $uemail;
	$CP{'ucom'} = $ucom;
	
	### 削除以外の場合再挿入
	unless($udel){
		### 行を構築
		$newline = &tdlprs'join_line_user(*CP);
		### 追加
		unshift(@usrs, $newline);
	}
	else{
		### 辞書からユーザを消す
		$i = 0;
		foreach(@dics){
			&tdlprs'parse_line_dic($_, *CP);
			($CP{'uid'} eq $uid) && ($CP{'uid'} = "_admin");
			$CP{'meanlist'} =~ s/<>$uid<>/<>_guest<>/g;
			$CP{'filelist'} =~ s/<>$uid<>/<>_guest<>/g;
			$dics[$i++] = &tdlprs'join_line_dic(*CP);
		}
	}
}



########## コメント登録
sub update_comment{
	local(*coms) = @_;
	local($cmode, $cwid, $cname, $ccom);
	local($newline);
	local($CP);
	
	### 入力
	$cmode = $tdllib'F{'cmode'};
	$cwid = $tdllib'F{'cwid'};
	$cname = &tdllib'decode($tdllib'F{'cname'});
	$ccom = &tdllib'decode($tdllib'F{'ccom'});
	
	### チェック
	($cwid =~ /^\d+$/) || &tdllib'error("LP-0261", 0, "入力エラー：単語ＩＤが指定されていないか不正です", "($cwid)");
	($cname) || &tdllib'error("LP-0263", 0, "入力エラー：名前が入力されていません");
	($ccom) || &tdllib'error("LP-0264", 0, "入力エラー：コメントが入力されていません");
	
	### 行作成
	$CP{'cid'} = &tdllib'make_new_id();
	$CP{'cwid'} = $cwid;
	$CP{'cname'} = $cname;
	$CP{'ctime'} = &tdllib'get_time(0, 4);
	$CP{'ccom'} = $ccom;
	
	### 行を構築
	$newline = &tdlprs'join_line_com(*CP);
#       &tdllib'error("LP-9999", 0, "LINE:$newline");
	### 追加
	unshift(@coms, $newline);
}



########## 単語チェック
sub check_word{
	local($b_meanlist, $b_filelist) = @_;
	local(%C, %CP, %OP);
	
	local($wmode, $wid, $wuid, $wword, $wruby, $wurl, $wgids, $wrelrubys, $wdate, $wdel, $wimgx, $wimgy, $wimgdel);
	
	### 入力受け取り
	$wmode = $tdllib'F{'wmode'};
	$wid = $tdllib'F{'wid'};
	$wuid = $tdllib'F{'wuid'};
	$wword = &tdllib'decode($tdllib'F{'wword'});
	$wruby = &tdllib'decode($tdllib'F{'wruby'});
	$wurl = &tdllib'decode($tdllib'F{'wurl'});
	$wgids = $tdllib'F{'wgids'};
	$wrelrubys = &tdllib'decode($tdllib'F{'wrelrubys'});
	$wdate = $tdllib'F{'wdate'};
	$wdel = $tdllib'F{'wdel'};
	$wimgx = $tdllib'F{'wimgx'};
	$wimgy = $tdllib'F{'wimgy'};
	$wimgdel = $tdllib'F{'wimgdel'};
	
	### 仮登録フラグ
	$tmpflg = $tdllib'F{'tmpflg'};
	
	### チェック
	($wid =~ /^\d+$/) || &tdllib'error("LP-0221", 0, "入力エラー：単語ＩＤが不正です：$wid");
	($wuid =~ /^[\w\-]+/) || &tdllib'error("LP-0222", 0, "入力エラー：登録者ＩＤが不正です：$wuid");
	(&tdlprs'hash_user_uid($wuid)) || &tdllib'error("LP-0223", 0, "入力エラー：ユーザが存在しません：$wuid");
	($wword) || &tdllib'error("LP-0224", 0, "入力エラー：単語が入力されていません");
	($wruby) || &tdllib'error("LP-0225", 0, "入力エラー：ふりがなが入力されていません");
	($wgids =~ /\d+(\0\d+)*/) || &tdllib'error("LP-0226", 0, "入力エラー：分類ＩＤが選択されていないか不正です：$wgids");
	(!$wimgx) || ($wimgx =~ /^\d+$/) || &tdllib'error("LP-0227", 0, "入力エラー：画像サイズヨコが不正です：$wimgx");
	(!$wimgy) || ($wimgy =~ /^\d+$/) || &tdllib'error("LP-0228", 0, "入力エラー：画像サイズタテが不正です：$wimgy");
	
	### 分類の\0を,に修正
	$wgids =~ s/\0/,/g;
	### 重複ＩＤの検索
	($line = &tdlprs'hash_dic_wid($wid)) && (&tdlprs'parse_line_dic($line, *OP));
	### 新規の場合
	($wmode eq "new") && ($line) && &tdllib'error("LP-0229", 0, "単語ＩＤ $wid は既に登録されています。");
	### 修正、削除の場合
	($wmode eq "fix") && (!$line) && &tdllib'error("LP-0230", 0, "単語ＩＤ $wid が見つかりません。");
	
	##### 共通処理
	### 10進化
	(($b_decs = &tdlchr'RubyToDecs($wruby)) > 0) || &tdllib'error("LP-0231", 0, "入力エラー：ふりがなに不正な文字が含まれています：$wruby");
	### 先頭
	(($b_idxdec = &tdlchr'DecsToIdxDec($b_decs)) > 0) || &tdllib'error("LP-0232", 0, "入力エラー：ふりがなの先頭文字が不正です：$wruby - $b_idxdec");
	### 頭２つ
	$b_h2dec = &tdlchr'DecsToH2Dec($b_decs);
	### 更新時刻
	$b_wstime = ($wdate) || &tdllib'get_time(0, 4);
	### 関連語ふりがな→ＩＤ
	@sps = split(",", $wrelrubys);
	foreach(@sps){
		($buf) = split('\(');
		(&tdlchr'RubyToDecs($buf) > 0) || &tdllib'error("LP-0233", 0, "入力エラー：関連語が不正です：$_");
		(($buf = &tdlprs'hash_dic_ruby($_)) eq "") && &tdllib'error("LP-0234", 0, "入力エラー：関連語「$_」は存在しません。");
		&tdlprs'parse_line_dic($buf, *CP);
		$b_wrelids .= $CP{'wid'} . ",";
	}
	
	### 画像登録処理
	$b_imgext = $OP{'imgext'};
	if($imgfile = &tdllib'get_client_filename('wimage')){
		# 仮登録でなく、前の画像ファイルがあったら削除エントリ追加
		(!$tmpflg) && ($b_imgext) && (&tdllib'add_filelist_to_delete("$tdllib'imgdir/$wid.$b_imgext", 1));
		# 新しい拡張子チェック
		($b_imgext) = $imgfile =~ m|\.(\w+)$|;
		($b_imgext =~ /^gif|jpg|png$/i) || &tdllib'error("LP-0235", 0, "入力エラー：画像ファイルの拡張子が不正です：$b_imgext。登録可能な画像ファイルは gif, jpg, png です。");
		# 登録エントリ追加
		$sfname = &tdllib'get_server_filename('wimage');
		&tdllib'add_filelist($sfname, "$tdllib'imgdir/$wid.$b_imgext", 1);
	}
	
	### 画像ファイルが元からある、または新規に登録した場合、サイズが書いてないとエラー
	if($b_imgext){
		(!$wimgx) && (!$wimgy) && &tdllib'error("LP-0236", 0, "入力エラー：画像サイズが指定されていません。必須です。");
	}
	### ない場合は空に
	else{
		$b_imgext = "";
		$wimgx = "";
		$wimgy = "";
	}
	
	### 削除
	if($wimgdel || $wdel){
		# 前の画像ファイルがあったら削除エントリ追加
		($OP{'imgext'}) && (&tdllib'add_filelist_to_delete("$tdllib'imgdir/$wid.$OP{'imgext'}"), 1);
		$b_imgext = "";
		$wimgx = "";
		$wimgy = "";
	}
	
	### 行の作成
	$C{'wid'} = $wid;
	$C{'idxdec'} = $b_idxdec;
	$C{'h2dec'} = $b_h2dec;
	$C{'stime'} = $b_wstime;
	$C{'uid'} = $wuid;
	$C{'gids'} = $wgids;
	$C{'rnos'} = $b_wrelids;
	$C{'imgext'} = $b_imgext;
	$C{'imgx'} = $wimgx;
	$C{'imgy'} = $wimgy;
	$C{'url'} = $wurl;
	$C{'hno'} = $b_hno;
	$C{'param'} = $b_param;
	$C{'ruby'} = $wruby;
	$C{'word'} = $wword;
	$C{'meanlist'} = $b_meanlist;
	$C{'filelist'} = $b_filelist;
	
	$newline = &tdlprs'join_line_dic(*C);
	
	$newline;
}



########## 意味チェック
sub check_word_mean{
	local($mid, $mdel, $muid, $mdate, $mmean, $cnt);
	local($key, $cnt);
	
	### 仮登録フラグ
	$tmpflg = $tdllib'F{'tmpflg'};
	
	### 意味リスト作成
	$cnt = 1;
	while(1){
		$key = "wm" . $cnt;
		$cnt++;
		$mid = $tdllib'F{"${key}_mid"};
		$mdel = $tdllib'F{"${key}_del"};
		$muid = $tdllib'F{"${key}_uid"};
		$mdate = $tdllib'F{"${key}_date"};
		$mmean = &tdllib'decode($tdllib'F{"${key}_mean"});
		
		### 意味ＩＤがなくなったら終わり
		($mid) || last;
		### 削除かつ仮フラグなしなら次
		($mdel && !$tmpflg) && next;
		### 意味が書いてなければ次
		($mmean) || next;
		
		### 入力チェック
		$cnt--;
		($mid =~ /^\d+$/) || &tdllib'error("LP-0241", 1, "致命的エラー", "hiddenの意味ＩＤが不正：$mid");
		($muid =~ /^[\w\-]+/) || &tdllib'error("LP-0242", 0, "入力エラー：意味 $cnt の登録者ＩＤが入力されていないか不正です：$muid");
		(&tdlprs'hash_user_uid($muid)) || &tdllib'error("LP-0243", 0, "入力エラー：意味 $cnt のユーザは存在しません：$muid");
		$cnt++;
		
		### 行作成
		$CP{'mid'} = $mid;
		$CP{'mtime'} = ($mdate) || (&tdllib'get_time(0, 4));
		$CP{'muid'} = $muid;
		$CP{'mean'} = $mmean;
		$b_meanlist .= &tdlprs'join_line_dic_mean(*CP);
	}
	($b_meanlist) || &tdllib'error("LP-0244", 0, "入力エラー：意味がひとつも入力されていません。最低でもひとつは入力してください。");
	
	$b_meanlist;
}



########## ファイルチェック
sub check_word_file{
	local($fid, $fdel, $fuid, $fdate, $ftitle, $foname, $fosize);
	local($tmpflg, $key, $cnt, $fdname, $newfilename);
	
	### 仮登録フラグ
	$tmpflg = $tdllib'F{'tmpflg'};
	
	$wid = $tdllib'F{'wid'};
	($wid =~ /^\d+$/) || &tdllib'error("LP-0251", 1, "致命的エラー", "hiddenの単語ＩＤが不正：$wid");
	
	$cnt = 1;
	while(1){
		$key = "wf" . $cnt;
		$filekey = $key . "_file";
		$cnt++;
		$fid = $tdllib'F{"${key}_fid"};
		$fdel = $tdllib'F{"${key}_del"};
		$fuid = $tdllib'F{"${key}_uid"};
		$fdate = $tdllib'F{"${key}_date"};
		$ftitle = &tdllib'decode($tdllib'F{"${key}_title"});
		$foname = $tdllib'F{"${key}_foname"};
		$fosize = $tdllib'F{"${key}_fosize"};
		
		$fname = &tdllib'get_client_filename($filekey);
		
		### ファイルＩＤがなくなったら終わり
		($fid) || last;
		### タイトルがなかったら次
		($ftitle) || next;
		
		### 入力チェック
		$cnt--;
		($fid =~ /^\d+$/) || &tdllib'error("LP-0252", 1, "致命的エラー", "hiddenのファイルＩＤが不正：$mid");
		($fuid =~ /^[\w\-]+/) || &tdllib'error("LP-0253", 0, "入力エラー：ファイル $cnt の登録者ＩＤが入力されていないか不正です：$muid");
		(&tdlprs'hash_user_uid($fuid)) || &tdllib'error("LP-0254", 0, "入力エラー：ファイル $cnt のユーザが存在しません：$muid");
#	       ($ftitle) || &tdllib'error("LP-0255", 0, "入力エラー：ファイル $cnt のタイトルが入力されていません");
		$cnt++;
		
		### 削除かつ仮フラグなし→ファイル削除して次
		if($fdel && !$tmpflg){
			&tdllib'add_filelist_to_delete("$tdllib'filedir/$wid/$foname");
			next;
		}
		
		### 新規ファイル指定あり
		if($fname){
			$sfname = &tdllib'get_server_filename("${key}_file");
			$fsize = &tdllib'get_filesize($sfname);
			### 仮登録じゃなく、オリジナルがあったら消す
			(!$tmpflg) && ($foname) && (-f "$tdllib'filedir/$wid/$foname") && &tdllib'add_filelist_to_delete("$tdllib'filedir/$wid/$foname");
			### 新規登録
			&tdllib'add_filelist($sfname, "$tdllib'filedir/$wid/$fname");
		}
		### 新規ファイル指定なし
		else{
			$cnt--;
			($foname) || &tdllib'error("LP-0256", 1, "入力エラー：ファイル $cnt が登録されていません。");
			$cnt++;
			$fname = $foname;
			$fsize = $fosize;
		}
		
		### 行の作成
		$CP{'fid'} = $fid;
		$CP{'ftime'} = ($fdate) || (&tdllib'get_time(0, 4));
		$CP{'fuid'} = $fuid;
		$CP{'fname'} = $fname;
		$CP{'fsize'} = $fsize;
		$CP{'ftitle'} = $ftitle;
		$b_filelist .= &tdlprs'join_line_dic_file(*CP);
	}
	
	$b_filelist;
}



########## 辞書の更新
sub update_dictionary{
	local(*dics, $newline) = @_;
	
	local($wmode, $wdel, $wid, $wruby, $widxdec, $wh2dec);
	local($n_decs, $w_decs, $nd_decs, $wd_decs, $nl_decs, $wl_decs);
	local($nipo, $opo, $line, $n_decs, $b_hno);
	local(%CP, %NP, %CN);
	
	### 使う分だけ
	$wmode = $tdllib'F{'wmode'};
	$wdel = $tdllib'F{'wdel'};
	
	### ラインのパース
	&tdlprs'parse_line_dic($newline, *CN);
	$wid = $CN{'wid'};
	$wruby = $CN{'ruby'};
	$widxdec = $CN{'idxdec'};
	$wh2dec = $CN{'h2dec'};
	
	$w_decs = &tdlchr'RubyToDecs($CN{'ruby'}, 1);
	$wd_decs = &tdlchr'RubyToDecs($CN{'ruby'});
	$wl_decs = &tdlchr'RubyToDecs($CN{'ruby'}, 1, 1);
	
	##### 既存行削除ルーチン
	# 新しい挿入ポイント（初期値）
	$nipo = -1;
	if($wmode eq "fix"){
		### とりあえず消す
		$opo = -1;
		foreach(@dics){
			$opo++;
			&tdlprs'parse_line_dic($_, *CP);
			($CP{'wid'} == $wid) || next;
			splice(@dics, $opo, 1);
			last;
		}
		### ふりがなが登録前後で変わらない、かつ、削除でない → 同じ位置に挿入
		if(($CP{'ruby'} eq $wruby) && !$wdel){
			$nipo = $opo;
			$b_hno = $CP{'hno'};
		}
		### それ以外 → よみがなが同じ限りhnoを詰める
		else{
			&tdlprs'parse_line_dic($dics[$opo], *NP);
			while($CP{'ruby'} eq $NP{'ruby'}){
				($NP{'hno'} > 0) || &tdllib'error("LP-0261", 1, "致命的エラー", "同音異義語番号が取得できない");
				(--$NP{'hno'} == 1) && ($NP{'hno'} = "");
				$dics[$opo] = &join_line_dic(*NP);
				&parse_line_dic($dics[++$opo], *NP);
			}
		}
		### 削除ならここで終わり
		($wdel) && return;
	}
	
	### 挿入ポイントがまだ決定していない場合
	if($nipo == -1){
		### ダミー行
		push(@dics, "d\td\t" . $wh2dec + 1);
		foreach(@dics){
			$nipo++;
			&tdlprs'parse_line_dic($_, *CP);
			### 頭２で比較
			($CP{'h2dec'} < $wh2dec) && next;
			($CP{'h2dec'} > $wh2dec) && last;
			### 全体を清音で比較
			$n_decs = &tdlchr'RubyToDecs($CP{'ruby'}, 1);
			$n_result = &tdlchr'CmpDecLength($n_decs, $w_decs);
			($n_result == -1) && next;
			($n_result ==  1) && last;
			### 全体を濁点を加味して比較
			$nd_decs = &tdlchr'RubyToDecs($CP{'ruby'});
			$nd_result = &tdlchr'CmpDecLength($nd_decs, $wd_decs);
			($nd_result == -1) && next;
			($nd_result ==  1) && last;
			### 全体を促音を加味して比較
			$nl_decs = &tdlchr'RubyToDecs($CP{'ruby'}, 1, 1);
			$nl_result = &tdlchr'CmpDecLength($nl_decs, $wl_decs);
			($nl_result == -1) && next;
			($nl_result ==  1) && last;
			### ここまで同じなら完全一致のはず。識別IDを増やす。
			($CP{'ruby'} eq $CN{'ruby'}) || &tdllib'error("LP-0271", 1, "致命的エラー", "ふりがな挿入位置判定に失敗（$CP{'ruby'}$CN{'ruby'})");
			$b_hno++;
		}
		### 識別IDがあるなら最大値の次の値
		($b_hno) && ($b_hno++);
		### ダミー行削除
		pop(@dics);
	}
	
	### 行の作成（同義語No.付け直しのため）
	$CN{'hno'} = $b_hno;
	$newline = &tdlprs'join_line_dic(*CN);
	
	### 挿入
	splice(@dics, $nipo, 0, $newline);
}



1;