#!/usr/bin/perl

#**********************************************************************************************************************
#		アトラス号目撃情報ＢＢＳ用サブルーチン群
#**********************************************************************************************************************


######################### デフォルトデータ設定 ########################################################################
#
#######################################################################################################################
sub default_data {
	#************************************************************各種環境変数データ
	$host = $ENV{'REMOTE_HOST'};
	$ref = $ENV{'HTTP_REFERER'};				#１個前のＵＲＬ
	$ip = $ENV{'REMOTE_ADDR'};
	$burauza = $ENV{'HTTP_USER_AGENT'};
	$time = &GetTime();
	#************************************************************
}

#######################################################################################################################


######################### フォームデータデコード ######################################################################
#
#######################################################################################################################
sub form_data_decode {
	($hash_ref, $array_ref) = @_;
	@pairs = ();
	$buf = "";
	$name = "";
	$value = "";
	
	#ぽすとー
	if ($ENV{'REQUEST_METHOD'} eq 'POST') {
		read(STDIN, $buf, $ENV{'CONTENT_LENGTH'});
		if ($buf !~ /^\-\-/) {
			@pairs = split(/&/,$buf);
		}
		else {
			return;
		}
	}
	#げっとー
	else {
		$buf = $ENV{'QUERY_STRING'};
		@pairs = split(/&/,$buf);
	}
	undef $buf;
	
	for ($i=0; $i<@pairs; $i++) {
		($name, $value) = split(/=/, $pairs[$i]);
		#文字コードをsjisへ変換してチェック
		&jcode'convert(\$name, 'sjis');
		&jcode'convert(\$value, 'sjis');
		#&jcode::convert( \$key, "sjis" );
		#&jcode::convert( \$value, "sjis" );
		
		$value =~ tr/+/ /;
		$value =~ s/%([a-fA-F0-9][a-fA-F0-9])/pack("C", hex($1))/eg;
		$value =~ s/[\0\e\f\a]//g;
		$value =~ s/\r\n/\n/g;
		$value =~ s/\r/\n/g;
		#$value =~ s/\t/    /g;
		
		$name =~ tr/+/ /;
		$name =~ s/%([a-fA-F0-9][a-fA-F0-9])/pack("C", hex($1))/eg;
		$name =~ s/[\0\e\f\a]//g;
		$name =~ s/\r\n/\n/g;
		$name =~ s/\r/\n/g;
		
		if (!defined $hash_ref->{$name}) {
			$hash_ref->{$name} = $value;
			push @{$array_ref}, $name;
		}
		else {
			#同じ名前ならば、データをリターンで連結
			$hash_ref->{$name} = $hash_ref->{$name}."\n".$value;
		}
	}
	return;
}
######################### フォームデータタグチェック ##################################################################
#
#######################################################################################################################
sub TagConvert {
#	if ($key ne 'msg' && ($value =~ /</ || $value =~ />/ || $value =~ /\"/) ) {
#		$err_msg = 'タグを使うことは出来ません！';
#		&Print_Error;
#	}
	$value =~ s/\r\n/\n/g;
	$value =~ s/\r/\n/g;
	$value =~ s/\&/\&amp;/g;
	$value =~ s/</&lt;/g;
	
	$value =~ s/\n/<Br>/g;
	###
#	if ($key eq 'msg') {
#		$value =~ s/\t//g;
#		$value =~ s/&lt;\//<\//g;
#		$value =~ s/<\/body/\d/ig;
#		$value =~ s/<\/html/\d/ig;
#		#$value =~ s/&lt;br&gt;/<Br>/ig;
#		$value =~ s/&lt;br/<Br/ig;
#		$value =~ s/&lt;font/<Font/ig;  #Font有効
#		if ($value =~ /\"/) { $value = $value . '<!--"-->'; }
#		#&jcode'convert(*value, 'sjis');
#	}
}
######################### 今の時間をとってくる ########################################################################
#
#######################################################################################################################
sub GetTime {
	$moto_time = time+9*60*60;
	($sec,$min,$hour,$mday,$mon,$year,$wday) = gmtime($moto_time);
	$mon++;
	@week = ('Sun','Mon','Tue','Wed','Thu','Fri','Sat');
	$wday = $week[$wday];
	$sec= sprintf("%.2d",$sec);
	$min= sprintf("%.2d",$min);
	$hour= sprintf("%.2d",$hour);
	$mday= sprintf("%.2d",$mday);
	$mon= sprintf("%.2d",$mon);
	$year = $year + 1900;
	"$year\/$mon\/$mday $hour:$min";
}
######################### 入れた数値を時間に直す ######################################################################
#	$m_nama_time	／	出したい時間の元の数値
#######################################################################################################################
sub MakeTime {
	local($m_nama_time) = $_[0];
	
	($m_sec,$m_min,$m_hour,$m_mday,$m_mon,$m_year,$m_wday) = gmtime($m_nama_time);
	$m_mon++;
	@week = ('Sun','Mon','Tue','Wed','Thu','Fri','Sat');
	$m_wday = $week[$m_wday];
	$m_sec= sprintf("%.2d",$m_sec);
	$m_min= sprintf("%.2d",$m_min);
	$m_hour= sprintf("%.2d",$m_hour);
	$m_mday= sprintf("%.2d",$m_mday);
	$m_mon= sprintf("%.2d",$m_mon);
	$m_year = $m_year + 1900;
}
######################### エラー表示ルーチン ##########################################################################
#
#######################################################################################################################
sub Print_Error {
	local($value) = $_[0];
	
	print "Content-type: text/html\n\n";
	print <<"ERROR_MESSAGE";
<Html>
<Head>
<Title>お知らせ</Title>
</Head>
<body Text="#000000" Bgcolor="#FFFFFF" Link="#0000ff" Vlink="#800080" Alink="#ff0000">
●●お知らせ●●
<BR><BR>
$err_msg
<BR><BR>
<A Href="javascript:history.back()">戻る</A>
<Br>
</Body>
</Html>
ERROR_MESSAGE
	exit;
}
#######################################################################################################################
##任意のＨＴＭＬを表示する方式のエラー表示
#######################################################################################################################
sub Show_Info {
	#*********************************************************************表示するＨＴＭＬのデータ
	$err_msg = 'プログラムがデータファイルを開く事に失敗しました。<BR>もう一度挑戦してみてください。';
	$infoFile = './form_info.html';			#エラーのファイル
	open(INFO_DATA, "$infoFile") || die &Print_Error;
	flock(INFO_DATA, 2);
	@info_template = <INFO_DATA>;
	close(INFO_DATA);
	#*******************************************************
	
	print "Content-type: text/html\n\n";
	
	#**************************************エラーのＨＴＭＬ表示！
	foreach(@info_template) {
		s/<!-- INFO_MSG -->/$info_msg/ig;				#エラーメッセージ
		s/<!-- DATA_URL -->/$data_url/ig;
		
		print;
	}
	exit;
}


