#┏━━━━━━━━━━━━━━━━━━━━━━━━━━━━┓
#┃Hi Library Ver 1.10                                     ┃
#┃オリジナル汎用ライブラリ                                ┃
#┃Copyright(C) 2002-2005 Hisashi All Rights Reserved.     ┃
#┃   Web: http://www.e-hws.net/                           ┃
#┃---[注意事項]-------------------------------------------┃
#┃このスクリプトはフリーソフトです。このスクリプトを使用  ┃
#┃したいかなる損害に対して作者は一切の責任を負いません。  ┃
#┃--------------------------------------------------------┃
#┗━━━━━━━━━━━━━━━━━━━━━━━━━━━━┛

#┏━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━┓
#┃<変更履歴>                                                                              ┃
#┃ -Date-	-Ver-	-Comment-                                                          ┃
#┃----------------------------------------------------------------------------------------┃
#┃2003.05.26	1.10	ファイルアップロード機能追加（decode処理）                         ┃
#┃2003.05.12	1.09	エラー画面の著作権表示を削除                                       ┃
#┃2003.03.31	1.08	デバッグフラグが立っている場合のみログを出力する                   ┃
#┃2003.03.26	1.07	エラー画面(errhtml)のレイアウトを変更                              ┃
#┃2003.02.12	1.06	デバッグログにファイル名・行数を表示するように変更                 ┃
#┃			終了処理を削除                                                     ┃
#┃2003.02.07	1.05	クッキー保存・取得処理追加                                         ┃
#┃2003.01.31	1.04	エラー画面出力処理追加                                             ┃
#┃2003.01.15	1.03	ユーザ情報ログ取得処理追加                                         ┃
#┃			デバッグログ取得処理にて最大出力ログ行数の設定追加                 ┃
#┃2002.12.09	1.02	デコード処理にてPOST時の処理を追加                                 ┃
#┃			曜日算出処理追加                                                   ┃
#┃2002.12.03	1.01	ファイルロック・ロック解除処理追加                                 ┃
#┃2002.12.01	1.00	ローカル公開                                                       ┃
#┗━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━┛

#┏━━━━━━━━━━━━━━━━━━━━━━━━━━━━┓
#┃◆初期設定                                              ┃
#┗━━━━━━━━━━━━━━━━━━━━━━━━━━━━┛
$inflogmax  = 100;		# ユーザ情報ログ最大行数
$usrinf_log = "usrinf.log";	# ユーザ情報ログファイル名
$dbglogmax  = 100;		# デバッグログ最大行数
$dbg_log    = "dbg.log";	# デバッグログファイル名

#┏━━━━━━━━━━━━━━━━━━━━━━━━━━━━┓
#┃デコード処理                                            ┃
#┗━━━━━━━━━━━━━━━━━━━━━━━━━━━━┛
sub decode{
	local($name, $value, $buffer);
	my($server_os);

	# OS種別取得
	$server_os = &get_server_os;
	if( $server_os eq "win" ){
		binmode(STDIN);
	}

	if ($ENV{'REQUEST_METHOD'} eq "POST") {
		read(STDIN, $buffer, $ENV{'CONTENT_LENGTH'});
	}else{
		$buffer = $ENV{'QUERY_STRING'};
	}

#&dbglog("buffer = [\n$buffer\n]");
	if($ENV{'CONTENT_TYPE'} =~ /multipart\/form-data/){
		if( $ENV{'CONTENT_LENGTH'} > 1024 * ($maxupsize + 1) ){
			&errhtml("一度にアップロードできるサイズは${maxupsize}KBまでです。");
		}
		$buffer =~ /^(.+)\r\n/;
		$boundary = $1;
		@pairs = split(/$boundary/, $buffer);
		foreach $pair (@pairs){
			undef($name);
			undef($value);
                        $pair =~ s/\r\n$/\nD_End/;
			@vars = split(/\r\n/, $pair);
			$vars = @vars;

			# ファイル添付か？
			if( $vars[2] =~ /Content-Type/i){
				if ($vars[1] =~ /name\=\"(.+)\"\;\sfilename\=\"(.+)\"/){
					$name     = $1;
					$filename = $2;
					# パスを排除してファイル名のみ取得
					@tmp = split(/\\/, $filename);
					$filename = pop(@tmp);
				}
			}else{
				if ($vars[1] =~ /name\=\"(.*?)\"/){
					$name = $1;
				}
			}
			# データ抽出
			foreach( $i = 3; $i < $vars; $i++ ){
				if($value eq ''){
					$value = $vars[$i];
				}else{
					$value .= "\r\n$vars[$i]";
				}
			}
			$value=~ s/\nD_End$//;

			if( $name eq "" ){
				next;
			}

			if ($name eq 'file' && $filename){
				$file{$filename} = $value;
#&dbglog("ファイルデータ file{$filename} = $value");
			}else{
				$value =~ s/\r\n/\n/g;
				$value =~ s/\r/\n/g;
				$FORM{$name} = $value;
#&dbglog("通常フォームデータ FORM{$name} = $value");
			}
		}
	}else{
		@pairs = split(/&/,$buffer);
		foreach $pair (@pairs) {
			($name, $value) = split(/=/, $pair);
			$value =~ tr/+/ /;
			$value =~ s/%([a-fA-F0-9][a-fA-F0-9])/pack("C", hex($1))/eg;
#			&jcode'convert(*value,'sjis');
			if( $name eq "chk_files" ){
				push(@CHK_FILES, $value);
			}else{
				$FORM{$name} = $value;
			}
		}
	}

}# decode END

