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

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





### 入出力ファイル
# 見出し
$tplidx = "$tdllib'basedir/tdtidx.htm";
$outidx = "$tdllib'htmldir/tdolid.html";
# ジャンル
$outign = "$tdllib'htmldir/tdolgn.html";
$outinw = "$tdllib'htmldir/tdolnw.html";
# 辞書
$tpldic = "$tdllib'basedir/tdtdic.htm";
# パレット
$tplugn = "$tdllib'basedir/tdtugn.htm";
$outugn = "$tdllib'htmldir/tdougn.html";
# タイトル
$tplttl = "$tdllib'basedir/tdtttl.htm";
$outttl = "$tdllib'htmldir/tdottl.html";
# 検索
$tplsch = "$tdllib'basedir/tdtusc.htm";
$outsch = "$tdllib'htmldir/tdousc.html";





################################### 直接コールする関数 ###################################

##### 静的HTMLを全て生成
sub update_allpage{
	# ファイルを開く
	&tdllib'openfile($tdllib'datdic, *dics);
	&tdllib'openfile($tdllib'datgnr, *gnrs);
	
	# ソート
	&tdlprs'sort_genre(*gnrs);
	
	# 一旦全部消す
	for(100..109){
		unlink("$tdllib'htmldir/tdv$_.html");
	}
	for(120..145){
		unlink("$tdllib'$htmldir/tdv$_.html");
	}
	for(200..282){
		unlink("$tdllib'$htmldir/tdv$_.html");
	}
	
	# 単純に全部渡してやる
	&page_dictionary_all(*dics);
	&page_index_abc($outidx, *dics);
	&page_index_genre($outign, *dics, *gnrs);
	&page_index_new($outinw, *dics);
	&page_pallet_genre($outugn, *gnrs);
	&page_templates(*dics);
}




################################### ページ生成関数 ###################################

##### 五十音順見出しの作成
sub page_index_abc{
	local($outfile, *dics) = @_;
	local($htmlbuf, $bodybuf);
	local(@bufs, @tps, %C);
	
	### テンプレートパーツ読込
	defined(%PT_IDX) || &read_template_parts($tplidx, *PT_IDX);
	
	$headbuf = "";
	foreach(@dics){
		(/\t/) || next;
		undef(%C);
		&tdlprs'parse_line_dic($_, *C);
		if($C{'idxdec'} ne $headbuf){
			$headbuf = $C{'idxdec'};
			$C{'anchor'} = $headbuf;
			$C{'head'} = &tdlchr'DecsToRuby($headbuf);
			$bodybuf .= &merge_template_parts($PT_IDX{'head'}, *C);
		}
		$C{'wurl'} = "./tdv$headbuf.html?#$C{'wid'}";
		$bodybuf .= &merge_template_parts($PT_IDX{'item'}, *C);
	}
	
	undef(%C);
	$C{'body'} = $bodybuf;
	&merge_template($tplidx, '', $outfile, *C);
}



##### 分野順見出しの作成
sub page_index_genre{
	local($outfile, *dics, *gnrs) = @_;
	local($htmlbuf, $bodybuf, $b_gid, $b_cnt);
	local(@bufs, @tps, @subs);
	local(%C, %GB, %GC);
	
	### テンプレートパーツ読込
	defined(%PT_IDX) || &read_template_parts($tplidx, *PT_IDX);
	
	### 分野毎にまとめる
	foreach(@dics){
		(/\t/) || next;
		undef(%C);
		&tdlprs'parse_line_dic($_, *C);
		$C{'wurl'} = "./tdv$C{'idxdec'}.html?#$C{'wid'}";
		### その単語が属する分野
		&tdlprs'array_dic_gids($C{'gids'}, *subs);
		foreach(@subs){
			$GB{$_} .= &merge_template_parts($PT_IDX{'item'}, *C);
			$GC{$_}++; # ついでにリアル値でカウント
		}
	}
	
	### 見出し生成
	foreach(@gnrs){
		&tdlprs'parse_line_genre($_, *C);
		$b_gid = $C{'gid'};
		$b_cnt = $GC{$b_gid} || "0";
		$C{'anchor'} = $b_gid;
		$C{'head'} = "$C{'gname'} ($b_cnt)";
		$bodybuf .= &merge_template_parts($PT_IDX{'head'}, *C);
		$bodybuf .= $GB{$b_gid};
	}
	
	undef(%C);
	$C{'body'} = $bodybuf;
	&merge_template($tplidx, '', $outfile, *C);
}



