package tblib;
#
######################################################################
###
###
###  CGIリンク集管理システム T-Bookmark Ver.1.10
###     [4/4] 関数ライブラリ (tblib.pl)
###                                 (c) 1996-2000 Takahiro Nishida
###                                 http://www.mytools.net/
###
###
######################################################################
#
### 変数設定部 （詳細は上記ページをご覧下さい） ######################

# データディレクトリ（basedir） のパス
$basedir = ".";
# 戻り先ＵＲＬ
$backurl = "http://your.homepage/address/";
# 管理者メールアドレス
$admin_email = "your\@email.address";
# 漢字コード
$code = "sjis";

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


require "./jcode.pl";

$verno = "1.10";
$lockfile = "$basedir/lockdir/tb.lock";
$genrefile = "$basedir/tbgenre.txt";



########## 入力の受け取り
sub parseform{
	local($buffer, $vn, $pair, @pairs);
	
	if ($ENV{'REQUEST_METHOD'} eq "POST") {
		read(STDIN, $buffer, $ENV{'CONTENT_LENGTH'});
	}
	else {
		$buffer = $ENV{'QUERY_STRING'};
	}
	@pairs = split(/&/, $buffer);
	foreach $pair (@pairs) {
		($vn, $value) = split(/=/, $pair);
		$F{$vn} .= $value;
	}
}



########## 日本語のデコード
sub decode{
	local($w, $codeto) = @_;
	
	($codeto) && ($code = $codeto);
	
	$w =~ tr/+/ /;
	$w =~ s/%([a-fA-F0-9][a-fA-F0-9])/pack("C", hex($1))/eg;
	$w =~ s/\t//g;
	$w =~ s/</&LT;/g;
	$w =~ s/>/&GT;/g;
#	$w =~ s/\(/&#40;/g;
#	$w =~ s/\)/&#41;/g;
#	$w =~ s/\*/&#42;/g;
#	$w =~ s/\?/&#63;/g;
#	$w =~ s/\[/&#91;/g;
#	$w =~ s/\\/&#92;/g;
#	$w =~ s/\]/&#93;/g;
#	$w =~ s/\{/&#123;/g;
#	$w =~ s/\|/&#124;/g;
#	$w =~ s/\}/&#125;/g;
	
	&jcode'convert(*w, $code);
	$w;
}



##### 現在の時刻を得る
sub get_time{
	local($tsec, $format) = @_;
	($tsec) || ($tsec = time());
	local($sec, $min, $hour, $mday, $mon, $year) = localtime($tsec);
	$mon++;
	$year += 1900;
	($format) || return sprintf("%04d/%02d/%02d", $year, $mon, $mday);
	($format == 1) && return sprintf("%04d%02d%02d%02d%02d%02d", $year, $mon, $mday, $hour, $min, $sec);
	($format == 2) && return sprintf("%04d/%02d/%02d %02d:%02d", $year, $mon, $mday, $hour, $min);
}



###### ファイルを開いて、中身を配列に代入する
sub openfile{
	local ($filename, *buf, $frag) = @_;
	open(FILE, "$filename") || $frag || &error(1, $filename);
	@buf = <FILE>;
	close(FILE);
	
	(@buf) ? return(1) : return(0);
}



###### ファイルを更新する
sub updatefile{
	local ($filename, *buf, $frag) = @_;
	
	# フラグあり→追加、なし→更新
	if($frag){
		open(FILE, ">>$filename") || &error(1, $filename);
	}
	else{
		open(FILE, ">$filename") || &error(1, $filename);
	}
	print FILE @buf;
	close(FILE);
}





############### 検索関数：ここから ###############
##### ＩＤ検索
sub search_by_id{
	local($id, *datas) = @_;
	
	foreach(@datas){
		(/^$id\t/) && (return $_);
	}
}
############### 検索関数：ここまで ###############





########## 分野定義部分を抜き出す
sub set_genre{
	local(*genres) = @_;
	local($code, $gname);
	
	(@genres) || &openfile($genrefile, *genres);
	
	foreach(@genres){
		(/^\w/) || next;
		($code, $gname) = split("\t");
		$G{$code} = $gname;
	}
}



########## 分野選択用フォーム
sub make_genre_form{
	local($gbuf) = @_;
	local($htmlbuf, @gs, $code, $name, $com, $check);
	
	&openfile($genrefile, *genres);
	
	@gs = split(/:/, $gbuf);
	# 頭が ":" で始まっていた場合、先頭を捨てる
	($gs[0]) || shift(@gs);
	
	foreach(@genres){
		(/^\w/) || next;
		($code, $name, $com) = split("\t");
		
		$check = "";
		if($gs[0] eq $code){
			$check = " CHECKED";
			shift(@gs);
		}
		
		$htmlbuf .= "<INPUT TYPE=\"checkbox\" NAME=\"gcode\" VALUE=\"$code:\"$check>$name（$com）<BR>\n";
	}
	
	$htmlbuf;
}



