#!/usr/local/bin/perl
#
######################################################################
###
###
###  CGIフォームメール送信 T-FormMail Ver.1.03
###     [1/3] メイン (tfmail.cgi)
###                                 (c) 1996-2002 Takahiro Nishida
###                                 http://www.mytools.net/
###
###
######################################################################

require './tfmlib.pl';

$DEBUG = 0;

print "Content-type: text/html\n\n";

&main;

sub main{
	&tfmlib'lock;
	&init_variables;
	&open_datafile;
	&check_input;
	&form_to_mail;
	&post_mail;
	&update_log;
	&update_files;
	&show_html;
	&tfmlib'unlock;
}



########## 変数の初期化
sub init_variables{
	$basedir = $tfmlib'basedir;
	
	$datafile = "$basedir/tfmdata.txt";
	$logfile = "$basedir/tfmlog.txt";
	
	### 付帯情報
	$time_now = &tfmlib'get_time(0, 1); # 現在時刻
	$remote_host = $ENV{'REMOTE_HOST'} || $ENV{'REMOTE_ADDR'}; # ホスト
	$server_name = $ENV{'SERVER_NAME'}; # サーバ
	$script_name = $ENV{'SCRIPT_NAME'}; # スクリプト名
}



########## データファイルのオープン
sub open_datafile{
	&tfmlib'openfile($datafile, *datas);
	&tfmlib'openfile($logfile, *logs);
}



########## 入力内容のチェック
sub check_input{
	&tfmlib'parseform;
	
	$code = $tfmlib'F{'_code'};
	$id = $tfmlib'F{'_id'};
	$email = &tfmlib'decode($tfmlib'F{'_email'});
	
	### 各種チェック
	(!$id) || ($id =~ /^\d+$/) || &tfmlib'error(3, "_id");
	($code =~ /^\w+$/) || &tfmlib'error(9);
	
	### codeに対応する設定ファイルを取得
	foreach (@datas){
		(/^$code\t/) && (($code, $sendto, $frags, $mname, $backurl, $subject, $finmsg, $color) = split("\t"));
	}
	($fsend, $femail, $fshow, $fhost) = split("", $frags);
	($bgcolor, $fontcolor, $empfontcolor, $linkcolor, $bgimage) = split(",", $color);
	($sendto) || &tfmlib'error(10);
	
	### メール入力なしの場合
	unless($email){
		# 必須ならエラー
		if($femail){
			&local_error("メールアドレスは必須です");
		}
		# 必須でないなら仮アドレス
		else{
			$email = $sendto;
		}
	}
	($email =~ /^[\w\-\+\.]+\@[\w\-\+\.]+$/)
		 || &local_error("メールアドレスが入力されていないか、形式が間違っています。");
}



########## 入力をチェックし整形する
sub form_to_mail{
	local($errbuf, $key, $name, $must, $match, $htmlval, $mailval, $formval);
	local($mark_m, $mark_i);
	
	$mark_m = "<FONT COLOR=\"#FF0000\"><B>★</B></FONT>";
	$mark_i = "<FONT COLOR=\"#000099\"><B>×</B></FONT>";
	
	### 正規表現ライブラリの読込
	&tfmlib'matchingpattern;
	
	### 入力チェック部
	@mns = split(/\s+/, $mname); # 条件を抜き出す
	foreach (@mns){
		($key, $name, $must, $match) = split("###");
		$htmlval = &tfmlib'decode($tfmlib'F{$key});
		$formval = &tfmlib'TagToValue($htmlval);
		$mailval = &tfmlib'unescape($formval);
		
		### 必須チェック
		if($must && !$mailval){
			$errbuf .= "<LI> $mark_m $name\[$key\]";
			next;
		}
		
		### 正規表現チェック
		if($match){
			$match = $tfmlib'PATTERN{$match} || $match;
			(!$mailval) || ($mailval =~ /$match/) || ($errbuf .= "<LI> $mark_i $name\[$key\] <I>($htmlval)</I>");
		}
		
		### 出力用に整形（メール、hidden、確認）
		$mformbuf .= "[$name] $mailval\n";
		$hhiddbuf .= "<INPUT TYPE=\"hidden\" NAME=\"$key\" VALUE=\"$formval\">";
		$hformbuf .= &InputToHTML($name, $htmlval);
	}
	
	### エラーがあったらその旨を表示
	if($errbuf){
		&local_error("次の項目の入力に誤りがあります。戻って修正してください。", "（$mark_m...入力必須、$mark_i...入力が正しくない、<I>カッコ内</I>は入力内容）<UL STYLE=\"list-style-type:none\">$errbuf</UL>");
	}
}