##### 新着順見出しの作成
sub page_index_new{
	local($outfile, *dics) = @_;
	local($htmlbuf, $bodybuf, $b_gid, $b_cnt);
	local(%C, %BU, %DU);
	
	### テンプレートパーツ読込
	defined(%PT_IDX) || &read_template_parts($tplidx, *PT_IDX);
	
	### ×日以内に更新したものだけ取り出す
	$stime = time();
	$slimit = $stime - (24 * 60 * 60 * $tdllib'new_date);
	$i = 0;
	foreach(@dics){
		(/\t/) || next;
		undef(%C);
		&tdlprs'parse_line_dic($_, *C);
		($C{'stime'} >= $slimit) || next;
		$BU{$C{'wid'}} = $_;
		$DU{$C{'wid'}} = $C{'stime'};
		$i++;
	}
	
	### 日付順にソート
	sub sortbydate { $DU{$b} <=> $DU{$a}; }
	
	### ヘッダ
	$C{'anchor'} = "updated";
	$C{'head'} = "新着順 （$tdllib'new_date日以内）";
	$bodybuf .= &merge_template_parts($PT_IDX{'head'}, *C);
	
	### 並べて順にほうり込む
	foreach(sort sortbydate keys %DU){
		undef(%C);
		&tdlprs'parse_line_dic($BU{$_}, *C);
		$C{'wurl'} = "./tdv$C{'idxdec'}.html?#$C{'wid'}";
		$C{'wpre'} = "[" . &tdllib'get_time($C{'stime'}, 3) . "]&nbsp;";
		$bodybuf .= &merge_template_parts($PT_IDX{'item'}, *C);
	}
	
	undef(%C);
	$C{'body'} = $bodybuf;
	&merge_template($tplidx, '', $outfile, *C);
}



##### 自由見出しの作成
sub page_index_list{
	local($head, *dics) = @_;
	local($htmlbuf, $bodybuf);
	local(@bufs, @tps, %C);
	
	### テンプレートパーツ読込
	defined(%PT_IDX) || &read_template_parts($tplidx, *PT_IDX);
	
	### タイトル
	if($head){
		$C{'head'} = $head;
		$bodybuf = &merge_template_parts($PT_IDX{'head'}, *C);
	}
	
	### 一行ごと
	$headbuf = "";
	foreach(@dics){
		(/\t/) || next;
		undef(%C);
		&tdlprs'parse_line_dic($_, *C);
		$C{'wurl'} = "$tdllib'htmlurl/tdv$C{'idxdec'}.html#$C{'wid'}";
		$bodybuf .= &merge_template_parts($PT_IDX{'item'}, *C);
	}
	
	undef(%C);
	$C{'body'} = $bodybuf;
	&merge_template($tplidx, '', '', *C);
}



##### 辞書の作成
sub page_dictionary{
	local($outfile, *dics) = @_;
	local($htmlbuf, $bodybuf, $line, $comcnt);
	local(@bufs, @tps, @subs, %C, %CP);
	
	### テンプレートパーツ読込
	defined(%PT_DIC) || &read_template_parts($tpldic, *PT_DIC);
	
	$headbuf = "";
	foreach(@dics){
		undef(%C);
		undef(%CP);
		&tdlprs'parse_line_dic($_, *C);
		### 更新時刻部
		$C{'stime'} = &tdllib'get_time($C{'stime'}, 5);
		### リンク表示部
		($C{'url'}) && ($C{'link'} = &merge_template_parts($PT_DIC{'link'}, *C));
		### 画像
		if($C{'imgext'}){
			$C{'imgurl'} = "./images/$C{'wid'}.$C{'imgext'}";
			($C{'image'} = &merge_template_parts($PT_DIC{'image'}, *C));
		}
		### 分類表示部
		&tdlprs'array_dic_gids($C{'gids'}, *subs);
		foreach(@subs){
			$line = &tdlprs'hash_genre_gid($_);
			&tdlprs'parse_line_genre($line, *CP);
			$C{'genres'} .= &merge_template_parts($PT_DIC{'genres'}, *CP);
		}
		### 関連語表示部
		&tdlprs'array_dic_rnos($C{'rnos'}, *subs);
		foreach(@subs){
			$line = &tdlprs'hash_dic_wid($_);
			&tdlprs'parse_line_dic($line, *CP);
			$C{'relurl'} = "tdv$CP{'idxdec'}.html#$_";
			$C{'relruby'} = $CP{'ruby'};
			$C{'relword'} = $CP{'word'};
			$C{'relations'} .= &merge_template_parts($PT_DIC{'relations'}, *C);
		}
		### 意味表示部
		$CP{'mcnt'} = 0;
		&tdlprs'array_dic_meanlist($C{'meanlist'}, *subs);
		foreach(@subs){
			&tdlprs'parse_line_dic_mean($_, *CP);
			$CP{'mcnt'}++;
			&tdlprs'parse_line_user(&tdlprs'hash_user_uid($CP{'muid'}), *CPP);
			$CP{'muname'} = $CPP{'uname'};
			$CP{'mean'} = &change_meanlink_wid_to_tag($CP{'mean'});
			$C{'means'} .= &merge_template_parts($PT_DIC{'means'}, *CP);
		}
		### 関連ファイル表示部
		$CP{'fcnt'} = 0;
		$CP{'fburl'} = "./files/" . $C{'wid'};
		&tdlprs'array_dic_filelist($C{'filelist'}, *subs);
		foreach(@subs){
			&tdlprs'parse_line_dic_file($_, *CP);
			$CP{'fcnt'}++;
			&tdlprs'parse_line_user(&tdlprs'hash_user_uid($CP{'fuid'}), *CPP);
			$CP{'funame'} = $CPP{'uname'};
			$C{'files'} .= &merge_template_parts($PT_DIC{'files'}, *CP);
		}
		### 一言表示部
		&tdlprs'array_com($C{'wid'}, *subs);
		$comcnt = 0;
		foreach(@subs){
			($comcnt++ < $tdllib'MAX_COMMENTS) || last;
			&tdlprs'parse_line_com($_, *CP);
			$CP{'ctime'} = &tdllib'get_time($CP{'ctime'}, 3);
			$C{'coms'} .= &merge_template_parts($PT_DIC{'coms'}, *CP);
		}
		
		### 共通部品（効率悪いが仕方ない。。。）
		$C{'cgiurl'} = $tdllib'cgiurl;
		$bodybuf .= &merge_template_parts($PT_DIC{'word'}, *C);
	}
	
	undef(%C);
	$C{'body'} = $bodybuf;
	
	&merge_template($tpldic, '', $outfile, *C);
}



