#!/usr/local/bin/perl
#
######################################################################
###
###
###  CGIリンク集管理システム T-Bookmark Ver.1.10
###     [3/4] 管理 (tbadmin.cgi)
###                                 (c) 1996-2000 Takahiro Nishida
###                                 http://www.mytools.net/
###
###
######################################################################
#
### 変数設定部 （詳細は上記ページをご覧下さい） ######################

$password = "TBookmark110";

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

require './tblib.pl';
$errmsg = "<FONT COLOR=\"#000099\"><B>【！エラー！】</B></FONT>";

&main;

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



########## 変数の初期化
sub init_variables{
	$basedir = $tblib'basedir;
	
	$datafile = "$basedir/tbdata.txt";
	$newfile = "$basedir/tbnew.txt";
	$tpfile = "$basedir/tb_admin.html";
	$genrefile = "$basedir/tbgenre.txt";
	
	$topmsg = "作業を選択し、管理用パスワードを入力して、「作業実行」を押してください。";
}



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



########## データファイルのオープン
sub open_datafile{
	&tblib'openfile($datafile, *datas);
	&tblib'openfile($newfile, *news);
	&tblib'openfile($tpfile, *tps);
	&tblib'openfile($genrefile, *genres);
	
	&tblib'set_genre(*genres);
}



