#
# util.pl
#

#
# parseInput(encoding)
# <IN>  encoding: 日本語コード(jis|sjis|euc)
# <OUT> Name=>Val のハッシュ（グロブ）
#
sub parseInput
{
	my($encoding) = @_;
	my($method) = $ENV{'REQUEST_METHOD'};
	local($query, @in, $key, $val);


	# 日本語が必要な場合は jcode.pl を取り込む
	require 'jcode.pl' if $encoding;

	# GETメソッドかPOSTメソッドかを判別する
	if ($method eq 'GET') {
		$query = $ENV{'QUERY_STRING'};
	}
	elsif ($method eq 'POST') {
		read(STDIN, $query, $ENV{'CONTENT_LENGTH'});
	}

	# 入力データを分解する
	local(@query) = split(/&/, $query);

	# Name=Val を $in{'Name'} = 'Val' のハッシュにする。
	foreach (@query) {

		# + を空白文字に変換
		tr/+/ /;

		# Name=Val を分ける
		($key, $val) = split(/=/);

		# %HH形式を元の文字にデコードする。
		$key =~ s/%([A-Fa-f0-9][A-Fa-f0-9])/pack("c", hex($1))/ge;
		$val =~ s/%([A-Fa-f0-9][A-Fa-f0-9])/pack("c", hex($1))/ge;

		$val =~ s/\r\n/\n/g;

		# 日本語コードが指定されている場合は変換する。
		jcode'convert(*key, $encoding) if ($encoding);
		jcode'convert(*val, $encoding) if ($encoding);

		# 連想配列（ハッシュ）にセット
		$in{$key} = $val;
	}

	# 連想配列のグロブを返す
	return *in;
}




# ロック関連の設定値
$RetryNum = 100;			# リトライ回数
$Interval = 0.1;		# リトライのインターバル
$EX_LOCK = 2;			# 排他ロック
$UN_LOCK = 8;			# ロック解除
$LOCKTYPE = $EX_LOCK;	# ロックタイプは排他ロック
$useflock = 0;			# flock()を使う場合は1にする
$LPrefix = 'L-';		# ロックファイルのプリフィクス
#
# lock(lfh, lockfile)
# <IN>  lfh: ロックファイルのハンドル（openLockで指定されたファイル名
#       に等しい。
#       lockfile: ロックファイル名
# <OUT> true: 成功  false: 失敗
#
sub lock($$)
{
	my($lfh, $lockfile) = @_;

	if ($useflock) {		# flock()を使う
		flock($lfh, $LOCKTYPE);
		return 1;
	}
	else {
		my($retry) = $RetryNum;
		while (-f $lockfile) {
			select(undef, undef, undef, $Interval);
			return undef if (--$retry <= 0);
		}
		return open($lfh, ">$lockfile");
	}
}


#
# unlock(lfh, lockfile)
# <IN>  lfh: ロックファイルのハンドル（openLockで指定されたファイル名
#       に等しい。
#       lockfile: ロックファイル名
# <OUT> なし
#
sub unlock ($$)
{
	my($lfh, $lockfile) = @_;

	if ($useflock) {		# flock()を使う
		flock($lfh, $UN_LOCK);
	}
	else {
		close($lfh);
		unlink($lockfile);
	}
}


#
# openLock(fh, modefile)
# <IN>  fh: ハンドル
#       modefile: モードを含むファイル名
# <OUT> true or false
#
sub openLock(*$)
{
	my($fh, $modefile) = @_;
	my($lockf);

	($mode, $file) = ($modefile =~ /^(\+?(?:<|>>?)\s*?)(.+)$/);
	if ($file =~ /(\/|\\)/) {
		($path, $filename) = ($file =~ /^(.*[\/|\\])(.+)$/);
	}
	else {
		$path = '';
		$filename = $file;
	}

	return undef unless $filename;
	$lockf = $path.$LPrefix."$filename";	# ロックファイル名
	lock($filename, $lockf) or return undef;

	open($fh, $modefile)
		or unlock($filename, $lockf), return undef;

	return 1;
}