##### 全辞書の作成（頭文字毎にファイルを分ける）
sub page_dictionary_all{
	local(*dics) = @_;
	local($headbuf, $outfile, @dbufs, %C);
	
	$headbuf = "";
	$#dbufs = -1;
	foreach(@dics){
		(/\t/) || next;
		undef(%C);
		&tdlprs'parse_line_dic($_, *C);
		if($headbuf ne $C{'idxdec'}){
			if($#dbufs > -1){
				&page_dictionary("$tdllib'htmldir/tdv$headbuf.html", *dbufs);
			}
			$#dbufs = -1;
			$headbuf = $C{'idxdec'};
		}
		push(@dbufs, $_);
	}
	
	### まだ残ってたらそれも出力
	($#dbufs > -1) && &page_dictionary("$tdllib'htmldir/tdv$headbuf.html", *dbufs);
}



########## パレット - 分類
sub page_pallet_genre{
	local($outfile, *gnrs) = @_;
	local($b_gid, $bodybuf);
	local(%C);
	
	### テンプレートパーツ読込
	defined(%PT_PGN) || &read_template_parts($tplugn, *PT_PGN);
	
	### 表示
	foreach(@gnrs){
		&tdlprs'parse_line_genre($_, *C);
		$b_gid = $C{'gid'};
		$C{'glevel'} = "&nbsp;" x $C{'glevel'};
		$bodybuf .= &merge_template_parts($PT_PGN{'tree'}, *C);
	}
	
	undef(%C);
	$C{'body'} = $bodybuf;
	
	&merge_template($tplugn, '', $outfile, *C);
}



########## その他テンプレート系
sub page_templates{
	local(*dics) = @_;
	local(%C);
	
	### 件数
	$C{'wordcnt'} = @dics;
	### 更新日
	$udata = (stat($tdllib'datdic))[9];
	$C{'dataup'} = &tdllib'get_time($udata, 3);
	
	### その他
	$C{'cgiurl'} = $tdllib'cgiurl;
	$C{'verno'} = $tdllib'verno;
	$C{'backurl'} = $tdllib'backurl;
	$C{'copyright'} = &tdllib'copyright;
	
	### 出力部
	# タイトル
	&merge_template($tplttl, '', $outttl, *C);
	# 検索
	&merge_template($tplsch, '', $outsch, *C);
	
	
}



################################### 共通関数 ###################################

########## 文書内LINKをタグ化
sub change_meanlink_wid_to_tag{
	local($b_meanline) = @_;
	local($b_line, $b_ruby, $b_url, $b_linkword, $b_link, $buf, %CP);
	
	while($b_meanline =~ /(#LINK:(\d+)(:([^#:]+))?#)/)
	{
		$b_org = $1;
		$b_wid = $2;
		$b_line = &tdlprs'hash_dic_wid($b_wid);
		### 単語ID->ふりがなに置き換え
		if($b_line){
			&tdlprs'parse_line_dic($b_line, *CP);
			$b_linkword = $4 || $CP{'word'};
			$b_link = "<A HREF=\"./tdv$CP{'idxdec'}.html#$b_wid\">$b_linkword</A>";
		}
		### 該当する単語IDがなかったらその旨書く
		else{
			$b_link = "<B><I>LINKERROR!</I></B>";
		}
		### 「ー」化け回避用 (2003/3/18)
		$b_org =~ s/(\W)/\\$1/g;
		$b_meanline =~ s/$b_org/$b_link/;
#		(++$loop < 2) || &tdllib'error("LL-9999", 0, "", $b_meanline);
	}
	
	return $b_meanline;
}







################################### 簡易表示関数 ###################################

########## 単語の簡易表示
sub glance_word{
	local($line, $tmpflag) = @_;
	local(%CP, %CCP);
	
	&tdlprs'parse_line_dic($line, *CP);
	
	### 画像
	if($CP{'imgext'}){
		$b_image = "<IMG SRC=\"$tdllib'imgurl/$CP{'wid'}.$CP{'imgext'}\" WIDTH=\"$CP{'imgx'}\" HEIGHT=\"$CP{'imgy'}\">\n";
	}
	else{
		$b_image = "なし";
	}
	### 関連語
	&tdlprs'array_dic_rnos($CP{'rnos'}, *subs);
	$b_relwords = "";
	foreach(@subs){
		$line = &tdlprs'hash_dic_wid($_);
		&tdlprs'parse_line_dic($line, *CCP);
		$b_relwords .= "$CCP{'word'}、";
	}
	
	# 登録者
	
	# 意味リスト
	$b_means = &glance_word_mean($CP{'meanlist'}, $CP{'wid'});
	# ファイルリスト
	$b_files = &glance_word_file($CP{'filelist'}, $CP{'wid'}, 0, $tmpflag);
	
	"
	<FONT COLOR=\"#006600\"><B>【単語】</B></FONT> $CP{'word'}<BR>
	<FONT COLOR=\"#9933FF\"><B>【よみ】</B></FONT> $CP{'ruby'}<BR>
	<FONT COLOR=\"#993333\"><B>【関連語】</B></FONT> $b_relwords<BR>
	<FONT COLOR=\"#FF6633\"><B>【画像】</B></FONT><BR> $b_image<BR CLEAR=\"all\">
	$b_means<BR>
	$b_files<BR>
	";
}



########## 意味の簡易表示
sub glance_word_mean{
	local($line, $wid, $flag) = @_;
	local($htmlbuf, $i, @subs, %CP, %CCP);
	
	&tdlprs'array_dic_meanlist($line, *subs);
	if($flag){
		$line = &tdlprs'hash_dic_wid($wid);
		&tdlprs'parse_line_dic($line, *CCP);
		$htmlbuf = "<FONT COLOR=\"#006600\"><B>【単語】</B></FONT> $CCP{'word'} $CCP{'hno'} ($CCP{'ruby'})<BR>";
	}
	$htmlbuf .= "<FONT COLOR=\"#555555\"><B>【意味】</B></FONT><BR>";
	$i = 1;
	foreach(@subs){
		&tdlprs'parse_line_dic_mean($_, *CP);
		$CP{'mean'} = &tdlprs'meanlink_wid_to_ruby($CP{'mean'});
		$htmlbuf .= "&nbsp;&nbsp;&nbsp;($i) $CP{'mean'}<BR>";
		$i++;
	}
	
	$htmlbuf;
}



########## ファイルの簡易表示
sub glance_word_file{
	local($line, $wid, $flag, $actid) = @_;
	local($htmlbuf, $i, @subs, %CP, %CCP);
	
	&tdlprs'array_dic_filelist($line, *subs);
	if($flag){
		$line = &tdlprs'hash_dic_wid($wid);
		&tdlprs'parse_line_dic($line, *CCP);
		$htmlbuf = "<FONT COLOR=\"#006600\"><B>【単語】</B></FONT> $CCP{'word'} $CCP{'hno'} ($CCP{'ruby'})<BR>";
	}
	$htmlbuf  .= "<FONT COLOR=\"#660000\"><B>【ファイル】</B></FONT><BR>";
	$i = 1;
	foreach(@subs){
		&tdlprs'parse_line_dic_file($_, *CP);
		$wfileurl = ($actid) ? "$tdllib'fileurl/TMP_${actid}_$CP{'fid'}_$CP{'fname'}" : "$tdllib'fileurl/$wid/$CP{'fname'}";
		$htmlbuf .= "&nbsp;&nbsp;&nbsp;($i) $CP{'ftitle'} $CP{'fname'} ($CP{'fsize'}KB)\n";
		$htmlbuf .= "<A HREF=\"$wfileurl\" TARGET=\"_blank\">[LINK]</A>";
		$htmlbuf .= "<BR>\n";
		$i++;
	}
	
	$htmlbuf;
}



################################### フォーム関数 ###################################

########## 分類
sub form_checkbox_genre{
	local($name, *gnrs, *checked) = @_;
	local($htmlbuf, $b_checked);
	local(@sps);
	local(%SEL);
	
	foreach(@checked){
		$SEL{$_} = 1;
	}
	
	foreach(@gnrs){
		&tdlprs'parse_line_genre($_, *C);
		$b_gid = $C{'gid'};
		$b_checked = ($SEL{$b_gid}) ? "CHECKED" : "";
		$htmlbuf .= "＋" x $C{'glevel'};
		$htmlbuf .= "<INPUT TYPE=\"checkbox\" NAME=\"$name\" VALUE=\"$C{'gid'}\" $b_checked>$C{'gname'} <I>($C{'gcom'})</I><BR>\n";
	}
	
	$htmlbuf;
}

########## 分類
sub form_select_genre{
	local(*gnrs, *checked) = @_;
	local($htmlbuf, $b_checked);
	local(@sps);
	local(%SEL);
	
	foreach(@checked){
		$SEL{$_} = 1;
	}
	
	foreach(@gnrs){
		&tdlprs'parse_line_genre($_, *C);
		$b_gid = $C{'gid'};
		$b_checked = ($SEL{$b_gid}) ? "SELECTED" : "";
		$htmlbuf .= "<OPTION VALUE=\"$C{'gid'}\" $b_checked>";
		$htmlbuf .= "＋" x $C{'glevel'};
		$htmlbuf .= "[$C{'gsno'}] $C{'gname'}\n";
#	       $htmlbuf .= "[$C{'gsno'}] $C{'gname'} ($C{'gcom'})\n";
	}
	
	$htmlbuf;
}



########## 分類
sub form_select_user{
	local(*usrs, *checked) = @_;
	local($htmlbuf, $b_checked);
	local(@sps);
	local(%SEL);
	
	foreach(@checked){
		$SEL{$_} = "SELECTED";
	}
	
	foreach(sort(@usrs)){
		&tdlprs'parse_line_user($_, *C);
		$b_uid = $C{'uid'};
		$htmlbuf .= "<OPTION VALUE=\"$b_uid\" $SEL{$b_uid}>";
		$htmlbuf .= "$b_uid （$C{'uname'}）\n";
	}
	
	$htmlbuf;
}





################################### テンプレート関数 ###################################


##### テンプレートに値を埋め込んで出力
sub merge_template{
	local($tpfile, $tptype, $outfile, *C) = @_;
	
	&tdllib'openfile($tpfile, *tps);
	
	### ファイルが指定されている場合はそのファイルへ
	if($outfile ne ""){
#	       (-f $outfile) || &tdllib'error("LO-0001", 1, "ファイルが存在しません。", "ファイル名：$outfile");
		open(OUT, ">$outfile") || &tdllib'error("LO-0002", 1, "ファイルを書き込みモードで開くことができません。", "ファイル名：$outfile");
	}
	### ない場合は標準出力へ
	else{
		open(OUT, ">-") || &tdllib'error("LO-0003", 1, "標準出力を開くことができません。");
	}
	
	$tpfrag = 1;
	$ptfrag = 0;
	foreach (@tps){
#	       print "($tpfrag, $ptfrag) $_";
		### TEMPLATE内 は $typeが合う場合のみ表示
		(/^<TEMPLATE TYPE="([\w\d\_]+)">/) && ($1 ne $tptype) && ($tpfrag = 0);
		(/^<\/TEMPLATE>/) && ($tpfrag = 1) && (next);
		($tpfrag) || next;
		### TEMPLATE_PARTS内 は無視
		(/^<TEMPLATE_PARTS NAME="[\w\d\_]+"/) && ($ptfrag++); 
		(/^<\/TEMPLATE_PARTS>/) && ($ptfrag--) && (next);
		($ptfrag) && next;
		### 書込、表示
		s/#CHK:(\w+)#/$C{$1}/g;
		print OUT;
	}
	close(OUT);
}



##### パーツに値を埋め込んで出力
sub merge_template_parts{
	local($parts, *C) = @_;
	
	$parts =~ s/#CHK:([\w\d\_]+)#/$C{$1}/g;
	
	return $parts;
}



##### テンプレートパーツの読み込み
sub read_template_parts{
	local($filename, *PT) = @_;
	local(@tps, @tpns, $tpname);
	
	&tdllib'openfile($filename, *tps);
	
	# テンプレート分解
	$tpname = "body";
	foreach(@tps){
#	       print "TPNAME: $tpname $_";
		if(/<TEMPLATE_PARTS NAME="([\w\d\_]+)">/){
			push(@tpns, $tpname);
			$tpname = $1;
			next;
		}
		if(/<\/TEMPLATE_PARTS>/){
			($tpname = pop(@tpns)) || &tdllib'error("LO-0004", "テンプレートファイルが不正です。", "$filename: </TEMPLATE_PART>タグが余計。");
			next;
		}
		# パーツタグ外は読み飛ばす
		(@tpns) || next;
		$PT{$tpname} .= $_;
	}
}





1;