#┏━━━━━━━━━━━━━━━━━━━━━━━━━━━━┓
#┃時刻取得処理                                            ┃
#┃Param1 : 取得する時刻タイプ                             ┃
#┃         0 = YYYY/MM/DD HH:MM:SS                        ┃
#┃         1 = YYYY年M月D日(月) H:MM:SS                   ┃
#┃         2 = YYYY/MM/DD(月) HH:MM:SS                    ┃
#┃         3 = YYYYMM                                     ┃
#┃         4 = YYYYMMDD                                   ┃
#┃         5 = YYYY/MM/DD                                 ┃
#┃         6 = HH:MM:SS                                   ┃
#┃         7 = YYYY/M/D H:MM:SS                           ┃
#┃         8 = YYYY,MM,DD                                 ┃
#┃         9 = YYYYMMDDHHMMSS                             ┃
#┃Return : 時刻情報                                       ┃
#┗━━━━━━━━━━━━━━━━━━━━━━━━━━━━┛
sub gettime{
	my($type) = @_;
	my(@ret);

	if( $type eq "" ){
		$type = 0;
	}

	my($times) = time;#18時間時差があるなら、$times = time+18*60*60とする。
	my($sec,$min,$hour,$mday,$month,$year,$wday,$yday,$isdst) = localtime($times);
	$year = $year + 1900;
	$month++;
	my($youbi)    = ('Sun','Mon','Tue','Wed','Thu','Fri','Sat') [$wday];
	my($youbi2)   = ('日','月','火','水','木','金','土') [$wday];
	$ret[0] = sprintf("%04d/%02d/%02d %02d:%02d:%02d",   $year, $month, $mday, $hour,   $min,  $sec);
	$ret[1] = sprintf("%04d年%d月%d日(%s) %d:%02d:%02d", $year, $month, $mday, $youbi2, $hour, $min, $sec);
	$ret[2] = sprintf("%04d/%d/%d(%s) %d:%02d",          $year, $month, $mday, $youbi2, $hour, $min);
	$ret[3] = sprintf("%04d%02d",                        $year, $month);
	$ret[4] = sprintf("%04d%02d%02d",                    $year, $month, $mday);
	$ret[5] = sprintf("%04d/%02d/%02d",                  $year, $month, $mday) ;
	$ret[6] = sprintf("%02d:%02d:%02d",                  $hour, $min,   $sec) ;
	$ret[7] = sprintf("%04d/%d/%d %d:%02d:%02d",         $year, $month, $mday, $hour,   $min,  $sec);
	if( $type == 8 ){
		return($year, $month, $mday);
	}
	$ret[9] = sprintf("%04d%02d%02d%02d%02d%02d",        $year, $month, $mday, $hour,   $min,  $sec);

	return($ret[$type]);

}# gettime END