########## メールの発信
sub post_mail{
	($id) || return;
	
	local($flag);
	
	### 二重投稿のチェック
	foreach(@logs){
		if(/^$code\t$id\t/){
			(/\@/) && &local_error("二重投稿エラー<BR>既に送信されています");
			(/\tprev\t\n/) && ($flag = 1);
		}
	}
	($flag) || &local_error("IDが不正です");
	
	### メールヘッダ
	$mailbuf  = "To: $sendto\n";
	$mailbuf .= "From: $email\n";
	$mailbuf .= "Subject: [$code] $subject (ID=$id)\n";
	$mailbuf .= "Reply-To: $email\n";
	$mailbuf .= "Errors-To: $tfmlib'admin_email\n";
	$mailbuf .= "X-Mailer: T-FormMail Ver.$tfmlib'verno\n";
	$mailbuf .= "\n";
	
	### メール本文
	$mailbuf .= "このメールはフォームから送信されてきたものです\n";
	$mailbuf .= "心当たりのない場合は管理者までお問い合わせ下さい\n\n";
	$mailbuf .= "************ 入力内容 ************\n";
	$mailbuf .= $mformbuf;
	$mailbuf .= "\n";
	$mailbuf .= "*********** 投稿者情報 ***********\n";
	$mailbuf .= "E-Mail: $email\n";
	$mailbuf .= "時  刻: $time_now\n";
	($fhost) && ($mailbuf .= "ホスト: $remote_host\n");
	$mailbuf .= "Ｉ  Ｄ: $id\n";
	$mailbuf .= "\n";
	$mailbuf .= "************ 設置情報 ************\n";
	$mailbuf .= "コード: $code\n";
	$mailbuf .= "ＵＲＬ: http://$server_name$script_name\n";
	$mailbuf .= "管理者：$tfmlib'admin_email\n";
	$mailbuf .= "\n";
	$mailbuf .= "<ここがメールの末尾です>\n";
	
	### 表示用にコピー
	$hmailbuf = $mailbuf;
	### JISに変換
	&jcode'convert(*mailbuf, 'jis');
	# BR, Pタグを改行に戻す
	$mailbuf =~ s/<BR>/\n/g;
	$mailbuf =~ s/<P>/\n\n/g;
	
	### 送信
	if($DEBUG){
		open(MAIL, ">$basedir/mail.txt") || &tfmlib'error(1, "mail.txt");
	}
	else{
		open(MAIL, "| $tfmlib'sendmailpath $sendto") || &tfmlib'error(6);
	}
	print MAIL $mailbuf;
	close(MAIL);
}



########## ログの更新
sub update_log{
	
	### idがあったら投稿済
	if($id){
		$newline = "$code\t$id\t$time_now\t$remote_host\t$email\t\n";
	}
	### idが無かったらプレビュー
	else{
		$timeid = &tfmlib'get_time('', 2);
		$id = sprintf("$timeid%03d", $$ % 1000);
		$prevflag = 1;
		$newline = "$code\t$id\t$time_now\t$remote_host\tprev\t\n";
	}
	
	unshift(@logs, $newline);
	(@logs > $tfmlib'log_max) && ($#logs = $tfmlib'log_max - 1);
}



########## ファイル更新
sub update_files{
	&tfmlib'updatefile($datafile, *datas);
	&tfmlib'updatefile($logfile, *logs);
}



