#!/usr/bin/perl

#------------------------------------------------------------------------------
#
# 2008.08.26
# MEGABASS様 アンケートフォーム【PC・携帯共通版】
#
# 引数 K=1 で携帯モードになります。
#
#
#
#------------------------------------------------------------------------------

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


# ↓が"1"でメール送信のデバッグモード（送信せず画面に表示する）
$MAIL_DEBUG_MODE = 0;


# -----------------------------------------------------------------------------
# 外部モジュールのインクルード

require './jcode.pl';
require './mimew.pl';
require './md5.pl';


# -----------------------------------------------------------------------------
# 全角から半角への変換の下準備
# (jcode.plを先にロードしておいてください)

$sjis  = 'Ａ-Ｚａ-ｚ０-９＠．＿ー−―  ';
$ascii = 'A-Za-z0-9@._--- ';
$euc   = jcode::euc($sjis, 'sjis');


#------------------------------------------------------------------------------
# 定数

$ANS_PATH			= './sagot7743/';			# ログを記録する場所。最後に/が必要。
$SEND_MAIL			= '/usr/sbin/sendmail';

$HTML_ROOT_URL		= 'http://www.megabass.co.jp/or-poi/';
$BACK_URL			= 'http://www.megabass.co.jp/or-poi/';
$THIS_CGI_PATH		= 'http://www.megabass.co.jp/or-poi/cgi-bin/0808_anq/exec.cgi';

$DEF_MAIL_ADDRESS	= 's.yamazaki@megabass.co.jp';
$send_mail_addr		= $DEF_MAIL_ADDRESS;

$DEBUG_MAIL_AD1		= 'test@wr-salt.com';
$DEBUG_MAIL_AD2		= 'ryoke@emeraude.co.jp';

$BCC_ADDRESS		= '';

$DEF_DATA_PATH		= './temp7743/';


#------------------------------------------------------------------------------
# システム系定数

($sec,$min,$hour, $mday,$mon,$year, $isdst,$isdst,$isdst) = localtime(time);
$year = $year + 1900;
$mon++;


# -----------------------------------------------------------------------------
# フォームからのデータを取得

use CGI;
my $query = new CGI;
@param_names= $query->param();
foreach $form_name (@param_names){
	$value = $query->param($form_name);

	$value = &sanitize($value);

# print "$form_name\t";

	$FORM{$form_name} = $value;
}

# PAGEが2より下の時はチェックボックスを1つの文字列にする
if($FORM{'PAGE'} == 2){
	#
	@temp_arry = $query->param('COLOR');
	$temp_str = '';
	foreach $temp (@temp_arry){
		if($temp_str ne ''){
			$temp_str .= "\a";
		}
		$temp_str .= $temp;
	}
	$FORM{'COLOR_STR'} = $temp_str;
	#
	@temp_arry = $query->param('CHOKA');
	$temp_str = '';
	foreach $temp (@temp_arry){
		if($temp_str ne ''){
			$temp_str .= "\a";
		}
		$temp_str .= $temp;
	}
	$FORM{'CHOKA_STR'} = $temp_str;
}


#------------------------------------------------------------------------------
# 処理開始

# 引数に"K=1"が指定されていれば携帯用のHTMLを読む。そのための前置文字列(PREFIX)を設定
if($FORM{'K'} == 1){
	# 携帯版
	$PREFIX = 'keitai_';
}else{
	# 無指定：PC
	$PREFIX = 'pc_';
}

# 古いキャッシュファイルを削除する(外部ファイルから関数呼び出し)
$setting_file = './delete_cache.pl';
if(-e $setting_file){
	require $setting_file;
	$pathmask = $DEF_DATA_PATH . '*.cgi';
	&delete_old_cache_file($pathmask, 1);
}

# シリアルが無ければ作る
if($FORM{'SERIAL'} eq ''){
	# リモートホスト取得
	$REMOTE_HOST = $ENV{'REMOTE_HOST'};
	$REMOTE_ADDR = $ENV{'REMOTE_ADDR'};
	if ($REMOTE_HOST eq '') { $REMOTE_HOST = $REMOTE_ADDR; }
	if ($REMOTE_HOST eq $REMOTE_ADDR) { $REMOTE_HOST = gethostbyaddr(pack('C4',split(/\./,$REMOTE_HOST)),2) || $REMOTE_ADDR; }
	$REFFRER = $REMOTE_HOST;

	# 使用ブラウザー取得
	$UA = $ENV{'HTTP_USER_AGENT'};

	# 日時とIDを加えて、MD5を作成
	$temp_md5_seed = sprintf("%04d%02d%02d%02d%02d%02d %s %s", $year,$mon,$mday, $hour,$min,$sec, $REFFRER,$UA);
	$FORM{'SERIAL'} = &md5sum($temp_md5_seed);
}