#┏━━━━━━━━━━━━━━━━━━━━━━━━━━━━┓
#┃ファイルロック処理                                      ┃
#┗━━━━━━━━━━━━━━━━━━━━━━━━━━━━┛
sub lock{

	my($lockdir) = @_;

	$sleepcnt = 0;
	while(1){
		if (!mkdir("$lockdir", 0777)){
		# (ロックされている場合)
			# 最大リトライ回数を超えたらエラー画面表示
			if( $sleepcnt >= $sleepmax ){
				($dev,$ino,$mode,$nlink,$uid,$gid,$rdev,$size,$atime,$mtime,$ctime,$blksize,$blocks) = stat($lockdir);
				# ディレクトリ作成日付より10分以上経過しているか？
				if( $mtime + (10 * 60) < time ){
				# (経過している場合)
					# ロックディレクトリを削除し、新たにロックディレクトリを作成
					rmdir($lockdir);
					# ロックディレクトリが作成できなければビジー
					if (!mkdir("$lockdir", 0777)){
						&errhtml("ただ今混み合っています。しばらくたってから再度実行して下さい。");
					}
					last;
				}
				# (経過していない場合)
				# ビジー
				&errhtml("ただ今混み合っています。しばらくたってから再度実行して下さい。");
			}
			sleep(1);
			$sleepcnt = $sleepcnt + 1;
		}else{
		# (ロックされていない場合)
			last;
		}
	}

}# lock END

#┏━━━━━━━━━━━━━━━━━━━━━━━━━━━━┓
#┃ファイルロック解除処理                                  ┃
#┗━━━━━━━━━━━━━━━━━━━━━━━━━━━━┛
sub unlock{

	rmdir("$_[0]");

}# unlock END

#┏━━━━━━━━━━━━━━━━━━━━━━━━━━━━┓
#┃曜日算出処理                                            ┃
#┗━━━━━━━━━━━━━━━━━━━━━━━━━━━━┛
sub whatday{
	local($yyyy, $mm, $dd) = @_;
	# 曜日算出
	if ($mm < 3) {--$yyyy; $mm+=12;}
	$wday=($yyyy+int($yyyy/4)-int($yyyy/100)+int($yyyy/400)+int((13*$mm+8)/5)+$dd)%7;
	$whatday1 = ('日曜日','月曜日','火曜日','水曜日','木曜日','金曜日','土曜日') [$wday];
	$whatday2 = ('日','月','火','水','木','金','土') [$wday];
	$whatday3 = ('Sun','Mon','Tue','Wed','Thu','Fri','Sat') [$wday];
}# whatday END

#┏━━━━━━━━━━━━━━━━━━━━━━━━━━━━┓
#┃ページ移動処理                                          ┃
#┗━━━━━━━━━━━━━━━━━━━━━━━━━━━━┛
sub disp_page{
	print "Location: $_[0]\n\n";

#	local($jump_url) = @_;
#
#	print <<END;
#Content-type: text/html
#
#<SCRIPT>
#<!--
#w = location.href = "$jump_url" ;
#// -->
#</SCRIPT>
#END
	exit;
}# disp_page END

#┏━━━━━━━━━━━━━━━━━━━━━━━━━━━━┓
#┃ユーザ情報取得処理                                      ┃
#┗━━━━━━━━━━━━━━━━━━━━━━━━━━━━┛
sub get_usrinf{

	$date = &gettime(0);
	$ip1 = $ENV{'REMOTE_ADDR'};
	$ip2 = $ENV{'HTTP_X_FORWARDED_FOR'};

	$host1 = gethostbyaddr(pack('C4',split(/\./,$ip1)),2);
	$host2 = gethostbyaddr(pack('C4',split(/\./,$ip2)),2);

	if( $ip1 eq "" ){	$ip1 = "unknown";}
	if( $ip2 eq "" ){	$ip2 = "unknown";}
	if( $host1 eq "" ){	$host1 = "unknown";}
	if( $host2 eq "" ){	$host2 = "unknown";}

	$usrinf = "$date<>$ip1($host1)<>$ip2($host2)<>$ENV{'HTTP_USER_AGENT'}<>$ENV{'HTTP_REFERER'}<>\n";

	open(INF, $usrinf_log);
	@infdata = <INF>;
	close(INF);
	
	unshift(@infdata, $usrinf);
	
	if( @infdata > $inflogmax ){
		$x = pop(@infdata);
	}

	&lock("${usrinf_log}loc");	
	open(INF, ">$usrinf_log");
	print INF @infdata;
	close(INF);
	&unlock("${usrinf_log}loc");	

}# get_usrinf END