########## 新ＩＤの生成
sub make_new_id {
	local($idate, $ips);
	
	$idate = &get_time(0, 1);
	$ips = sprintf("%02d", $$ % 100); # プロセス番号の下二桁
	
	return $idate.$ips;
}



########## 登録内容を簡易表示
sub glance_page{
	local($id, $gcode, $date, $url, $title, $com, $keys, $name, $mail, $serv) = @_;
	local(@gs, $gbuf);
	
	@gs = split(":", $gcode);
	foreach (@gs){
		($_) && ($gbuf .= " [$G{$_}]");
	}
		
	$htmlbuf = "
	・[日付] $date<BR>
	・[ＩＤ] $id<BR>
	・[タイトル] <B>$title</B><BR>
	・[ＵＲＬ] <A HREF=\"$url\" TARGET=\"_blank\">$url</A><BR>
	・[分野] <FONT COLOR=\"#000099\">$gbuf</FONT><BR>
	・[キーワード] $keys<BR>
	・[紹介文] $com<BR>
	・[登録者] $name ($mail) [$serv]<BR>
	";
}



########## コピーライト
sub copyright{
	"
<TABLE ALIGN=\"right\" BORDER=\"1\" CELLPADDING=\"0\" CELLSPACING=\"2\">
<TR><TH BGCOLOR=\"#FFFFCC\">
<A HREF=\"http://www.mytools.net/\" TARGET=\"_top\">
<FONT SIZE=\"2\" COLOR=\"#000000\">Powered by T-Bookmark Ver.$verno</A>
</FONT></TH></TR></TABLE>
	";
}



########## ロック（symlink使用）
sub lock{
	$try = 3;
	while(!symlink("$$", $lockfile)){
		(--$try > 0) || &error(0);
		sleep(1);
	}
}



########## ロック（symlinkが使えないサーバ（Windows系）用、弱い）
#sub lock{
#	$try = 3;
#	while(-f $lockfile){
#		(--$try > 0) || &error(0);
#		sleep(1);
#	}
#	open(FILE,">$lockfile") || &error(2, $lockfile);
#	close(FILE);
#}



########## ロック解除
sub unlock{
	unlink($lockfile);
}



########## 汎用エラーメッセージ
sub error{
	local($id, $file, $emsg) = @_;
	
	$fmid[0]  = 1;  $msg[0] = 'ロック中です';
	$fmid[1]  = 0;  $msg[1] = 'データファイルが開けません';
	$fmid[2]  = 0;  $msg[2] = 'データファイルに書き込めません';
	$fmid[3]  = 1;  $msg[3] = '変数が取得できません';
	$fmid[4]  = 0;  $msg[4] = 'データファイルが壊れています';
	$fmid[5]  = 1;  $msg[5] = '関数のパラメータが不足しています';
	
	$fmsg[0] = "管理者 (<A HREF=\"mailto:$admin_email\">$admin_email</A>) に連絡してください";
	$fmsg[1] = "Backを押して戻ってください";
	
	$fid = $fmid[$id];
	
	print "Content-type: text/html\n\n";
	
	print "<HTML><HEAD><TITLE>T-Bookmark - Error!!</TITLE></HEAD>\n";
	print "<BODY BGCOLOR=\"#CCCCFF\">\n";
	print "<FONT SIZE=\"4\"><B>エラー発生.</B></FONT><P>\n";
	print "<FONT SIZE=\"3\"><B>$msg[$id]</B>($file)</FONT>\n";
	($emsg) && print "<BR><FONT SIZE=\"3\">$emsg</FONT>\n";
	print "<P><FONT SIZE=\"3\">$fmsg[$fid]</FONT><HR>\n";
	print "[<A HREF=\"$backurl\">戻る</A>]</BODY></HTML>";
	
	&lock_check;
	
	exit;
}



########## ロックチェック
sub lock_check{
	local($lc) = @_;
	local(@sts) = lstat($lockfile);
	local($tn) = time();
	
	($id) && &unlock; # IDが0以外はロック解除
	($lc) && &unlock; # $lcがあったらロック解除
	($tn - $sts[9] < 15) || &unlock; # 約15秒以上ロックが続いてたら自動解除
}



1;