package tfmlib;
#
######################################################################
###
###
###  CGIフォームメール送信 T-FormMail Ver.1.03
###     [3/3] 関数ライブラリ (tfmlib.pl)
###                                 (c) 1996-2002 Takahiro Nishida
###                                 http://www.mytools.net/
###
###
######################################################################
#
### 変数設定部 （詳細は上記ページをご覧下さい） ######################

# データディレクトリ（basedir） のパス
$basedir = ".";
# 戻り先ＵＲＬ
$backurl = "http://your.homepage/";
# 管理者メールアドレス
$admin_email = "your\@email.address";
# 入力最大バイト数
$word_max = 10240;
# 文字コード
$char_code = "sjis";
# sendmailのパス
$sendmailpath = "/usr/sbin/sendmail";

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


require "./jcode.pl";

$code = "sjis";
$verno = "1.03";
$lockfile = "$basedir/lockdir/tfm.lock";
$log_max = 20;


########## 入力の受け取り
sub parseform{
	local($buffer, $vn, $pair, @pairs);
	
	($word_max > $ENV{'CONTENT_LENGTH'}) || &error(7, "$ENV{'CONTENT_LENGTH'}/$word_max");
	
	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);
		($vn =~ /^_/) || defined($F{$vn}) || push(@vseqs, $vn);
		$F{$vn} .= $value;
	}
}



########## 日本語のデコード
sub decode{
	local($w) = @_;
	$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/\cM//g;
	$w =~ s/\n{2,}/<P>/g;
	$w =~ s/\n/<BR>/g;
	$w =~ s/"/&quot;/g;
	&jcode'convert(*w, $code);
	$w;
}



########## 改行タグを\nに
sub TagToValue{
	local($w) = @_;
	$w =~ s/<P>/\n\n/g;
	$w =~ s/<BR>/\n/g;
	&jcode'convert(*w, $code);
	$w;
}



########## エスケープ済文字を元に戻す
sub unescape{
	local($w) = @_;
	$w =~ s/&LT;/</g;
#	$w =~ s/&GT;/>/g;
	$w =~ s/&quot;/"/g;
	&jcode'convert(*w, $code);
	$w;
}



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



########### ファイルを開いて、中身を配列に代入する
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 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=\"#006600\">Powered by T-FormMail 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] = '関数のパラメータが不足しています';
	$fmid[6]  = 0;  $msg[6] = 'メールの送信に失敗しました';
	$fmid[7]  = 1;  $msg[7] = '入力文字数が多すぎます。文章を短くしてください。';
	$fmid[8]  = 1;  $msg[8] = '以下の項目の入力に誤りがあります。';
	$fmid[9]  = 0;  $msg[9] = 'コードが指定されていません。';
	$fmid[10] = 0;  $msg[10]= '指定されたコードが存在しません。';
	
	$fmsg[0] = "管理者 (<A HREF=\"mailto:$admin_email\">$admin_email</A>) に連絡してください";
	$fmsg[1] = "ブラウザのBackを押して戻ってください";
	
	$fid = $fmid[$id];
	
	print "<HTML><HEAD><TITLE>T-FormMail - Error!!</TITLE></HEAD>\n";
	print "<BODY BGCOLOR=\"#CCFFCC\">\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 &copyright;
	print "</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秒以上ロックが続いてたら自動解除
}



########## 固定の正規表現ライブラリ
sub matchingpattern{
	$PATTERN{'NUMBER'} = '^\d+$';
	$PATTERN{'WORD'} = '^\w+$';
	$PATTERN{'EMAIL'} = '^[\w\-\+\.]+\@[\w\-\+\.]+$';
	$PATTERN{'URL'} = '^http://.+$';
}


1;