########## 表示
sub show_html{
	local($htitle, $hcom, $hcont, $hcopy);
	
	### prevflagがあったら確認
	if($prevflag){
		$htitle = "メール送信確認";
		($fsend) && ($hcom  = "以下の内容を <FONT COLOR=\"$empfontcolor\">$sendto</FONT> 宛てに送ります。");
		$hcom .= "内容を確認して「送信」ボタンを押して下さい。";
		$hcont  = "<TABLE>";
		($email ne $sendto) && ($hcont .= &InputToHTML("E-Mail", $email));
		($fhost) && ($hcont .= &InputToHTML("Host", $remote_host));
		$hcont .= $hformbuf;
		$hcont .= "</TABLE>";
		$hcont .= &html_hidden;
	}
	### prevflagがなかったら終了
	else{
		$htitle = "メール送信完了";
		$hcom  = $finmsg;
		$hcom .= "<P>あなたの送信ＩＤは <FONT COLOR=\"$empfontcolor\" SIZE=\"4\"><B>$id</B></FONT> です。<BR>※ 送信内容の変更、取消がある場合はこの番号をお書き添えの上、ページ管理者までご連絡下さい。";
		if($fshow){
			$hcont  = "<FONT COLOR=\"$empfontcolor\"><B>▼ メールの全文です。送信証明として保存しておくことをお勧めします。</B></FONT>";
			$hcont .= "<TABLE WIDTH=\"80%\" BORDER=\"1\" CELLPADDING=\"5\" CELLSPACING=\"0\" BGCOLOR=\"#FFFFFF\">";
			$hcont .= "<TR><TD><FONT SIZE=\"2\" COLOR=\"#000000\">";
			$hcont .= "<PRE>" . $hmailbuf . "</PRE>";
			$hcont .= "</FONT></TD></TR></TABLE>";
		}
	}
	
	$hcopy = &tfmlib'copyright;
	
	print "
	<HTML>
	<HEAD><TITLE>T-FormMail - $code</TITLE></HEAD>
	<BODY BGCOLOR=\"$bgcolor\" BACKGROUND=\"$bgimage\" LINK=\"$linkcolor\" VLINK=\"$linkcolor\" ALINK=\"$linkcolor\">
	<FONT SIZE=\"2\" COLOR=\"$fontcolor\">
	[<A HREF=\"$backurl\">戻る</A>]
	<H3>$htitle</H3>
	$hcom
	<HR SIZE=\"1\" NOSHADE>
	$hcont
	<HR SIZE=\"1\" NOSHADE>
	<DIV ALIGN=\"right\">$hcopy</DIV>
	</BODY>
	</HTML>
	";
	
}



########## 入力の確認表示用
sub InputToHTML{
	local($key, $value) = @_;
	"<TR><TD ALIGN=\"right\" VALIGN=\"top\"><FONT SIZE=\"2\" COLOR=\"$empfontcolor\"><B>[$key]</B></FONT></TD><TD><FONT SIZE=\"2\" COLOR=\"$fontcolor\">$value</FONT></TD></TR>\n";
}



########## HIDDENタグ
sub html_hidden{
	"
	<FORM METHOD=\"post\" ACTION=\"./tfmail.cgi\">
	<INPUT TYPE=\"hidden\" NAME=\"_id\" VALUE=\"$id\">
	<INPUT TYPE=\"hidden\" NAME=\"_code\" VALUE=\"$code\">
	<INPUT TYPE=\"hidden\" NAME=\"_email\" VALUE=\"$email\">
	$hhiddbuf
	<INPUT TYPE=\"submit\" VALUE=\"-- メール送信 --\">
	</FORM>
	";
}



########## 特有のエラー
sub local_error{
	local($lmsg, $com) = @_;
	
	print "
	<HTML><HEAD><TITLE>T-FormMail - Error!!</TITLE></HEAD>
	<BODY BGCOLOR=\"#CCFFCC\">
	<FONT SIZE=\"4\"><B>エラー</B></FONT><P>
	<FONT SIZE=\"3\"><B>$lmsg</B></FONT><P>
	<FONT SIZE=\"2\">$com</FONT><P>
	<FONT SIZE=\"3\">ブラウザのBackで戻ってください。</FONT><HR>
		";
	print &tfmlib'copyright;
	print "</BODY></HTML>";
	
	&tfmlib'lock_check(1);
	
	exit;
}