#
# closeUnlock
# <IN>  fh: ハンドル
#       modefile: モードを含むファイル名
# <OUT> なし
#
sub closeUnlock(*$)
{
	my($fh, $file) = @_;

	if ($file =~ /(\/|\\)/) {
		($path, $filename) = ($file =~ /^(.*[\/|\\])(.+)$/);
	}
	else {
		$path = '';
		$filename = $file;
	}
	my($lockfile) = $path.'L-'."$filename";	# ロックファイル名
	unlock($filename, $lockfile);

	close($fh);
}


#
# exitError()
# <IN>  エラーメッセージ
# <OUT> なし
#
sub exitError
{
	my($msg) = @_;

	$msg =~ s/\n/<BR>\n/g;
print <<END_OF_ERR_HTML;
Content-Type: text/html

<HTML>
<HEAD>
<TITLE>エラー！！</TITLE>
</HEAD>
<BODY>
<FONT color="#FF0000">$msg</FONT><BR>
<FONT color="#0000FF">$!</FONT>
</BODY>
</HTML>
END_OF_ERR_HTML

	exit(1);
}

#
# getCookie()
# <IN>  エラーメッセージ
# <OUT> なし
#
sub getCookie
{
	my($cookie) = $ENV{'HTTP_COOKIE'};
#	my(%cookies, @cookie);
	local(*cookies);
	my(@cookie);

	@cookie = split(/;\s*/, $cookie);

print "cookie = @cookie\n";
	foreach (@cookie) {
		local($name, $val) = split(/=/);
print "name=$name, val=$val\n";
		$cookies{$name} = $val;
	}

	return *cookies;
}

#
# setCookie()
# <IN>  エラーメッセージ
# <OUT> なし
#
sub setCookie
{
	local(*data) = @_;
	my($cookie);

	$cookie = qq(Set-Cookie: );
	foreach (keys %data) {
		$cookie = qq($cookie $_=$data{$_};);
	}

	return $cookie;
}


#
# ツェラーの公式より曜日を求める
# グレゴリウス暦(1582年10月15日(金)午後以後)で有効
#
# <IN> 年、月、日
# <OUT> 曜日 (0:日曜日 - 6:土曜日)
#
sub getDayOfWeek
{
	my($year, $month, $day) = @_;

	# 1月または2月の場合は前年の13月および14月とみなす
	if ($month <= 2) {
		--$year;
		$month += 12;
	}

	return (($year + int($year/4) - int($year/100) + int($year/400)
					+ int((13*$month + 8)/5) + $day) % 7);
}

#
# <IN>	西暦年号
# <OUT> うるう年: true  平年: false
#
sub leap
{
	my($year) = @_;

	if ($year % 100) {		# 西暦年号が 100 で割り切れない
		if ($year % 4) {	# 西暦年号が 4 で割り切れない
			return 0;	# 平年
		}
		else {
			return 1;	# うるう年
		}
	}
	else {					# 西暦年号が 100 で割り切れる
		if ($year % 400) {	# 西暦年号が 400 で割り切れない
			return 0;	# 平年
		}
		else {				# 西暦年号が 400 で割り切れる
			if ($year % 4000) {	# 西暦年号が 4000 で割り切れない
				return 1;	# うるう年
			}
			else {			# 西暦年号が 4000 で割り切れる
				return 0;	#平年
			}
		}
	}
}

@LeapYear = (0, 31, 29, 31, 30, 31, 30, 31, 31, 30, 31, 30, 31);
@NormYear = (0, 31, 28, 31, 30, 31, 30, 31, 31, 30, 31, 30, 31);

#
# <IN>  年、月
# <OUT> その月の合計日数
#
sub getDaysOfMonth
{
	my($year, $month) = @_;

	return leap($year) ? $LeapYear[$month] : $NormYear[$month];
}

1;