if($FORM{'PAGE'} < 2){
	# STEP1：入力フォームの表示

	&put_input_page('');

}elsif($FORM{'PAGE'} == 2){
	# STEP2：確認画面の表示

	&show_page2();

}elsif($FORM{'PAGE'} == 3){
	# STEP3：メール送信・ログの保存・ありがとう画面の表示

	# テンポラリファイルを読む
	$fname = $DEF_DATA_PATH . $FORM{'SERIAL'} . '.cgi';
	if(open(DATA, $fname)){
		@lines = <DATA>;
		close(DATA);

		foreach $line (@lines){
			$temp = $line;
			chomp($temp);
			($temp_key,$temp_name) = split(/\t/, $temp);
			$FORM{$temp_key} =  $temp_name;
#			$FORM{$temp_key} =~ s/<br>/\r\n/gi;
		}
	}else{
		# エラー
		print "システムエラー：テンポラリファイルを読めませんでした。時間を置いて再度送信してください。";
		exit;
	}

	# 入力チェック
	&input_value_check();

	$FORM{'SEND_DATE'}	= sprintf("%04d/%02d/%02d", $year,$mon,$mday);
	$FORM{'SEND_TIME'}	= sprintf("%02d:%02d:%02d", $hour,$min,$sec);

	# リモートホスト取得
	$REMOTE_HOST = $ENV{'REMOTE_HOST'};
	$REMOTE_ADDR = $ENV{'REMOTE_ADDR'};
	if ($REMOTE_HOST eq '') { $REMOTE_HOST = $REMOTE_ADDR; }
	if ($REMOTE_HOST eq $REMOTE_ADDR) { $REMOTE_HOST = gethostbyaddr(pack('C4',split(/\./,$REMOTE_HOST)),2) || $REMOTE_ADDR; }
	# 変数にセット
	$FORM{'REFFRER'} = $REMOTE_HOST;

	# 使用ブラウザー取得
	$FORM{'UA'} = $ENV{'HTTP_USER_AGENT'};

	$ANS_DATA = &make_ans_data();

	$temp = sprintf("%04d-%02d-%02d_%02d-%02d-%02d",$year,$mon,$mday,$hour,$min,$sec);
	$ansfname = $ANS_PATH . $temp . ".cgi";
	if(open(DATA, "> $ansfname")){
		print DATA $ANS_DATA;
		close(DATA);
	}

	# テンポラリを読んだ後のメールを送信する前にデバッグチェックをする
	$debug_mess = &check_debug_mode();

	# メール送信 for 管理者
	$rcd1 = &send_mail($send_mail_addr, $send_mail_addr, $FORM{'MAIL'},$FORM{'NAME'}, 'ホームページよりアンケートの回答がありました',$BCC_ADDRESS,0);

	if($FORM{'MAIL'} ne ''){
		$mail_title = 'アンケートへの回答ありがとうございます';
		$current_shop_name = $DEF_NAME_STR;

		# メール送信 for 回答者
		$rcd2 = &send_mail($FORM{'MAIL'}, $send_mail_addr, $send_mail_addr,$current_shop_name, $mail_title,'',1);
	}

	$readfname = './' . $PREFIX . '3_thanks.html';
	if(open(DATA, $readfname)){
		$lines = '';
		while(<DATA>){
			$lines .= $_;
		}
		close(DATA);

		$lines =~ s/!THIS_CGI!/$THIS_CGI_PATH/gi;
		$lines =~ s/!SERIAL!/$FORM{'SERIAL'}/gi;

		$lines =~ s/!NAME!/$FORM{'NAME'}/gi;
		$lines =~ s/!KANA!/$FORM{'KANA'}/gi;
		$lines =~ s/!ADDRESS!/$FORM{'ADDRESS'}/gi;
		$lines =~ s/!TEL1!/$FORM{'TEL1'}/gi;
		$lines =~ s/!TEL2!/$FORM{'TEL2'}/gi;
		$lines =~ s/!TEL3!/$FORM{'TEL3'}/gi;
		$lines =~ s/!MAIL!/$FORM{'MAIL'}/gi;
		$lines =~ s/!COMMENT!/$FORM{'COMMENT'}/gi;

		$lines =~ s/!BACK_URL!/$BACK_URL/gi;
		$lines =~ s/!DEF_TEL_NO!/$DEF_TEL_NO/gi;

		print $debug_mess;
		print $lines;
	}else{
		# 読み込めなかった
		print "CGIエラー：最終ページのベースファイルを読めませんでした。";
	}

}else{
	&put_input_page();

}


exit;













