
package main;
;#----------------------------------------------------------------------------
;# heros.pl : 汎用サブルーチン Perl パッケージ
;# http://www.junkperl.com/
;# Copyright (C) 2006- By HeRO
;# Ver 1.00 2006/08/09 outscreen_html / get_ipaddr / chg_sjis_post_str
;# Ver 1.01 2006/08/09 get_cookie / set_cookie
;# Ver 1.02 2006/08/10 lock / unlock
;# Ver 1.03 2006/08/14 make_new_key
;# Ver 1.04 2006/08/15 HTML-cookie
;#
;# このプログラムはフリーソフトウェアです。あなたはこれを、フリーソフトウェア
;# 財団によって発行された GNU 一般公衆利用許諾契約書(バージョン2か、希望によっ
;# てはそれ以降のバージョンのうちどれか)の定める条件の下で再頒布または改変する
;# ことができます。
;#
;# このプログラムは有用であることを願って頒布されますが、*全くの無保証* です。
;# 商業可能性の保証や特定の目的への適合性は、言外に示されたものも含め全く存在
;# しません。詳しくはGNU 一般公衆利用許諾契約書をご覧ください。
;#
;# あなたはこのプログラムと共に、GNU 一般公衆利用許諾契約書の複製物を一部受け
;# 取ったはずです。もし受け取っていなければ、フリーソフトウェア財団まで請求し
;# てください(宛先は the Free Software Foundation, Inc., 59 Temple Place,
;# Suite 330, Boston, MA 02111-1307 USA)。
;#----------------------------------------------------------------------------
$LOCKTYPE = 1 if $LOCKTYPE eq "";
$LOCKFILE = "./file.lock" if $LOCKFILE eq "";
;#----------------------------------------------------------------------------
sub outscreen_html
{
	local( $title, $str ) = @_;
	print "Content-type: text/html\n\n";
	print <<HTML;
<!DOCTYPE HTML PUBLIC "-//W3C//DTD HTML 4.01 Transitional//EN" "http://www.w3.org/TR/1999/REC-html401-19991224/loose.dtd">
<HTML lang="ja">
<HEAD>
<META HTTP-EQUIV="Content-type" CONTENT="text/html; charset=Shift_JIS">
<META HTTP-EQUIV="Content-Language" CONTENT="ja">
<META HTTP-EQUIV="Pragma" CONTENT="no-cache">
<TITLE>$title</TITLE>
</HEAD>
<BODY bgcolor="#FFFFFF" leftmargin="5" topmargin="5" marginwidth="5" marginheight="5">
$str
<hr>
<div align="right"><font size="2">$CGI_NAME $CGI_VERSION Copyright &copy; 2006 <A HREF="http://www.junkperl.com/" target="_blank">JunkPerl.com</A> All right reserved.</font></div>
</BODY>
</HTML>
HTML
	if( $LOCKING == 1 ){ return 0 unless &unlock; }
	exit;
}
;#----------------------------------------------------------------------------
sub make_new_key
{
	local( *recs, $index_key ) = @_;
	local( $loop, $nkey, $chkflag );

	my $ret = &get_ltime( time, $sec, $tmin, $hour, $mday, $mon, $year, $todaynow, $wkday, $wday );
	$loop = 0;
	while( 1 ){
		$nkey = sprintf( "%02d%02d%02d%02d%02d%02d%02d", $year, $mon, $mday, $hour, $tmin, $sec, $loop );
		$chkflg = 0;
		foreach( @recs ){
			if( $nkey eq (split( /<>/, $_ ))[$index_key] ){
				$chkflg = 1;
				last;
			}
		}
		last if $chkflg == 0;
		$loop++;
	}
	return $nkey;
}
;#----------------------------------------------------------------------------
sub chg_sjis_post_str {
	local( *in ) = @_;
	local( $key, $val );
	while ( ($key,$val) = each %in ) {
		&jcode::convert( *val, "sjis", "", "z" );
		$in{$key} = $val;
	}
}
;#----------------------------------------------------------------------------
sub convert_rev_chk{
	local( $str, $tocode ) = @_;
	# $tcode : sjis / euc / jis
	local( $reverse, $chk );
	$str = pack( 'C*', unpack( 'C*', $str ) );
	foreach $chk ( "utf-8", "euc", "sjis", 'jis' ) {
		$result = $str;
		if( $chk eq "utf-8" ){
			&mojicode'convert( *result, $tocode, $chk );
			$reverse = $result;
			&mojicode'convert( *reverse, $chk, $tocode );
		}
		else{
			&jcode'convert( *result, $tocode );
			$reverse = $result;
			&jcode'convert( *reverse, $chk );
		}
		return ( $result, $chk ) if $str eq $reverse;
	}
	return( $str, undef );
}
;#----------------------------------------------------------------------------
sub s3c
{
	local( $value ) = @_;
	$value =~ s/(\d{1,3})(?=(?:\d\d\d)+(?!\d))/$1,/g;
	return $value;
}
;#----------------------------------------------------------------------------
sub lock {
	local( $ret );

	if( -e $LOCKFILE ) {
		&unlock if (stat( $LOCKFILE ))[9] < (time-60);
	}

	foreach( 1..5 ){
		$ret = symlink( ".", $LOCKFILE ) if $LOCKTYPE == 1;
		$ret = mkdir( $LOCKFILE, 0755 ) if $LOCKTYPE == 2;
		if( $ret ){
			$LOCKING = 1;				# unlock と連動
			return 1;
		}
		else{
			sleep(1);
		}
	}
	$ERR_MSG = "サーバが混雑しています。";
	return 0;
}
;#----------------------------------------------------------------------------
sub unlock {
	unlink( $LOCKFILE ) if $LOCKTYPE == 1;
	rmdir(  $LOCKFILE ) if $LOCKTYPE == 2;
	$LOCKING = 0;						# lock と連動
	return 1;
}
;#----------------------------------------------------------------------------
sub get_ltime
{
	local( $t, $sec, $tmin, $hour, $mday, $mon, $year, $todaynow, $wkday, $wday ) = @_;
	local( @week );
	local( $sec,$tmin,$hour,$mday,$mon,$year,$wday,$yday,$isdst ) = localtime($t);
	$mon++;
	$year = $year - 100;
	@week = ( "Sun", "Mon", "Tue", "Wed", "Thu", "Fri", "Sat" );
	$wkday = $week[$wday];
	$todaynow = sprintf( "%04d/%02d/%02d %02d:%02d:%02d", $year+2000, $mon, $mday, $hour, $tmin, $sec );
	@_[1] = $sec;
	@_[2] = $tmin;
	@_[3] = $hour;
	@_[4] = $mday;
	@_[5] = $mon;
	@_[6] = $year;
	@_[7] = $todaynow;
	@_[8] = $wkday;
	@_[9] = $wday;
	return $todaynow;
}
;#----------------------------------------------------------------------------

1;