#┏━━━━━━━━━━━━━━━━━━━━━━━━━━━━┓
#┃デバッグ用ログ出力                                      ┃
#┃ Param1:出力ログメッセージ                              ┃
#┃ Param2:ファイル名                                      ┃
#┃ Param3:行数                                            ┃
#┗━━━━━━━━━━━━━━━━━━━━━━━━━━━━┛
sub dbglog{
	local($dbgmsg, $file, $line) = @_;

	if( $DBG ){
		$date = &gettime(0);
		open(DBG, $dbg_log);
		@dbgdata = <DBG>;
		close(DBG);
		
		if( $file ne "" and $line ne "" ){
			unshift(@dbgdata, "[$date] $file:$line > $dbgmsg\n");
		}elsif( $file ne "" ){
			unshift(@dbgdata, "[$date] $file > $dbgmsg\n");
		}elsif( $line ne "" ){
			unshift(@dbgdata, "[$date] $line > $dbgmsg\n");
		}else{
			unshift(@dbgdata, "[$date] > $dbgmsg\n");
		}
		if( @dbgdata > $dbglogmax ){
			$x = pop(@dbgdata);
		}

		&lock("${dbg_log}loc");	
		open(DBG, ">$dbg_log");
		print DBG @dbgdata;
		close(DBG);
		&unlock("${dbg_log}loc");
	}
}# dbglog END

#┏━━━━━━━━━━━━━━━━━━━━━━━━━━━━┓
#┃エラー画面出力                                          ┃
#┃ Param1:エラーメッセージ                                ┃
#┃ Param2:エラーファイル                                  ┃
#┃ Param3:エラー行数                                      ┃
#┗━━━━━━━━━━━━━━━━━━━━━━━━━━━━┛
sub errend{

	local($errmsg, $errfile, $errline) = @_;

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

<HTML>
<HEAD>
<META http-equiv="Content-Type" content="text/html; charset=Shift_JIS">
<META http-equiv="Content-Style-Type" content="text/css">
<TITLE>エラーが発生しました。</TITLE>
</HEAD>
<BODY background="$bgimg">
<font color="red">エラーが発生しました。</font><br>
<HR size="2" color="red" width="100%">
<CENTER>
<table width="100%" border="0">
<tr>
	<td nowrap width="20%" align="right">
		エラー内容：
	</td>
	<td nowrap width="80%">
		$errmsg
	</td>
</tr>
<tr>
	<td nowrap align="right">
		エラーファイル：
	</td>
	<td nowrap>
		$errfile
	</td>
</tr>
<tr>
	<td nowrap align="right">
		エラー行数：
	</td>
	<td nowrap>
		$errline
	</td>
</tr>
<tr>
	<td nowrap colspan="2" align="center">
		<br><br>
		※\申\し訳ありませんが、実行継続不可\能\なエラーが発生しました。<br>
		ＷＥＢ管理者かプログラム作成者までご連絡ください。
	</td>
</tr>
</table><br><br>

<INPUT type="button" name="return" value="戻る" onclick="history.back();">　　　
<INPUT type="button" name="home" value="ホーム" onclick="location='$home'">
</CENTER>
</BODY>
</HTML>

_HTML_

	exit;
}# errend END