######################### フォームデータのラストのＢＲを削る ##########################################################
#
#######################################################################################################################
sub DeleteLastBr {
	local($value) = $_[0];
	while(TRUE) { if (!($value =~ s/<br>$//i)) { last; } }
	$value;
}
######################### フォームデータのラストのスペースを削る ######################################################
#
#######################################################################################################################
sub DeleteLastSpace {
	local($value) = $_[0];
	while(TRUE) { if (!($value =~ s/\s$//g)) { last; } }
	$value;
}

#######################################################################################################################
##クッキーのデータ取得
#	$c_name		クッキーの名前
#######################################################################################################################
sub cookie_data_get {
	#---------------------------------------
	#クッキーを格納する名前
	local($c_name) = $_[0];
	#---------------------------------------

	#環境変数からクッキーの情報を取得
	$cookies = $ENV{'HTTP_COOKIE'};
	@pairs = split(/;/,$cookies);
	#このチャットのクッキーだけを抜き出す
	foreach $pair (@pairs) {
		($c_key, $c_value) = split(/=/, $pair);
		$c_key =~ s/ //g;
		$DUMMY{$c_key} = $c_value;
	}
	#さらに、各パーツに分解する
	$cookie_datas = $DUMMY{$c_name};
	
	$cookie_datas =~ tr/+/ /;
	$cookie_datas =~ s/%([0-9A-Fa-f][0-9A-Fa-f])/pack("C", hex($1))/eg;
	
#	$cookie_datas =~ s/%([a-fA-F0-9][a-fA-F0-9])/pack("C", hex($1))/eg;
	
	@pairs = split(/,/,$cookie_datas);
	foreach $pair (@pairs) {
		($c_key, $c_value) = split(/\!/, $pair);
		$COOKIE{$c_key} = $c_value;
	}
	
	$cook_name = $COOKIE{'C_NAME'};
	$cook_sex = $COOKIE{'C_SEX'};
	$cook_address = $COOKIE{'C_ADDRESS'};
}

#######################################################################################################################
##クッキーのデータ格納
#	$c_name		クッキーの名前
#######################################################################################################################
sub cookie_data_put {
	#---------------------------------------
	#クッキーを格納する名前
	local($c_name) = $_[0];
	#---------------------------------------
	
	$c_nama_time = time + 9*60*60 + (365*24*60*60);				#有効期限１年
	($c_sec,$c_min,$c_hour,$c_mday,$c_mon,$c_year,$c_wday) = gmtime($c_nama_time);
	$c_mon++;
	@c_week_list = ('Sunday','Monday','Tuesday','Wednesday','Thursday','Friday','Saturday');
	@c_mon_list = ('Jan','Feb','Mar','Apr','May','Jun','Jul','Aug','Sep','Oct','Nov','Dec');
	$c_wday_word = $c_week_list[$c_wday];
	$c_mon_word = $c_mon_list[$c_mon];
	$c_sec= sprintf("%02d",$c_sec);
	$c_min= sprintf("%02d",$c_min);
	$c_hour= sprintf("%02d",$c_hour);
	$c_mday= sprintf("%02d",$c_mday);
#	$c_mon= sprintf("%.2d",$c_mon);
	
#	if ($year < 2000){ #Y2K対応
		$year = $year + 1900;
#	}
	
	$date_gmt = "$c_wday_word, $mday-$c_mon_word-$year 00:00:00 GMT";
#	$domain_name = 'www.crystalstaff.co.jp';
	
	$cook_words = "C_NAME\!$name,C_SEX\!$sex,C_ADDRESS\!$address";
	
	$cook_words =~ s/(\W)/sprintf("%%%02X", unpack("C", $1))/eg; #エンコード
	#$cook =~ s/\s/+/g;
	
#	print "Set-Cookie: $c_name=$cook_words; expires=$date_gmt; domain=$domain_name\n";
	print "Set-Cookie: $c_name=$cook_words; expires=$date_gmt;\n";
	
	$C_NAME = $name;
	$C_SEX = $sex;
	$C_ADDRESS = $address;
}
#######################################################################################################################
#	メール送信プログラム
#
#	$to_mail				送る側のメールアドレス
#	$from_mail				送られる側のメールアドレス
#	$subject				題名
#	$mail_body				本文
#######################################################################################################################
sub sendmail {
	local($to_mail) = $_[0];					##送る側のメールアドレス
	local($from_mail) = $_[1];					##送られる側のメールアドレス
	local($subject) = $_[2];					##題名
	local($mail_body) = $_[3];					##本文
	
	$jis_subject = &jis_encode($subject);
	
	foreach $to(split(/\s*,\s/,$to_mail)) {
		$mail_data = <<MAIL;
Subject: $jis_subject
To: $to_mail
From: $from_mail
Mime-Version: 1.0
Content-Transfer-Encording: 7bit
Content-Type: text/plain; charset=ISO-2022-JP
MAIL

		&jcode::convert(\$mail_data, 'jis');
		&jcode::convert(\$mail_body, 'jis');
	#	$jis_mail_body = &jis_encode($mail_body);
		
		$info_msg = 'メール送信に失敗しました。<BR>もう一度確認してから送信してみて下さい。';
		open(MAIL, "| $SENDMAIL -t") || &Show_Info;
		print MAIL $mail_data;
		print MAIL $mail_body;
		close(MAIL);
	}
}


#######################################################################################################################
#	メール用にJISに変換する
#
#######################################################################################################################
sub jis_encode {
	my( $str ) = @_;
	my $ret = "";
	
	#ＥＵＣへ
	&jcode::convert( \$str, 'euc' );
	&jcode::h2z_euc( \$str );
	
	#メールヘッダに影響のある文字を置換
	$str =~ s/\t/ /g;
	$str =~ s/\0/ /;
	$str =~ s/[\n\r\f\a\e]/ /g;
	
	#前後のスペースを削除
	while( substr( $str, 0, 1 ) =~ /\s/ ) { substr( $str, 0, 1, "" ); }
	while( substr( $str, -1 ) =~ /\s/ ) { chop( $str ); }
	
	my $char = "";
	my $char2 = "";
	my $off = 0;
	my $ret2 = "";
	my $j_flag = 0;
	
	if (($str =~ /[\xA1-\xFE][\xA1-\xFE]/) || ($str =~ /\W/)) {
		#漢字、記号
		while( length( $str ) > $off ) {
			$char = substr( $str, $off, 1 );
			$off++;
			
			if (($char =~ /\x8F$/) || ($char =~ tr/\x8E\xA1-\xFE// % 2 )) {
				$j_flag = 1;
			}
			else {
				$j_flag = 0;
			}
			
			if (($j_flag == 0) && (($char =~ /</) ||($char =~ />/) || ($char =~ /\@/))) {
				if ( $char2 ne "" ) {
					$ret2 = "";
					jcode::convert( \$char2, 'jis' );
					ap_mimeenc::encodeToBase64( \$char2, \$ret2, undef );
				#	$ret .= "=?iso-2022-jp?B?".$ret2."?=";
					$ret .= "=?ISO-2022-JP?B?".$ret2."?=";
					$char2 = "";
				}
				$ret .= $char;
				next;
			}
			elsif( $j_flag == 1 ) {
				if (($char2 ne "") && ($char2 !~ /\W/)) {
					$ret .= $char2;
					$char2 = "";
				}
				
				$char2 .= $char;
				next();
			}
			elsif( $char2 eq "" ) {
				$char2 .= $char;
				next();
			}
			else {
				$char2 .= $char;
				next();
			}
			
		}
		if( length( $char2 ) > 0 ) {
			if( $char2 !~ /\W/ ) {
				#英数はそのまま連結
				$ret .= $char2;
			}
			else {
				#日本語
				$ret2 = "";
				&jcode::convert( \$char2, 'jis' );
				&encodeToBase64( \$char2, \$ret2, undef );
			#	$ret .= "=?iso-2022-jp?B?".$ret2."?=";
				$ret .= "=?ISO-2022-JP?B?".$ret2."?=";
			}
		}
		
	}
	else {
		return $str;
	}
	return $ret;
}

#######################################################################################################################
#	Base64エンコード
#
#######################################################################################################################
sub encodeToBase64 {
	my( $in_ref, $out_ref, $eol  ) = @_;
	${$out_ref} = pack( "u", ${$in_ref} );
	if( $eol ) { $eol = "\n"; } else { $eol = ""; }
	${$out_ref} =~ s/^.//mg;
	${$out_ref} =~ s/\n//g;
	${$out_ref} =~ tr|` -_|AA-Za-z0-9+/|; 
	my $padding = (3 - length($$in_ref) % 3) % 3;
	if( $padding >= 1 ) {
		$$out_ref =~ s/.{$padding}$/'=' x $padding/e;
	}
	if (length( $eol ) ) { ${$out_ref} =~ s/(.{1,76})/$1$eol/g; }
	return;
}

#######################################################################################################################


#**********************************************************************************************************************

1;	# RETURN TRUE
__END__