# 以下、sub
# -----------------------------------------------------------------------------
# 入力チェック
sub input_value_check
{
	if($FORM{'FIELD'} eq ''){
		$error_message = '入力エラー：フィールド欄をご入力ください';
		&put_input_page($error_message);
		exit;
	}
	if($FORM{'COLOR'} eq ''){
		$error_message = '入力エラー：カラーをお選びください';
		&put_input_page($error_message);
		exit;
	}
	if($FORM{'CHOKA'} eq ''){
		&put_input_page('入力エラー：釣果をご入力ください');
		exit;
	}
	if($FORM{'キャスタビリティ'} eq ''){
		&put_input_page('入力エラー：使用感：キャスタビリティをご選択ください');
		exit;
	}
	if($FORM{'ボディウエイト'} eq ''){
		&put_input_page('入力エラー：使用感：ボディウエイトをご選択ください');
		exit;
	}
	if($FORM{'ルアーアクション'} eq ''){
		&put_input_page('入力エラー：使用感：ルアーアクションをご選択ください');
		exit;
	}
	if($FORM{'アピール力'} eq ''){
		&put_input_page('入力エラー：使用感：アピール力をご選択ください');
		exit;
	}
	if($FORM{'ターゲットの反応'} eq ''){
		&put_input_page('入力エラー：使用感：ターゲットの反応をご選択ください');
		exit;
	}
#	if($FORM{'BODY_SIZE'} eq ''){
#		&put_input_page('入力エラー：リクエスト：ボディーサイズをご入力ください');
#		exit;
#	}
#	if($FORM{'BODY_SIZE_CB'} eq ''){
#		&put_input_page('入力エラー：リクエスト：ボディーサイズ（大・小）をお選びください');
#		exit;
#	}
#	if($FORM{'BODY_WEIGHT'} eq ''){
#		&put_input_page('入力エラー：リクエスト：ボディーウェイトをご入力ください');
#		exit;
#	}
#	if($FORM{'BODY_WEIGHT_CB'} eq ''){
#		&put_input_page('入力エラー：リクエスト：ボディーウェイト（重・軽）をお選びください');
#		exit;
#	}
	if($FORM{'SEX_CB'} eq ''){
		&put_input_page('入力エラー：性別をお選びください');
		exit;
	}
	if($FORM{'AGE'} eq '' || $FORM{'AGE'} eq '選択してください'){
		&put_input_page('入力エラー：年代をお選びください');
		exit;
	}

#	if($FORM{'MAIL'} eq ''){
#		$error_message = '入力エラー：メールアドレスをご入力ください';
#		&put_input_page($error_message);
#		exit;
#	}elsif($FORM{'MAIL'} ne $FORM{'MAIL2'}){
#		&put_input_page('入力エラー：確認欄に同じメールアドレスをご入力ください');
#		exit;
#	}else{
	if($FORM{'MAIL'} ne ''){
		my $rcd0 = 0;
		if($FORM{'MAIL'} =~ /.@/){			# 先頭以外に@がある
			if($FORM{'MAIL'} =~ /.\./){		# 先頭以外に.がある
				# OK
				$rcd0 = 1;
			}
		}
		if($rcd0 != 1){
			$error_message = '入力エラー：メールアドレスの形式が正しくないようです';
			&put_input_page($error_message);
			exit;
		}
	}

}
# -----------------------------------------------------------------------------
# 2ページ目(確認画面)の処理を実行する
#
sub show_page2
{
	# 入力チェック
	&input_value_check();

	# テンポラリに保存
	$fname = $DEF_DATA_PATH . $FORM{'SERIAL'} . '.cgi';
	if(open(DATA, "> $fname")){
		@temp_keys = keys(%FORM);
		foreach $temp_key (@temp_keys){
			$temp_value =  $FORM{$temp_key};

			$temp_value =~ s/\r\n/\n/gi;
			$temp_value =~ s/\r/\n/gi;
			$temp_value =~ s/\n/<br>/gi;

			$temp_value =~ s/\t/ /gi;

			print DATA "$temp_key\t$temp_value"."\n";
		}

		close(DATA);
	}

	$debug_mess = &check_debug_mode();

	# 表示用にトリミング
	@temp_keys = keys(%FORM);
	foreach $temp_key (@temp_keys){
		$FORM{$temp_key} =~ s/\r\n/\n/gi;
		$FORM{$temp_key} =~ s/\r/\n/gi;
		$FORM{$temp_key} =~ s/\n/<br>/gi;
		$FORM{$temp_key} =~ s/\t/ /gi;

		$FORM{$temp_key} =~ s/\a/ \/ /gi;
	}

	$BACKC_TEXT = $FORM{'BACK_COLOR'};
	if($BACKC_TEXT eq '選択してください'){
		$BACKC_TEXT = '';
	}

	$BERRYC_TEXT = $FORM{'BERRY_COLOR'};
	if($BERRYC_TEXT eq '選択してください'){
		$BERRYC_TEXT = '';
	}

	$SIDEC_TEXT = $FORM{'SIDE_COLOR'};
	if($SIDEC_TEXT eq '選択してください'){
		$SIDEC_TEXT = '';
	}

	$readfname = './' . $PREFIX . '2_confirm.html';
	if(open(DATA, $readfname)){
		$lines = '';
		while(<DATA>){
			$lines .= $_;
		}
		close(DATA);

		$lines =~ s/!THIS_CGI!/$THIS_CGI_PATH/gi;
		$lines =~ s/!SERIAL!/$FORM{'SERIAL'}/gi;
		$lines =~ s/!SYSTEM_MESSAGE!/$message/gi;

		$lines =~ s/!CHOKO_Y!/$FORM{'CHOKO_Y'}/gi;
		$lines =~ s/!CHOKO_M!/$FORM{'CHOKO_M'}/gi;
		$lines =~ s/!CHOKO_D!/$FORM{'CHOKO_D'}/gi;
		$lines =~ s/!COLOR_STR!/$FORM{'COLOR_STR'}/gi;
		$lines =~ s/!CHOKA_STR!/$FORM{'CHOKA_STR'}/gi;
		$lines =~ s/!C10!/$FORM{'キャスタビリティ'}/gi;
		$lines =~ s/!C11!/$FORM{'ボディウエイト'}/gi;
		$lines =~ s/!C12!/$FORM{'ルアーアクション'}/gi;
		$lines =~ s/!C13!/$FORM{'アピール力'}/gi;
		$lines =~ s/!C14!/$FORM{'ターゲットの反応'}/gi;
		$lines =~ s/!BACK_COLOR!/$BACKC_TEXT/gi;
		$lines =~ s/!BERRY_COLOR!/$BERRYC_TEXT/gi;
		$lines =~ s/!SIDE_COLOR!/$SIDEC_TEXT/gi;
		$lines =~ s/!BODY_SIZE_CB!/$FORM{'BODY_SIZE_CB'}/gi;
		$lines =~ s/!BODY_WEIGHT_CB!/$FORM{'BODY_WEIGHT_CB'}/gi;
		$lines =~ s/!SEX_CB!/$FORM{'SEX_CB'}/gi;
		$lines =~ s/!AGE!/$FORM{'AGE'}/gi;

		# フリー入力の欄
		$lines =~ s/!FIELD!/$FORM{'FIELD'}/gi;
		$lines =~ s/!BACK_COLOR_FREETEXT!/$FORM{'BACK_COLOR_FREETEXT'}/gi;
		$lines =~ s/!BERRY_COLOR_FREETEXT!/$FORM{'BERRY_COLOR_FREETEXT'}/gi;
		$lines =~ s/!SIDE_COLOR_FREETEXT!/$FORM{'SIDE_COLOR_FREETEXT'}/gi;
		$lines =~ s/!BODY_SIZE!/$FORM{'BODY_SIZE'}/gi;
		$lines =~ s/!BODY_WEIGHT!/$FORM{'BODY_WEIGHT'}/gi;
		$lines =~ s/!ACTION!/$FORM{'ACTION'}/gi;
		$lines =~ s/!NAME!/$FORM{'NAME'}/gi;
		$lines =~ s/!MAIL!/$FORM{'MAIL'}/gi;

		print $debug_mess;
		print $lines;
	}else{
		# 読み込めなかった
		print "CGIエラー：確認ページのベースファイルを読めませんでした。";
	}
}
# -----------------------------------------------------------------------------
# DEBUGモードかどうかのチェックをする
sub check_debug_mode
{
	my $debug_mess = '';

	if($MAIL_DEBUG_MODE){
		$debug_mess = '<font color="RED">デバッグモード：メールは送信されず画面に表示されます</font><br>';
	}

	if($FORM{'NAME'} eq 'prok'){
		$debug_mode = 1;
		$send_mail_addr  = $DEBUG_MAIL_AD1;
		$debug_mess		.= '<font color="RED">デバッグモード：メールの送信先が '. $send_mail_addr .' になります</font><br>';
#		$BCC_ADDRESS	 = $send_mail_addr;
	}
	if($FORM{'NAME'} eq 'DEBUG_ryoke'){
		$debug_mode = 1;
		$send_mail_addr	 = $DEBUG_MAIL_AD2;
		$debug_mess		.= '<font color="RED">デバッグモード：メールの送信先が '. $send_mail_addr .' になります</font><br>';
#		$BCC_ADDRESS	 = $send_mail_addr;
	}

	# 一番最後に実行
	if($debug_mess ne ''){
		$debug_mess .= '<hr><br>';
	}

	return($debug_mess);
}
# -----------------------------------------------------------------------------
# メール送信
#   $switch … 0.お店用  1.お客さん用
sub send_mail
{
	my $rcd = 1;

	my $mlto		= shift(@_);
	my $returnto	= shift(@_);
	my $mlfrom		= shift(@_);
	my $mlfrom_name	= shift(@_);
	my $mlttl		= shift(@_);
	my $bcc			= shift(@_);
	my $switch		= shift(@_);

	$encoded_subject = &mimeencode($mlttl);
	$encoded_fromname= &mimeencode($mlfrom_name);

my	$line  = "X-Mailer: Web Mail\n";
	$line .= "To: $mlto\n";
	$line .= "From: $encoded_fromname <$mlfrom>\n";
	$line .= "Reply-To: $mlfrom\n";
	$line .= "Return-Path: $returnto\n";
	$line .= "BCC: $bcc\n";
	$line .= "Subject: $encoded_subject\n";
	$line .= "Content-Transfer-Encoding: 7bit\n";
	$line .= "Content-Type: text/plain; charset=iso-2022-jp\n";
	$line .= "\n";

	$line .= &make_mail_body($switch);

	$line .= "\n";

if($MAIL_DEBUG_MODE){
	print "<pre>$line</pre>";
	return;
}

	$line = jcode::jis($line);

	if( open(MAIL, "| $SEND_MAIL -t") ){
		print MAIL $line;
		close MAIL;
	}else{
		$rcd = 0;
		print "<br>\nメール送信に失敗しました。<br>\n大変お手数ですが時間を置いて再度送信を行ってください。<br>\n";
	}

	return $rcd;
}
# -----------------------------------------------------------------------------
sub make_mail_body
{
	my $switch = shift(@_);
	my $line = '';

	my $action_text	= $FORM{'ACTION'};
	$action_text	=~ s/<br>/\n  /gi;

	# 表示用にトリミング
	@temp_keys = keys(%FORM);
	foreach $temp_key (@temp_keys){
		$FORM{$temp_key} =~ s/\r\n/\n/gi;
		$FORM{$temp_key} =~ s/\r/\n/gi;
		$FORM{$temp_key} =~ s/\n/<br>/gi;
		$FORM{$temp_key} =~ s/\t/ /gi;

		$FORM{$temp_key} =~ s/\a/ \/ /gi;
	}

	if($switch == 0){
		# 会社向け

$line = <<"EOT";
ホームページご担当者様：

ホームページよりアンケートの回答がありました。

釣行日：$FORM{'CHOKO_Y'}年$FORM{'CHOKO_M'}月$FORM{'CHOKO_D'}日
フィールド：$FORM{'FIELD'}
カラー：$FORM{'COLOR_STR'}
釣果：$FORM{'CHOKA_STR'}
使用感：
　キャスタビリティ：$FORM{'キャスタビリティ'}
　ボディウエイト：$FORM{'ボディウエイト'}
　ルアーアクション：$FORM{'ルアーアクション'}
　アピール力：$FORM{'アピール力'}
　ターゲットの反応：$FORM{'ターゲットの反応'}
カラー：
　バックカラー：$FORM{'BACK_COLOR'}
　　その他：$FORM{'BACK_COLOR_FREETEXT'}
　バックカラー：$FORM{'SIDE_COLOR'}
　　その他：$FORM{'SIDE_COLOR_FREETEXT'}
リクエスト：
　現在のボディーサイズより $FORM{'BODY_SIZE'} mm $FORM{'BODY_SIZE_CB'}
　現在のボディーウェイトより $FORM{'BODY_WEIGHT'} mm $FORM{'BODY_WEIGHT_CB'}
ルアーアクション：
  $action_text
氏名：$FORM{'NAME'}
性別：$FORM{'SEX_CB'}
年代：$FORM{'AGE'}
メール：$FORM{'MAIL'}

送信日時：$FORM{'SEND_DATE'} - $FORM{'SEND_TIME'}

EOT

	}else{
		# 問い合わせた人向け

		$A1 = $FORM{'ADDRESS'};
		if($A1 ne ''){
			$A1 = &z_substr($A1,0,4,2); 
			$A1 = $A1 . '****';
		}

$line = <<"EOT";

※このメールはホームページより自動送信しております。
※このメールにご返信頂いてもメールを受け取ることができません。


ホームページよりアンケートの回答を頂き誠にありがとうございます。
下記の内容でアンケートの回答を承りました。

■入力内容

釣行日：$FORM{'CHOKO_Y'}年$FORM{'CHOKO_M'}月$FORM{'CHOKO_D'}日
フィールド：$FORM{'FIELD'}
カラー：$FORM{'COLOR_STR'}
釣果：$FORM{'CHOKA_STR'}
使用感：
　キャスタビリティ：$FORM{'キャスタビリティ'}
　ボディウエイト：$FORM{'ボディウエイト'}
　ルアーアクション：$FORM{'ルアーアクション'}
　アピール力：$FORM{'アピール力'}
　ターゲットの反応：$FORM{'ターゲットの反応'}
カラー：
　バックカラー：$FORM{'BACK_COLOR'}
　　その他：$FORM{'BACK_COLOR_FREETEXT'}
　ベリーカラー：$FORM{'SIDE_COLOR'}
　　その他：$FORM{'SIDE_COLOR_FREETEXT'}
リクエスト：
　現在のボディーサイズより $FORM{'BODY_SIZE'} mm $FORM{'BODY_SIZE_CB'}
　現在のボディーウェイトより $FORM{'BODY_WEIGHT'} g $FORM{'BODY_WEIGHT_CB'}
ルアーアクション：
　$action_text;
氏名：$FORM{'NAME'}
性別：$FORM{'SEX_CB'}
年代：$FORM{'AGE'}
メール：$FORM{'MAIL'}


アンケートのご回答誠にありがとうございました。

$DEF_NAME_STR
---- ----
$DEF_ADDRESS_STR
 TEL: $DEF_TEL_NO
MAIL: $DEF_MAIL_ADDRESS
 WEB: $HTML_ROOT_URL
EOT
	}

	# 逆サニタイズ
	$line =~ s/&lt;/</gi;
	$line =~ s/&gt;/>/gi;

	return($line);
}
# ----------------------------------------------------------------------------
# 全角対応のsubstr
# z_substr(文字列, 開始位置(0~), 切り出す文字数, "2"で2バイト文字を1文字と数える);
sub z_substr
{
	local($s,$p,$l,$o) = @_;
	$s =~ s/(.)/$1\0/g;
	$s =~ s/([\x81-\x9f\xe0-\xfc])\0(.)\0/$o==2?"$1$2":"$1$2\0\0"/eg;
	$s = $l eq '' ? substr($s,$p*2):substr($s,$p*2,$l*2);
	if ($o==1) { $s =~ s/^\0\0/ /; $s =~ s/.[^\0]$/ /;}
	$s =~ tr/\0//d;
	$s;
}
# -----------------------------------------------------------------------------
# 入力ページを表示する
sub put_input_page
{
	my $message = shift(@_);

	if($message ne ''){
		$temp_value = int($FORM{'K'});
		if($temp_value == 0){
			# PCサイト
$SYSTEM_MESSAGE_TAG = qq(
<table width="738" border="0" align="center" cellpadding="5" cellspacing="1" bgcolor="#FFFFFF">
  <tr>
    <td bgcolor="#FF0000" class="normal_white" align="center">$message</td>
  </tr>
</table>
);
		}else{
			$SYSTEM_MESSAGE_TAG = qq(<font color="#FF0000">$message</font><br>);
		}
	}

	# 全入力データの中から<br>の部分を\nに変換する(テキストボックス用)
	@ARRY_FORM_KEYS = keys(%FORM);
	foreach $name (@ARRY_FORM_KEYS){
		$FORM{$name} =~ s/<br>/\n/gi;
	}

	# エラーメッセージが無いときはPAGE=3から戻ってきた時（かHTMLから呼ばれた時）なのでテンポラリを読んでみる
	if($message eq ''){
		$fname = $DEF_DATA_PATH . $FORM{'SERIAL'} . '.cgi';
		if(open(DATA, $fname)){
			@lines = <DATA>;
			close(DATA);

			foreach $line (@lines){
				$temp = $line;
				chomp($temp);
				($temp_key,$temp_name) = split(/\t/, $temp);
#				$REC{$temp_key} = $temp_name;
				$FORM{$temp_key} =  $temp_name;
				$FORM{$temp_key} =~ s/<br>/\r\n/gi;
			}
		}
	}

	$debug_mess = &check_debug_mode();

	# 釣行日のselect tag
	# 年
	$temp_tags = '';
	$now_y = int($FORM{'CHOKO_Y'});
	if($now_y == 0){
		$now_y = $year;
	}
	# 前後1ヶ月
	for($i=-1; $i<2; $i++){
		$select_y = $year + $i;
		if($select_y == $now_y){
			$element = ' selected';
		}else{
			$element = '';
		}
		$temp_tags .= qq(  <option$element>$select_y</option>\n);
	}
	$temp_tags  = qq(<select name="CHOKO_Y" id="CHOKO_Y">\n) . $temp_tags;
	$temp_tags .= qq(</select>\n);
	$CHOKO_Y_TAGS = $temp_tags;

	# 月
	$temp_tags = '';
	$now_m = int($FORM{'CHOKO_M'});
	if($now_m == 0){
		$now_m = $mon;
	}
	for($i=1; $i<13; $i++){
		if($i == $now_m){
			$element = ' selected';
		}else{
			$element = '';
		}
		$temp_tags .= qq(  <option$element>$i</option>\n);
	}
	$temp_tags  = qq(<select name="CHOKO_M" id="CHOKO_M">\n) . $temp_tags;
	$temp_tags .= qq(</select>\n);
	$CHOKO_M_TAGS = $temp_tags;

	# 日
	$temp_tags = '';
	$now_d = int($FORM{'CHOKO_D'});
	if($now_d == 0){
		$now_d = $mday;
	}
	for($i=1; $i<32; $i++){
		if($i == $now_d){
			$element = ' selected';
		}else{
			$element = '';
		}
		$temp_tags .= qq(  <option$element>$i</option>\n);
	}
	$temp_tags  = qq(<select name="CHOKO_D" id="CHOKO_D">\n) . $temp_tags;
	$temp_tags .= qq(</select>\n);
	$CHOKO_D_TAGS = $temp_tags;

	# selectタグ(特殊タグを置き換え版)
	#
	$temp_tag_name = 'BACK_COLOR';
	if($FORM{$temp_tag_name} eq 'ピンク系'){
		$C1{'B'} = ' selected';
	}elsif($FORM{$temp_tag_name} eq 'ブラック系'){
		$C1{'C'} = ' selected';
	}elsif($FORM{$temp_tag_name} eq 'ブルー系'){
		$C1{'D'} = ' selected';
	}elsif($FORM{$temp_tag_name} eq 'パープル系'){
		$C1{'E'} = ' selected';
	}elsif($FORM{$temp_tag_name} eq 'その他'){
		$C1{'F'} = ' selected';
	}else{
		$C1{'A'} = ' selected';
	}
	#
	$temp_tag_name = 'BERRY_COLOR';
	if($FORM{$temp_tag_name} eq 'ホワイト系'){
		$C2{'B'} = ' selected';
	}elsif($FORM{$temp_tag_name} eq 'オレンジ系'){
		$C2{'C'} = ' selected';
	}elsif($FORM{$temp_tag_name} eq 'レッド系'){
		$C2{'D'} = ' selected';
	}else{
		$C2{'A'} = ' selected';
	}
	#
	$temp_tag_name = 'SIDE_COLOR';
	if($FORM{$temp_tag_name} eq 'ホログラムシルバー系'){
		$C3{'B'} = ' selected';
	}elsif($FORM{$temp_tag_name} eq 'アルミ系'){
		$C3{'C'} = ' selected';
	}elsif($FORM{$temp_tag_name} eq 'シースルー系'){
		$C3{'D'} = ' selected';
	}else{
		$C3{'A'} = ' selected';
	}
	#
	$temp_tag_name = 'AGE';
	if($FORM{$temp_tag_name} eq '18歳未満'){
		$C4{'B'} = ' selected';
	}elsif($FORM{$temp_tag_name} eq '18〜19歳'){
		$C4{'C'} = ' selected';
	}elsif($FORM{$temp_tag_name} eq '20〜29歳'){
		$C4{'D'} = ' selected';
	}elsif($FORM{$temp_tag_name} eq '30〜39歳'){
		$C4{'E'} = ' selected';
	}elsif($FORM{$temp_tag_name} eq '40〜49歳'){
		$C4{'F'} = ' selected';
	}elsif($FORM{$temp_tag_name} eq '50〜59歳'){
		$C4{'G'} = ' selected';
	}elsif($FORM{$temp_tag_name} eq '60〜69歳'){
		$C4{'H'} = ' selected';
	}elsif($FORM{$temp_tag_name} eq '70歳以上'){
		$C4{'I'} = ' selected';
	}else{
		$C4{'A'} = ' selected';
	}

	# カラー（複数回答可）
	@temp_arry = split(/\a/, $FORM{'COLOR_STR'});
	foreach $temp_value (@temp_arry){
		if($temp_value eq 'G MAIWASHI'){
			$C5{'A'} = ' checked';
		}
		if($temp_value eq 'G CORAL PINK FLAS'){
			$C5{'B'} = ' checked';
		}
		if($temp_value eq 'G TOBIUO MIRROR FIN'){
			$C5{'C'} = ' checked';
		}
		if($temp_value eq 'G DEEP BLUE FLASH'){
			$C5{'D'} = ' checked';
		}
		if($temp_value eq 'G SEGURO IWASHI'){
			$C5{'E'} = ' checked';
		}
		if($temp_value eq 'G PEN PEN GOLD FLASH'){
			$C5{'F'} = ' checked';
		}
	}
	# 釣果（複数回答可）
	@temp_arry = split(/\a/, $FORM{'CHOKA_STR'});
	foreach $temp_value (@temp_arry){
		if($temp_value eq 'シイラ'){
			$C6{'A'} = ' checked';
		}
		if($temp_value eq 'キハダ'){
			$C6{'B'} = ' checked';
		}
		if($temp_value eq 'カツオ'){
			$C6{'C'} = ' checked';
		}
		if($temp_value eq 'メジ'){
			$C6{'D'} = ' checked';
		}
		if($temp_value eq 'クロマグロ'){
			$C6{'E'} = ' checked';
		}
		if($temp_value eq 'ブリ'){
			$C6{'F'} = ' checked';
		}
		if($temp_value eq 'ヒラマサ'){
			$C6{'G'} = ' checked';
		}
		if($temp_value eq 'カンパチ'){
			$C6{'H'} = ' checked';
		}
		if($temp_value eq 'セイルフィッシュ'){
			$C6{'I'} = ' checked';
		}
		if($temp_value eq 'その他'){
			$C6{'J'} = ' checked';
		}
	}
	# RADIO BUTTON
	$temp_tag_name = 'BODY_SIZE_CB';
	if($FORM{$temp_tag_name} eq '小さく'){
		$C7{'B'} = ' checked';
	}elsif($FORM{$temp_tag_name} eq '大きく'){
		$C7{'A'} = ' checked';
	}
	# RADIO BUTTON
	$temp_tag_name = 'BODY_WEIGHT_CB';
	if($FORM{$temp_tag_name} eq '軽く'){
		$C8{'B'} = ' checked';
	}elsif($FORM{$temp_tag_name} eq '重く'){
		$C8{'A'} = ' checked';
	}
	# RADIO BUTTON
	$temp_tag_name = 'SEX_CB';
	if($FORM{$temp_tag_name} eq '女'){
		$C9{'B'} = ' checked';
	}elsif($FORM{$temp_tag_name} eq '男'){
		$C9{'A'} = ' checked';
	}

	#
	$temp_tag_name = 'キャスタビリティ';
	if($FORM{$temp_tag_name} eq 'かなり良い'){
		$C10{'A'} = 'checked';
	}elsif($FORM{$temp_tag_name} eq '良い'){
		$C10{'B'} = 'checked';
	}elsif($FORM{$temp_tag_name} eq '普通'){
		$C10{'C'} = 'checked';
	}elsif($FORM{$temp_tag_name} eq '程々'){
		$C10{'D'} = 'checked';
	}elsif($FORM{$temp_tag_name} eq '悪い'){
		$C10{'E'} = 'checked';
	}
	#
	$temp_tag_name = 'ボディウエイト';
	if($FORM{$temp_tag_name} eq 'かなり良い'){
		$C11{'A'} = 'checked';
	}elsif($FORM{$temp_tag_name} eq '良い'){
		$C11{'B'} = 'checked';
	}elsif($FORM{$temp_tag_name} eq '程々'){
		$C11{'D'} = 'checked';
	}elsif($FORM{$temp_tag_name} eq '悪い'){
		$C11{'E'} = 'checked';
	}elsif($FORM{$temp_tag_name} eq '普通'){
		$C11{'C'} = 'checked';
	}
	#
	$temp_tag_name = 'ルアーアクション';
	if($FORM{$temp_tag_name} eq 'かなり良い'){
		$C12{'A'} = 'checked';
	}elsif($FORM{$temp_tag_name} eq '良い'){
		$C12{'B'} = 'checked';
	}elsif($FORM{$temp_tag_name} eq '程々'){
		$C12{'D'} = 'checked';
	}elsif($FORM{$temp_tag_name} eq '悪い'){
		$C12{'E'} = 'checked';
	}elsif($FORM{$temp_tag_name} eq '普通'){
		$C12{'C'} = 'checked';
	}
	#
	$temp_tag_name = 'アピール力';
	if($FORM{$temp_tag_name} eq 'かなり良い'){
		$C13{'A'} = 'checked';
	}elsif($FORM{$temp_tag_name} eq '良い'){
		$C13{'B'} = 'checked';
	}elsif($FORM{$temp_tag_name} eq '程々'){
		$C13{'D'} = 'checked';
	}elsif($FORM{$temp_tag_name} eq '悪い'){
		$C13{'E'} = 'checked';
	}elsif($FORM{$temp_tag_name} eq '普通'){
		$C13{'C'} = 'checked';
	}
	#
	$temp_tag_name = 'ターゲットの反応';
	if($FORM{$temp_tag_name} eq 'かなり良い'){
		$C14{'A'} = 'checked';
	}elsif($FORM{$temp_tag_name} eq '良い'){
		$C14{'B'} = 'checked';
	}elsif($FORM{$temp_tag_name} eq '程々'){
		$C14{'D'} = 'checked';
	}elsif($FORM{$temp_tag_name} eq '悪い'){
		$C14{'E'} = 'checked';
	}elsif($FORM{$temp_tag_name} eq '普通'){
		$C14{'C'} = 'checked';
	}

	$readfname = './' . $PREFIX . '1_input.html';
	if(open(DATA, $readfname)){
		$lines = '';
		while(<DATA>){
			$lines .= $_;
		}
		close(DATA);

		$lines =~ s/!THIS_CGI!/$THIS_CGI_PATH/gi;
		$lines =~ s/!SYSTEM_MESSAGE_TAG!/$SYSTEM_MESSAGE_TAG/gi;
		$lines =~ s/!SERIAL!/$FORM{'SERIAL'}/gi;

		# SELECT BOX
		$lines =~ s/!CHOKO_Y_TAG!/$CHOKO_Y_TAGS/gi;
		$lines =~ s/!CHOKO_M_TAG!/$CHOKO_M_TAGS/gi;
		$lines =~ s/!CHOKO_D_TAG!/$CHOKO_D_TAGS/gi;
		#
		$lines =~ s/!C1A!/$C1{'A'}/gi;
		$lines =~ s/!C1B!/$C1{'B'}/gi;
		$lines =~ s/!C1C!/$C1{'C'}/gi;
		$lines =~ s/!C1D!/$C1{'D'}/gi;
		$lines =~ s/!C1E!/$C1{'E'}/gi;
		$lines =~ s/!C1F!/$C1{'F'}/gi;
		#
		$lines =~ s/!C2A!/$C2{'A'}/gi;
		$lines =~ s/!C2B!/$C2{'B'}/gi;
		$lines =~ s/!C2C!/$C2{'C'}/gi;
		$lines =~ s/!C2D!/$C2{'D'}/gi;
		#
		$lines =~ s/!C3A!/$C3{'A'}/gi;
		$lines =~ s/!C3B!/$C3{'B'}/gi;
		$lines =~ s/!C3C!/$C3{'C'}/gi;
		$lines =~ s/!C3D!/$C3{'D'}/gi;
		#
		$lines =~ s/!C4A!/$C4{'A'}/gi;
		$lines =~ s/!C4B!/$C4{'B'}/gi;
		$lines =~ s/!C4C!/$C4{'C'}/gi;
		$lines =~ s/!C4D!/$C4{'D'}/gi;
		$lines =~ s/!C4E!/$C4{'E'}/gi;
		$lines =~ s/!C4F!/$C4{'F'}/gi;
		$lines =~ s/!C4G!/$C4{'G'}/gi;
		$lines =~ s/!C4H!/$C4{'H'}/gi;
		$lines =~ s/!C4I!/$C4{'I'}/gi;
		# カラー（複数回答可）
		$lines =~ s/!C5A!/$C5{'A'}/gi;
		$lines =~ s/!C5B!/$C5{'B'}/gi;
		$lines =~ s/!C5C!/$C5{'C'}/gi;
		$lines =~ s/!C5D!/$C5{'D'}/gi;
		$lines =~ s/!C5E!/$C5{'E'}/gi;
		$lines =~ s/!C5F!/$C5{'F'}/gi;
		# 釣果（複数回答可）
		$lines =~ s/!C6A!/$C6{'A'}/gi;
		$lines =~ s/!C6B!/$C6{'B'}/gi;
		$lines =~ s/!C6C!/$C6{'C'}/gi;
		$lines =~ s/!C6D!/$C6{'D'}/gi;
		$lines =~ s/!C6E!/$C6{'E'}/gi;
		$lines =~ s/!C6F!/$C6{'F'}/gi;
		$lines =~ s/!C6G!/$C6{'G'}/gi;
		$lines =~ s/!C6H!/$C6{'H'}/gi;
		$lines =~ s/!C6I!/$C6{'I'}/gi;
		$lines =~ s/!C6J!/$C6{'J'}/gi;
		# ボディーサイズ
		$lines =~ s/!C7A!/$C7{'A'}/gi;
		$lines =~ s/!C7B!/$C7{'B'}/gi;
		# ボディーウェイト
		$lines =~ s/!C8A!/$C8{'A'}/gi;
		$lines =~ s/!C8B!/$C8{'B'}/gi;
		# 性別
		$lines =~ s/!C9A!/$C9{'A'}/gi;
		$lines =~ s/!C9B!/$C9{'B'}/gi;
		#
		$lines =~ s/!C10A!/$C10{'A'}/gi;
		$lines =~ s/!C10B!/$C10{'B'}/gi;
		$lines =~ s/!C10C!/$C10{'C'}/gi;
		$lines =~ s/!C10D!/$C10{'D'}/gi;
		$lines =~ s/!C10E!/$C10{'E'}/gi;
		#
		$lines =~ s/!C11A!/$C11{'A'}/gi;
		$lines =~ s/!C11B!/$C11{'B'}/gi;
		$lines =~ s/!C11C!/$C11{'C'}/gi;
		$lines =~ s/!C11D!/$C11{'D'}/gi;
		$lines =~ s/!C11E!/$C11{'E'}/gi;
		#
		$lines =~ s/!C12A!/$C12{'A'}/gi;
		$lines =~ s/!C12B!/$C12{'B'}/gi;
		$lines =~ s/!C12C!/$C12{'C'}/gi;
		$lines =~ s/!C12D!/$C12{'D'}/gi;
		$lines =~ s/!C12E!/$C12{'E'}/gi;
		#
		$lines =~ s/!C13A!/$C13{'A'}/gi;
		$lines =~ s/!C13B!/$C13{'B'}/gi;
		$lines =~ s/!C13C!/$C13{'C'}/gi;
		$lines =~ s/!C13D!/$C13{'D'}/gi;
		$lines =~ s/!C13E!/$C13{'E'}/gi;
		#
		$lines =~ s/!C14A!/$C14{'A'}/gi;
		$lines =~ s/!C14B!/$C14{'B'}/gi;
		$lines =~ s/!C14C!/$C14{'C'}/gi;
		$lines =~ s/!C14D!/$C14{'D'}/gi;
		$lines =~ s/!C14E!/$C14{'E'}/gi;

		# フリー入力の欄
		$lines =~ s/!FIELD!/$FORM{'FIELD'}/gi;
		$lines =~ s/!BACK_COLOR_FREETEXT!/$FORM{'BACK_COLOR_FREETEXT'}/gi;
		$lines =~ s/!BERRY_COLOR_FREETEXT!/$FORM{'BERRY_COLOR_FREETEXT'}/gi;
		$lines =~ s/!SIDE_COLOR_FREETEXT!/$FORM{'SIDE_COLOR_FREETEXT'}/gi;
		$lines =~ s/!BODY_SIZE!/$FORM{'BODY_SIZE'}/gi;
		$lines =~ s/!BODY_WEIGHT!/$FORM{'BODY_WEIGHT'}/gi;
		$lines =~ s/!ACTION!/$FORM{'ACTION'}/gi;
		$lines =~ s/!NAME!/$FORM{'NAME'}/gi;
		$lines =~ s/!MAIL!/$FORM{'MAIL'}/gi;

		print $debug_mess;
		print $lines;

	}else{
		# 読み込めなかった
		print "CGIエラー：入力ページのベースファイルを読めませんでした。";
	}
}
# -----------------------------------------------------------------------------
# ファイルに保存する用のデータを作る
sub make_ans_data
{
	my $tag = '';
	my ($name,$value);

	@ARRY_FORM_KEYS = keys(%FORM);
	@ARRY_FORM_KEYS = sort(@ARRY_FORM_KEYS);
	foreach $name (@ARRY_FORM_KEYS){
		# 列挙した連想配列キーは無視する
		if($name eq 'Submit'){
		}elsif($name eq 'PAGE'){
		}elsif($name eq 'NAME'){
		}elsif($name eq 'MAIL'){
		}else{
			$value = $FORM{$name};
			$tag .= "$name\t$value"."\n";
		}
	}

	return $tag;
}
#-----------------------------------------------------------------------------
# 全角から半角への変換
# 変換できるのはローマ字と数字、記号の一部
# $sjis,$euc,$asciiのサンプル文字列、および、jcode.plが必要
sub zen2han
{
	my $str = shift(@_);

	$str = jcode::euc($str, 'sjis');
	$str = jcode::trans($str, $euc, $ascii);
	$str = jcode::sjis($str);

	return($str);
}
# -----------------------------------------------------------------------------
# 文字列のサニタイズ
sub sanitize
{
	my $value = shift(@_);

	$value =~ s/\t/ /gi;

	$value =~ s/</&lt;/gi;
	$value =~ s/>/&gt;/gi;

	$value =~ s/&/&amp;/g;
	$value =~ s/"/&quot;/g;
	$value =~ s/'/&#x27;/g;

	return($value);
}
# -----------------------------------------------------------------------------



1;