########## メイン
sub exec_action{
	if($pwd ne $password){
		$msg = ($pwd) ? "$errmsg パスワードが違います。" : $topmsg;
		$mode = "top";
		return;
	}
	
	# back に値があったら管理トップに戻る
	($tblib'F{'back'}) && ($mode = "top");
	
	### mode に応じた処理
	if($mode eq 'new'){
		($tblib'F{'newexec'}) && &add_data;
	}
	elsif($mode eq 'fix'){
		($tblib'F{'fixexec'}) && &fix_data;
	}
	elsif($mode eq 'genre'){
		($tblib'F{'gexec'}) && &fix_genre;
	}
	else{
		$msg = "$errmsg 作業が選択されていません。";
		$mode = 'top';
	}
}



########## 登録依頼を正式採用する
sub add_data{
	local($id, $cid, @adds, @bufs, $addno, $dispno);
	
	foreach (@news){
		($type, $id) = split("\t");
		$cid = $tblib'F{$id};
		($cid) || push(@bufs, $_); # 値が指定されていなかったら保留
		($cid == 1) && push(@adds, $_); # １だったら登録
	}
	
	### 許可件数、却下件数
	$addno = @adds;
	$dispno = @news - ($addno + @bufs);
	
	### 修正作業
	foreach (@adds){
		@pms = split("\t");
		&regist_page(@pms);
	}
	
	@news = @bufs; # 保留分を戻す
	$newfrag_news = 1; # 更新フラグ
	
	$msg = "$addno 件を許可、$dispno 件を却下しました。";
}



########## データを修正、削除する
sub fix_data{
	local($fmode, $fid, $fname, $fmail, $ftitle, $fgcode, $fkeys, $fcom, $fdate);
	
	### 入力の受け取り
	$fmode = $tblib'F{'fmode'};
	$fid = $tblib'F{'fid'};
	$fname = &tblib'decode($tblib'F{'fname'});
	$fmail = &tblib'decode($tblib'F{'fmail'});
	$ftitle = &tblib'decode($tblib'F{'ftitle'});
	$furl = &tblib'decode($tblib'F{'furl'});
	$fgcode = &tblib'decode($tblib'F{'gcode'});
	$fkeys = &tblib'decode($tblib'F{'fkeys'});
	$fcom = &tblib'decode($tblib'F{'fcom'});
	$fdate = &tblib'decode($tblib'F{'fdate'});
	$fserv = "[by admin]";
	
	### 不正チェック
	($fid =~ /^\d+$/) || &admin_error("ＩＤが不正です。");
	($fname) || &admin_error( "名前が入力されていません。");
	($ftitle) || &admin_error( "タイトルが入力されていません。");
	($fmail =~ /^[\w\-\+\.]+\@[\w\-\+\.]+$/) || &admin_error("メールアドレス入力されていないか不正です。$fmail");
	($furl =~ /^http:\/\//) || &admin_error("ＵＲＬが入力されていないか不正です。");
	($fgcode) || ($fgcode =~ /^(\w\w:)+$/) || &admin_error("ジャンルが不正です。");
	### 日付のチェック
	if($fdate){
		($fdate =~ /^\d+\/\d+\/\d+$/) || &admin_error("更新日時が不正です。");
	}
	else{
		$fdate = "###";
	}
	
	### 修正でdelがチェックされていたら削除モード
	($fmode eq 'fix' && $tblib'F{'fdel'}) && ($fmode = 'del');
	### 登録
	&regist_page($fmode, $fid, ":$fgcode", $fdate, $furl, $ftitle, $fcom, $fkeys, $fname, $fmail, $fserv);
	### 修正の場合は修正後の内容をフォームに再表示
	if($fmode eq 'fix'){
		$tblib'F{'fnid'} = $fid;
		$tblib'F{'fread'} = 1;
	}
	### メッセージ	
	$M{'new'} = "新しいページ（No.$fid）を登録しました。";
	$M{'fix'} = "No.$fid を修正しました。";
	$M{'del'} = "ID No.$fid を削除しました。";
	$msg = $M{$fmode};
}



########## ページの登録、修正、削除
sub regist_page{
	local($type, $id, $gcode, $date, $url, $title, $com, $keys, $name, $mail, $serv) = @_;
	local($i, $dfrag, $newline);
	
	### 重複チェック
	push(@datas, $id);
	for($i = 0; $i <= $#datas; $i++){
		($datas[$i] =~ /^$id/) && last;
	}
	
	
	### 日付チェック
	if($date eq "###"){
		$date = &tblib'get_time(0);
		$dfrag = 1;
	}
	elsif($date eq "UUU"){
		$date = &tblib'get_time(0);
		$com .= "<UP/>";
		$dfrag = 1;
	}
	
	### 追加される行
	$newline = "$id\t$gcode\t$date\t$url\t$title\t$com\t$keys\t$name\t$mail\t$serv\t\n";
	
	### 新規
	if($type eq 'new'){
		($i == $#datas)
			|| &admin_error("ID No.$id は既に登録されています。ボタンを二度押しませんでしたか？"); 
		$datas[$i] = $newline;
	}
	else{
		($i != $#datas) || &admin_error("ID No.$fidが見つかりません。");
		pop(@datas);
	### 削除
		if($type eq 'del'){
			splice(@datas, $i, 1);
		}
	### 修正
		elsif($type eq 'fix'){
			### 最新にする
			if($dfrag){
				$buf = splice(@datas, $i, 1);
				$i = $#datas + 1;
			}
			$datas[$i] = $newline;
		}
		else{
			&admin_error("作業内容が不明です。");
		}
	}
	
	### 更新フラグ
	$newfrag_datas = 1;
}



########## 分野の修正
sub fix_genre{
	local($gmode, $gcode, $gname, $gpos, $gcom);
	
	### 入力の受け取り
	$gmode = $tblib'F{'gmode'};
	$gcode = $tblib'F{'gcode'};
	$gname = &tblib'decode($tblib'F{'gname'});
	$gcom = &tblib'decode($tblib'F{'gcom'});
	$gpos = $tblib'F{'gpos'};
	
	### 不正チェック
	($gcode =~ /^\w+$/) || &admin_error("分野コードが不正です。");
	($gname) || &admin_error( "名前が入力されていません。");
	($gpos =~ /^\d+$/) || &admin_error("順番が不正です。");
	($gpos == 0) && ($gpos = 1);
	
	$gcode =~ tr/a-z/A-Z/; # 大文字に変換
	
	### 重複チェック
	push(@genres, $gcode);
	for($i = 0; $i <= $#genres; $i++){
		($genres[$i] =~ /^$gcode/i) && last;
	}
	pop(@genres);
	
	### 追加される行
	$newline = "$gcode\t$gname\t$gcom\t\n";
	
	### 新規
	if($gmode eq 'new'){
		($i > $#genres) || &admin_error("分野コード $gcode は既に使用されています。"); 
		($gpos <= @genres + 1) || &admin_error("順番が大きすぎます。");
	}
	elsif($gmode eq 'fix'){
		($i <= $#genres) || &admin_error("分野コード $gcode が見つかりません。");
		($gpos <= @genres) || &admin_error("順番が大きすぎます。");
	### 一旦削除
		splice(@genres, $i, 1);
	### 再表示用
		$tblib'F{'gread'} = 1;
		$tblib'F{'gncode'} = $gcode;
	}
	else {
		&admin_error("作業内容が不明です。");
	}
	
	### 削除の場合、対応する分野コードをデータファイルから消去
	if($tblib'F{'gdel'}){
		for($i = 0; $i <= $#datas; $i++){
			$datas[$i] =~ s/:$gcode//g;
		}
		$newfrag_datas = 1;
		### 再表示無し
		$tblib'F{'gread'} = 0;
	}
	### 新規、修正の場合挿入
	else{
		splice(@genres, $gpos - 1, 0, $newline);
	}
	
	### メッセージ
	$M{'new'} = "新しい分野 $gname を登録しました。";
	$M{'fix'} = "分野 $gname を修正しました。";
	$M{'del'} = "分野 $gname を削除しました。";
	$msg = $M{$gmode};
	
	### 更新フラグ
	$newfrag_genres = 1;
}



########## ファイルを更新する
sub update_datafile{
	($newfrag_datas) && (&tblib'updatefile($datafile, *datas));
	($newfrag_news) && (&tblib'updatefile($newfile, *news));
	($newfrag_genres) && (&tblib'updatefile($genrefile, *genres));
}



########## 表示
sub show_html{
	local($list, $htmlbuf);
	
	if($mode eq 'new'){
		$list = &html_newlist;
		($msg) || ($msg = "登録依頼されているＵＲＬ一覧を表\示しています。");
	}
	elsif($mode eq 'fix'){
		&html_fix;
		($msg) || ($msg = "ＵＲＬ登録／修正／削除用フォームを表\示しています。");
	}
	elsif($mode eq 'genre'){
		&html_genre;
		$list = &html_genrelist;
		($msg) || ($msg = "分野登録／編集／削除用フォームを表\示しています。");
	}
	
	# 表示用ハッシュ
	$C{'pwd'} = $pwd;
	$C{'newno'} = @news;
	
	$htmlbuf = "Content-type: text/html\n\n";
	
	$tpfrag = 1;
	foreach (@tps){
		(/^<TEMPLATE TYPE="(\w+)">/) && ($1 ne $mode) && ($tpfrag = 0); 
		(/^<\/TEMPLATE>/) && ($tpfrag = 1);
		($tpfrag) || next;
		
		s/#MESSAGE#/$msg/g;
		s/#LIST#/$list/g;
		s/#CHK:(\w+)#/$C{$1}/g;
		
		$htmlbuf .= $_;
	}
	print $htmlbuf;
}



########## 登録依頼されているＵＲＬの一覧
sub html_newlist{
	local($htmlbuf, $page, $type, $id);
	
	$T{'new'} = "新規登録";
	$T{'fix'} = "修正";
	$T{'del'} = "削除";
	
	foreach(@news){
		@pbuf = split("\t");
		($type) = shift(@pbuf);
		($id) = $pbuf[0];
		
		$page = &tblib'glance_page(@pbuf);
		$htmlbuf .= "
		<FONT COLOR=\"#FF0000\"><B>◆ 【$T{$type}】</B></FONT> → 
		<FONT COLOR=\"#006600\"><B>【<INPUT TYPE=\"radio\" NAME=\"$id\" VALUE=\"1\">許可
		<INPUT TYPE=\"radio\" NAME=\"$id\" VALUE=\"2\">却下】</B></FONT><BR>
		$page
		<P>
		";
	}
	
	$htmlbuf;
}



##### 分野リストの表示
sub html_genrelist{
	local($htmlbuf, $sgcode, $sgname, $sgcom, $i);
	
	$htmlbuf .= "<CENTER><TABLE BORDER=\"1\" CELLPADDING=\"1\" CELLSPACING=\"1\" BGCOLOR=\"#FFFFFF\">\n";
	$htmlbuf .= "<CAPTION ALIGN=\"center\"><B>▼ 分野一覧 ▼</B></CAPTION>\n";
	$htmlbuf .= "<TR BGCOLOR=\"#9999FF\"><TH>順番</TH><TH>コード</TH><TH>名前</TH><TH>説明</TH></TR>\n";
	
	$i = 1;
	foreach(@genres){
		($sgcode, $sgname, $sgcom) = split("\t");
		$htmlbuf .= "<TR><TD><FONT SIZE=\"2\">No. $i</FONT></TD><TD><FONT SIZE=\"2\">$sgcode</FONT></TD><TD><FONT SIZE=\"2\">$sgname</FONT></TD><TD><FONT SIZE=\"2\">$sgcom</FONT></TD></TR>\n";
		$i++;
	}
	$htmlbuf .= "</TABLE></CENTER>\n";
	
	$htmlbuf;
}



##### 情報修正用フォームの変数
sub html_fix{
	local($buf, $nid, $gbuf);
	
	### 修正
	if($tblib'F{'fread'}){
		($nid = $tblib'F{'fnid'}) || &admin_error("ID が入力されていません。");
		($nid =~ /^\d+$/) || &admin_error("IDが不正です。");
		$C{'fhead'} = "ID No.$nid 修正";
		$C{'fmode'} = "fix";
		($buf = &tblib'search_by_id($nid, *datas))
			|| &admin_error("ID No.$nid が見つかりません。");
		($C{'fid'}, $gbuf, $C{'fdate'}, $C{'furl'}, $C{'ftitle'}, $C{'fcom'}, $C{'fkey'}, $C{'fname'}, $C{'fmail'}) = split("\t", $buf);
	}
	### 新規
	else{
		$C{'fhead'} = "新規登録";
		$C{'fid'} = &tblib'make_new_id;
		$C{'fmode'} = "new";
		$C{'fdate'} = &tblib'get_time(0);
	}
	
	### ジャンル選択フォーム
	$C{'fgcode'} = &tblib'make_genre_form($gbuf);
}



##### 分野修正用フォームの変数
sub html_genre{
	local($buf, $ncode, $i);
	
	### 修正
	if($tblib'F{'gread'}){
		($ncode = $tblib'F{'gncode'}) || &admin_error("分野コードが入力されていません。");
		($ncode =~ /^\w+$/) || &admin_error("分野コードが不正です。");
		$ncode =~ tr/a-z/A-Z/; # 大文字に置換
		$C{'ghead'} = "分野コード $ncode 修正";
		$C{'gmode'} = "fix";
		$i = 1;
		foreach(@genres){
			if(/^$ncode\t/){
				$buf = $_;
				$C{'gpos'} = $i;
				last;
			}
			$i++;
		}
		($buf) || &admin_error("分野コード $ncode が見つかりません。");
		($C{'gcode'}, $C{'gname'}, $C{'gcom'}) = split("\t", $buf);
		$C{'gcode'} .= "<INPUT TYPE=\"hidden\" NAME=\"gcode\" VALUE=\"$ncode\">";
		$C{'delbox'} = "<INPUT TYPE=\"checkbox\" NAME=\"gdel\" VALUE=\"1\">この分野を削除";
	}
	### 新規
	else{
		$C{'ghead'} = "新規登録";
		$C{'gmode'} = "new";
		$C{'gcode'} = "<INPUT TYPE=\"text\" NAME=\"gcode\" SIZE=\"10\">";
		$C{'gpos'} = @genres + 1;
	}
}



##### 管理特有のエラー
sub admin_error{
	local($aemsg) = @_;
	
	print "Content-type: text/html; charset=euc-jp\n\n";
	
	print "
	<HTML><HEAD><TITLE>T-Bookmark - Admin Error!!</TITLE></HEAD>
	<BODY BGCOLOR=\"#CCCCFF\">
	<FONT SIZE=\"4\"><B>管理エラー.</B></FONT><P>
	<FONT SIZE=\"3\"><B>$aemsg</B></FONT><P>
	<FONT SIZE=\"3\">ブラウザのBackで戻ってください。</FONT><HR>
	</BODY></HTML>
	";
	
	&tblib'lock_check(1);
	
	exit;
}