#┏━━━━━━━━━━━━━━━━━━━━━━━━━━━━┓
#┃エラー画面出力                                          ┃
#┃ Param1:エラーメッセージ                                ┃
#┗━━━━━━━━━━━━━━━━━━━━━━━━━━━━┛
sub errhtml{

	local($errmsg) = @_;

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

<HTML>
<HEAD>
<meta http-equiv="Content-Type" content="text/html; charset=Shift_JIS">
<meta http-equiv="Content-Style-Type" content="text/css">
<TITLE>ERROR</TITLE>
<STYLE type="text/css">
<!--
A:hover{text-decoration:underline;color:blue;background-color:#dae6d9;}
body,tr,td { font-size: 9pt;font-family:verdana,"MS UI Gothic",Osaka,chicago,Arial,Helvetica,"ＭＳ Ｐゴシック";}
-->
</STYLE>
</HEAD>
<body bgcolor="#ffffff" text="#666699" link="#6666cc" alink="#cc66ff" vlink="#999999">
<center>
<table border="0" width="300" style="border-width:0px 0px 3px 0px; border-style:solid;">
<tr>
	<td nowrap align="center">
		<font size="5" color="red">ERROR</font>
	</td>
</tr>
</table>
<br><br>
<table border="0" width="400">
<tr>
	<td align="center">
		$errmsg
	</td>
</tr>
</table>
<br><br><br>
<input type="button" value="戻　る" style="width:100; border-width:1px; border-style:solid; border-color:#666666" onclick="history.back()">
</center>
</BODY>
</HTML>
_HTML_

	exit;
}# errhtml END

#┏━━━━━━━━━━━━━━━━━━━━━━━━━━━━┓
#┃クッキー取得処理                                        ┃
#┗━━━━━━━━━━━━━━━━━━━━━━━━━━━━┛
sub get_cookie{
	$cooks = $ENV{'HTTP_COOKIE'};
	($cookieid, $cooks) = split(/=/, $cooks);
	($count,$dmy) = split(/<>/, $cooks);
}# get_cookie END

#┏━━━━━━━━━━━━━━━━━━━━━━━━━━━━┓
#┃クッキー保存処理                                        ┃
#┗━━━━━━━━━━━━━━━━━━━━━━━━━━━━┛
sub set_cookie{
	local($dmy,$mdc,$monc,$yrc,$wdayc,$mc,$yc);
	($dmy,$dmy,$dmy,$mdc,$monc,$yrc,$wdayc,$dmy,$dmy) = localtime(time + 7776000);
	$yc = ('Sunday','Monday','Tuesday','Wednesday','Thursday','Friday','Saturday') [$wdayc];
	$mc = ('Jan','Feb','Mar','Apr','May','Jun','Jul','Aug','Sep','Oct','Nov','Dec') [$monc];
	$yrc = $yrc+1900;	$mdc = "0$mdc" if ($mdc < 10);
	$count ++;
	$data = "$count<>chdend";
	print "Set-Cookie: hiedit=$data; expires=$yc, $mdc-$mc-$yrc 00:00:00 GMT\n";
}# set_cookie END

#┏━━━━━━━━━━━━━━━━━━━━━━━━━━━━┓
#┃サーバOS取得処理                                        ┃
#┃入力値：なし                                            ┃
#┃戻り値："win"/"mac"                                     ┃
#┗━━━━━━━━━━━━━━━━━━━━━━━━━━━━┛
sub get_server_os{

	my($server_os);

	# OS取得
	$server_os = $^O;

	# 環境変数から取得
	if($server_os eq ""){
		$server_os = $ENV{'OS'};
	}

	# AnHTTPd /OmniHTTPd/IIS対策
	if($ENV{'SERVER_SOFTWARE'} =~ /AnWeb|Omni|IIS\//i){
		$server_os= 'win';
	}

	# Win Apache 対策
	if($ENV{'WINDIR'} ne ""){
		$server_os= 'win';
	}

	if($server_os eq ""){
		$server_os = "mac";
	}

	return($server_os);

}# get_server_os END

#┏━━━━━━━━━━━━━━━━━━━━━━━━━━━━┓
#┃ディレクトリ削除処理                                    ┃
#┃入力値：削除するディレクトリ                            ┃
#┃戻り値：0 = 成功                                        ┃
#┃        1 = 失敗                                        ┃
#┗━━━━━━━━━━━━━━━━━━━━━━━━━━━━┛
sub deldir{
	my($dir) = @_;
	my($ret) = 1;
	my($file);
	if( opendir(DIR, $dir) ){
		foreach $file (readdir DIR){
			if($file ne '.' && $file ne '..'){
				if(-d "$dir/$file"){
					$ret = &deldir("$dir/$file");
					if( $ret ){
						&dbglog("deldir($dir/$file) error. [$!]", __FILE__, __LINE__);
						$ret = 0;
						last;
					}
				}else{
					$ret = unlink("$dir/$file");
					if( !$ret ){
						&dbglog("unlink($dir/$file) error. [$!]", __FILE__, __LINE__);
						last;
					}
				}
			}
		}
		closedir(DIR);
		$ret = rmdir($dir);
		if( !$ret ){
			&dbglog("rmdir($dir) error. [$!]", __FILE__, __LINE__);
		}else{
			$ret = 0;
		}
	}else{
		$ret = 0;
	}

	return(!$ret);

}# deldir END

#┏━━━━━━━━━━━━━━━━━━━━━━━━━━━━┓
#┃ディレクトリコピー処理                                  ┃
#┃入力値：コピー元ディレクトリ                            ┃
#┃入力値：コピー先ディレクトリ                            ┃
#┃戻り値：0 = 成功                                        ┃
#┃        1 = 失敗                                        ┃
#┗━━━━━━━━━━━━━━━━━━━━━━━━━━━━┛
sub cpydir{
	my($from_dir, $to_dir) = @_;
	my $ret = 1;
	my($f_file);

	# コピー先ディレクトリがなければ作成する
	if( -e "$to_dir" ){
	}else{
		# ディレクトリ作成
		$ret = mkdir("$to_dir", 0777);
		if( !$ret ){
			&dbglog("mkdir($to_dir) error. [$!]", __FILE__, __LINE__);
			last;
		}
	}
	if( opendir(F_DIR, $from_dir) ){
		foreach $f_file (readdir F_DIR){
			# .と..はスキップ
			if($f_file ne '.' && $f_file ne '..'){
				# ディレクトリであれば再帰呼出し
				if(-d "$from_dir/$f_file"){
					# ディレクトリコピー
					$ret = &cpydir("$from_dir/$f_file", "$to_dir/$f_file");
					if( $ret == 1 ){
						&dbglog("cpydir($from_dir/$f_file -> $to_dir/$f_file) error.", __FILE__, __LINE__);
						$ret = 0;
						last;
					}else{
						$ret = 1;
					}
				}else{
					# ファイルコピー
					$ret = copy( "${from_dir}/$f_file", "${to_dir}/$f_file" ) ;
					if( !$ret ){
						&dbglog("copy($from_dir/$f_file -> $to_dir/$f_file) error. [$!]", __FILE__, __LINE__);
						last;
					}
				}
			}
		}
		closedir(F_DIR);
	}else{
		&dbglog("mkdir($from_dir/$f_file) error. [$!]", __FILE__, __LINE__);
		$ret = 0;
	}

	return(!$ret);

}# cpydir END

#┏━━━━━━━━━━━━━━━━━━━━━━━━━━━━┓
#┃ディレクトリ移動処理                                    ┃
#┃入力値：移動元ディレクトリ                              ┃
#┃入力値：移動先ディレクトリ                              ┃
#┃戻り値：0 = 成功                                        ┃
#┃        1 = 失敗                                        ┃
#┗━━━━━━━━━━━━━━━━━━━━━━━━━━━━┛
sub movdir{
	my($from_dir, $to_dir) = @_;
	my($ret) = 0;

	# ディレクトリコピー
	$ret = &cpydir($from_dir,$to_dir);
	if( $ret ){
		&dbglog("cpydir($from_dir -> $to_dir) error.", __FILE__, __LINE__);
	}else{
		# 移動元ディレクトリ削除
		$ret = &deldir($from_dir);
		if( $ret ){
			&dbglog("deldir($from_dir) error.", __FILE__, __LINE__);
		}
	}

	return($ret);

}# movdir END

#┏━━━━━━━━━━━━━━━━━━━━━━━━━━━━┓
#┃↓↓↓　「1;」は削除しないで！！  ↓↓↓                ┃
#┗━━━━━━━━━━━━━━━━━━━━━━━━━━━━┛
1;
