#============================================================
# Utils
#============================================================
package Utils;
use Common;
@ISA = qw(Common);

#公開したいサブルーチン
#@EXPORT = qw(DelSpace Reduce01 MakePath MakePath2 RegExpQuote);

use strict;
use Digest::MD5  qw(md5_base64);
use Digest::SHA1 qw(sha1_base64);

use Jcode;
use Cwd;
use File::Find;
use HTTP::Request::Common;
use HTTP::Cookies;
use MIME::Base64;
use Hash::Util qw(lock_keys unlock_keys);
eval('use Crypt::RC4;');
use Time::Local;
#eval('use Email::Valid;');
use File::Copy;# (copy, move);
use File::Copy::Recursive qw(fcopy rcopy dircopy);

use Deps;
use JFile;

my @LeapYear = (0, 31, 29, 31, 30, 31, 30, 31, 31, 30, 31, 30, 31);
sub LeapYear { return @LeapYear; }
my @NormYear = (0, 31, 28, 31, 30, 31, 30, 31, 31, 30, 31, 30, 31);
sub NormYear { return @NormYear; }

#===============================================
# デバッグ関係変数
#===============================================
my $Debug = 0;

#===============================================
# 文字コード関係変数
#===============================================
# sjis, euc, jis, noconv, utf8
my $FileSystemCharCode = Deps::FileSystemCharCode();
my $PerlCharCode       = Deps::PerlCharCode();
my $MySQLCharCode      = Deps::MySQLCharCode();
my $WebCharCode        = Deps::WebCharCode();
my $WebCharSet         = Deps::WebCharSet();

#===============================================
# スクリプト大域変数
#===============================================
my $LF = Deps::LF();
my $DirectorySeparator = Deps::DirectorySeparator();
my $OS = Deps::OS();

sub IsCGI
{
	my $method = $ENV{'REQUEST_METHOD'};
	return 0 if(!defined $method);
	return 1 if(uc $method eq 'POST' or uc $method eq 'GET');
	return 0;
}

sub IsWindows
{
	return 1 if($OS =~ /MSWin/i);
	return 0;
}

sub IsLinux
{
	return 1 if($OS =~ /Linux/i);
	return 0;
}

sub IsUnix
{
	return 1 if($OS =~ /Unix/i);
	return 0;
}

sub sleep
{
	my ($sec) = @_;
	select(undef, undef, undef, $sec);
}

sub GetIPAddress
{
	return $ENV{'REMOTE_ADDR'};
}

sub IsAllowedIPAddress
{
	my ($IPAddress, @allowed) = @_;
	
	foreach my $exp (@allowed) {
		return 1 if($IPAddress =~ /$exp/i);
	}
	return 0;
}

sub Round
{
	my ($v, $dec, $RaiseDecimal) = @_;
	$dec = 4 unless($dec);
	return 0.0 if(abs($v) < 1.0e-100);

	my $k = 1.0;
	my $av = abs($v);
	my $i = 0;
	while($av < 10) {
		$av *= 10;
		$k  *= 10;
		$i++;
		last if($i > 20);
	}
	while(1 <= $av) {
		$av *= 0.1;
		$k  *= 0.1;
	}
#print "av=$av  v=$v  k=$k\n";
	$v = $v * $k;
	if($RaiseDecimal) {
		my $coef = 1.0;
		for(my $i = 0 ; $i < $dec ; $i++) {
			$coef *= 0.1;
		}
		$RaiseDecimal -= $coef;
#print "v1=$v  RD: $RaiseDecimal\n";
		$v += $RaiseDecimal * $coef if($v > 0.0);
		$v -= $RaiseDecimal * $coef if($v < 0.0);
#print "v2=$v\n";
	}
	if($v =~ /^[-+]/) {
		$v = substr($v, 0, $dec+3);
	}
	else {
		$v = substr($v, 0, $dec+2);
	}
	$v = $v / $k;
#print "v3=$v\n";
	return $v;
}

sub RoundParameter
{
	my ($x, $tol) = @_;
	return $tol * int( ($x+0.1*$tol) / $tol );
}

sub ExtractUniqueElement
{
	my ($pArray, $Sort) = @_;

	my %hash;
	foreach my $s (@$pArray) {
		$hash{$s}++;
	}
	return sort keys %hash if($Sort);
	return keys %hash;
}

sub IsIncludedInArray
{
	my ($key, $pArray, $CaseSensitive) = @_;
	$CaseSensitive = 0 if(!defined $CaseSensitive);

	$key = uc $key if(!$CaseSensitive);
	for(my $i = 0 ; $i < @$pArray ; $i++) {
		if($CaseSensitive) {
			return 1 if($pArray->[$i] eq $key);
		}
		else {
			return 1 if(uc $pArray->[$i] eq $key);
		}
	}
	return 0;
}

sub RemoveSpaceElement
{
	my @array;
	for(my $i = 0 ; $i < @_ ; $i++) {
		my $s = $_[$i];
		DelSpace($s);
		push(@array, $_[$i]) if($s ne '');
	}
	return @array;
}

sub LockHashKeys
{
	my ($pHash, $f) = @_;
	$f = 1 if(!defined $f);
	return lock_keys(%$pHash) if($f);
	return unlock_keys(%$pHash);
}

sub MergeHashByCondition
{
	my ($pTarget, $pHash, $NotExistOnly) = @_;
	return $pTarget if($pTarget == $pHash);
	$NotExistOnly = 1 if(!defined $NotExistOnly);

	foreach my $key (keys %$pHash) {
		if(!$NotExistOnly or !defined $pTarget->{$key}) {
			$pTarget->{$key} = $pHash->{$key};
		}
	}
	return $pTarget;
}

sub MergeHash
{
	my (@pHash) = @_;
	return $pHash[0] if(@pHash == 2 and $pHash[0] == $pHash[1]);
#print "h=", join(', ', @pHash, "\n");

	my $ph0 = $pHash[0];
	for(my $i = 1 ; $i < @pHash ; $i++) {
		my $ph = $pHash[$i];
		next if(!defined $ph);
		foreach my $key (keys %$ph) {
			$ph0->{$key} = $ph->{$key};
		}
	}
	return $ph0;
}

sub RevertHash
{
	my ($pHash) = @_;
	my %NewHash;
	foreach my $k (keys %$pHash) {
		my $s = $pHash->{$k};
		$NewHash{$s} = $k;
	}
	return %NewHash;
}

sub BuildHashFromHashArray
{
	my ($pList, $pHash, $key) = @_;
	return {} if(!$pList);
	$pHash = {} if(!$pHash);

	for(my $i = 0 ; $i < @$pList ; $i++) {
		my $pi = $pList->[$i];
		my $k = $pi->{$key};
		$pHash->{$k} = $pi;
	}
	return $pHash;
}

sub MergeListHash
{
	my ($App, @list) = @_;
	my %hash;
	my @List;
	for(my $i = 0 ; $i < @list ; $i += 2) {
		my $var = $list[$i];
		my $varkey = ($var eq '')? ':blank:' : $var;
		my $val = $list[$i+1];
#$App->print("var=[$varkey]\n");
		if(!defined $hash{$varkey}) {
			@List = (@List, $var, $val);
			$hash{$varkey}++;
		}
	}
	return @List;
}

sub MergeList
{
	my (@list) = @_;
	my %hash;
	my @List;
	for(my $i = 0 ; $i < @list ; $i++) {
		if(!$hash{$list[$i]}) {
			@List = (@List, $list[$i]);
			$hash{$list[$i]}++;
		}
	}
	return @List;
}

sub DeleteItemFromList
{
	my ($plist, $pdeletelist) = @_;
	my @List;
	my %Registered;
	for(my $i = 0 ; $i < @$plist ; $i++) {
		my $key = $plist->[$i];
		my $Delete = 0;
		for(my $j = 0 ; $j < @$pdeletelist ; $j++) {
			if($key eq $pdeletelist->[$j]) {
				$Delete = 1;
				last;
			}
		}
		if(!$Delete and !defined $Registered{$key}) {
			@List = (@List, $key);
			$Registered{$key}++;
		}
	}
	return @List;
}

sub ListToHash
{
	my ($plist, $phash) = @_;
	for(my $i = 0 ; $i < @$plist ; $i += 2) {
		$phash->{$plist->[$i]} = $plist->[$i+1];
	}
}

sub Split
{
	my ($RegExp, $str, $RemoveBlank) = @_;
	$RemoveBlank = 1 if(!defined $RemoveBlank);
	my @a = split(/$RegExp/, $str);
	@a = Utils::RemoveSpaceElement(@a) if($RemoveBlank);
	return @a;
}

sub FindAll
{
	my ($RegExp, $str) = @_;
	my (@a, $found, $rest);
	while(1) {
		$rest = "";
		($found, $rest) = ($str =~ /($RegExp)(.*)$/);
#print "f=$found, $rest [$str]\n";
		push(@a, $found);
		last if($rest eq '');
		$str = $rest;
	}
	return Utils::RemoveSpaceElement(@a);
}

sub MergeName
{
	my ($FirstName, $LastName) = @_;
	return $FirstName if($LastName eq '');
	return $LastName  if($FirstName eq '');

	my $Name;
	if($LastName =~ /^[a-zA-Z\s\.\,\/\(\)]*$/ and $FirstName =~ /^[a-zA-Z\s\.\,\/\(\)]*$/) {
		$Name = "$FirstName $LastName";
	}
	else {
		$Name = "$LastName $FirstName";
	}
	Utils::DelSpace($Name);
	return $Name;
}

sub SplitName
{
	my ($Name) = @_;
	&DelSpace($Name);
	return ('', '') if($Name eq '');

	my ($FirstName, $LastName);
my $code = Jcode::getcode($Name);
#print "code: $code<br>\n";
#	if($Name =~ /^[a-zA-Z\s\.,\-+\~\/\(\)\*:]+$/) {
	if($code =~ /ascii/i) {
#		my @a = Utils::Split("\\s+", $Name);
		if($Name =~ /,/) {
			$Name =~ /^([\w\-\']+)[\s,]+(.*)\s*$/;
			$FirstName = $2;
			$LastName  = $1;
		}
		elsif($Name =~ /^(.+)\s+([\w\-\']+)\s*$/) {
			$FirstName = $1;
			$LastName  = $2;
		}
		elsif($Name =~ /^(.+)\s+(\S+)\s*$/) {
			$FirstName = $1;
			$LastName  = $2;
		}
		else {
			$FirstName = '';
			$LastName  = $Name;
		}
	}
	else {
#		my ($a, $b) = Utils::Split("\\s+", $Name);
#		if($Name =~ /^([\w\.]+?)[\s,]+(.*)$/) {
		if($Name =~ /^([\S]+?)[\s,]+(.*)$/) {
			$FirstName = $2;
			$LastName  = $1;
		}
		else {
			$FirstName = '';
			$LastName  = $Name;
		}
	}
	Utils::DelSpace($FirstName);
	Utils::DelSpace($LastName);
	if($FirstName eq '' and $Name =~ /\./) {
		$Name =~ /^(.*\.)\s*(.*?)$/;
		$FirstName = $1;
		$LastName  = $2;
		Utils::DelSpace($FirstName);
		Utils::DelSpace($LastName);
	}

	return ($FirstName, $LastName);
}

sub Sort
{
	return ($_[1], $_[0]) if($_[0] > $_[1]);
	return ($_[0], $_[1]);
}

sub Swap
{
	return ($_[1], $_[0]);
}

sub DelSpace($)
{
	my ($s) = @_;
	return $s unless(defined $s);
	$s =~ s/[\r\n\s]+$//;
	$s =~ s/^[\r\n\s]+//;
	return $_[0] = $s;
}

sub DelQuote
{
	my ($s) = @_;
	
	chomp($s);
	$s =~ s/^\s*//;
	$s =~ /^(.)(.*)(.)$/;
	my $firstchar = $1;
	my $restchar  = $2;
	my $lastchar  = $3;
	if($firstchar eq '"' and $lastchar eq '"') {
		return $_[0] = $restchar
	}
	if($firstchar eq '\'' and $lastchar eq '\'') {
		return $_[0] = $restchar
	}
	return $restchar
		if($firstchar eq '\'' and $lastchar eq '\'');
	return $_[0];
}

sub Reduce01($)
{
	my ($x) = @_;

	while($x < 0.0) {
		$x += 1.0;
	}
	while($x >= 1.0) {
		$x -= 1.0;
	}
	return $x;
}

sub CalMinMax
{
	my ($pArray, $CompareAbsoluteValue) = @_;
	$CompareAbsoluteValue = 0 if(!defined $CompareAbsoluteValue);

	my ($min, $max) = (1.0e99, -1.0e99);
	if($CompareAbsoluteValue) {
		for(my $i = 0 ; $i < @$pArray ; $i++) {
			my $v = abs($pArray->[$i]);
			$min = $v if($min > $v);
			$max = $v if($max < $v);
		}
	}
	else {
		for(my $i = 0 ; $i < @$pArray ; $i++) {
			my $v = $pArray->[$i];
			$min = $v if($min > $v);
			$max = $v if($max < $v);
		}
	}
	return ($min, $max);
}

sub CalMinMaxStep
{
	my ($pArray) = @_;

	my $nData = @$pArray;
	return 0.0 if($nData <= 1);
	my ($min, $max) = (1.0e99, -1.0e99);
	for(my $i = 0 ; $i < $nData -1 ; $i++) {
		my $v = abs($pArray->[$i+1] - $pArray->[$i]);
		$min = $v if($min > $v);
		$max = $v if($max < $v);
	}
	return ($min, $max);
}

sub IsDecreasingArray
{
	my ($pArray) = @_;
	my $n = @$pArray;
	for(my $i = 0 ; $i < $n-1 ; $i++) {
		return 0 if($pArray->[$i] < $pArray->[$i+1]);
	}
	return 1;
}

sub IsIncreasingArray
{
	my ($pArray) = @_;
	my $n = @$pArray;
	for(my $i = 0 ; $i < $n-1 ; $i++) {
		return 0 if($pArray->[$i] > $pArray->[$i+1]);
	}
	return 1;
}

sub IsConstantStepArray
{
	my ($pArray, $EPS) = @_;
	$EPS = 1.0e-6 if(!defined $EPS);

	return 1 if(@$pArray <= 2);
	my $dX0 = $pArray->[1] - $pArray->[0];
	return 0 if($dX0 == 0.0);

	for(my $i = 1 ; $i < @$pArray - 1 ; $i++) {
		my $dX = $pArray->[$i+1] - $pArray->[$i];
		if(abs(($dX - $dX0) / $dX0) > $EPS) {
			return 0;
		}
	}
	return 1;
}

sub RegExpQuote
{
	return Deps::RegExpQuote(@_);
}

sub QPEncode
{
	my ($string) = (@_);

	$string =~ s/=/=3D/g;
	$string =~ s/\t$/=09/;
	$string =~ s/ $/=20/;
	$string =~ s/([^!-" \t])/&StringToHex($1)/eg;
	return $string;
}

sub QPDecode
{
	my ($string) = (@_);

	$string =~ s/=\r\n//g;
	$string =~ s/=\n//g;
	$string =~ s/=\r//g;
	$string =~ s/=([0-9a-z]{2})/pack("C",hex($1))/gei;
	return $string;
}

sub URLEncode
{
	my ($s, $KeepSlash) = (@_);
	$s =~ s/([^\w ])/'%' . unpack('H2', $1)/eg;
	$s =~ tr/ /+/;

	$s =~ s/%2f/\//g if($KeepSlash);

	return $s;
}

sub URLDecode
{
	my ($s2) = (@_);
#print "s0: $s2<br>\n";
	$s2 =~ tr/+/ /;
	$s2 =~ s/%([0-9A-Fa-f][0-9A-Fa-f])/pack('H2', $1)/eg;
#print "s1: $s2<br>\n";
	return $s2;
}

sub ChrToHTMLCode
{
	my ($char) = @_;
	return sprintf("&#%03d;", unpack('c', $char));
}

sub HexDecode
{
	my ($s2) = (@_);
	$s2 =~ s/([0-9A-Fa-f][0-9A-Fa-f])/pack('H2', $1)/eg;
	return $s2;
}

sub IntToAlpha
{
	my ($i) = @_;

#for(my $i = 0 ; $i < 26 ; $i++) {
#my $a = chr($i + 97);
#my $a = $alphabet[$i];
#print "$i: $a\n";
#}

	my $base = 26;

	return 'a' if($i == 0);
	my $n = int(log($i) / log($base));
	my @A;
	for(my $nn = $n ; $nn >= 1 ; $nn--) {
		my $k = $base**$nn;
		$A[$nn] = int($i / $k);
		$i = $i - $A[$nn] * $k;
	}
	$A[0] = $i;

	my $s = '';
	for(my $i = $n ; $i >= 0 ; $i--) {
#print "$i: A=$A[$i]\n";
		if($i > 0) {
			$s = $s . chr($A[$i] + 97 - 1);
		}
		else {
			$s = $s . chr($A[$i] + 97);
		}
	}
#print "s=$s\n";
#exit;
	return $s;
}

my $Base64Alphabet = 'ABCDEFGHIJKLMNOPQRSTUVWXYZ'.
                  'abcdefghijklmnopqrstuvwxyz'.
                  '0123456789+/'; # and '='
my $Base64Pad = '=';

# b64decodesub -- takes some characters in the base64 alphabet and
# returns the raw bytes that they represent.
sub Base64DecodeSub
{
#    local ($_) = @_[0];
    local ($_) = @_;
             
    # translate each char to a value in the range 0 to 63
    eval qq{ tr!$Base64Alphabet!\0-\77!; };
    # keep 6 bits out of every 8, and pack them together
    $_ = unpack('B*', $_); # look at the bits
    s/(..)(......)/$2/g;   # keep 6 bits of every 8
    s/((........)*)(.*)/$1/; # throw away spare bits (not multiple of 8)
    $_ = pack('B*', $_);   # turn the bits back into bytes
    $_; # return
}

sub Base64Decode2
{
	my ($str) = (@_);

	my $leftover = '';

	# ignore illegal characters
	$str =~ s/[^$Base64Alphabet]//go;
	# insert the leftover stuff from last time
	$str = $leftover . $str;
	# if there are not a multiple of 4 bytes, keep the leftovers for later
	$str =~ m/^((....)*)/; 
	$str = $&; 
	$leftover = $';
	# turn each group of 4 values into 3 bytes
	$str =~ s/(....)/&Base64DecodeSub($1)/eg;
	# special processing at EOF for last few bytes
	if (eof)
	{
		$str .= &Base64DecodeSub($leftover); 
		$leftover = '';
	}
	# output it
	
	return $str;
}

sub Base64Decode
{
	return decode_base64($_[0]);
}

sub Base64Encode
{
	return encode_base64($_[0]);
}

sub Encode
{
	my ($passphrase, $str, $method) = @_;
	$method = "RC4:Base64" if(!defined $method);
	my $dec;
	if($method =~ /RC4/i) {
		$dec = RC4($passphrase, $str);
	}
	else {
		$dec = $str;
	}
	if($method =~ /Base64/i) {
		$dec = Utils::Base64Encode($dec);
		Utils::DelSpace($dec);
		$dec =~ s/=+$//;
	}
	return $dec;
}

sub Decode
{
	my ($passphrase, $str, $method) = @_;
	$method = "RC4:Base64" if(!defined $method);
	my $enc;
	if($method =~ /Base64/i) {
		$enc = Utils::Base64Decode($str);
	}
	else {
		$enc = $str;
	}
	if($method =~ /RC4/i) {
		$enc = RC4($passphrase, $enc);
	}
	return $enc;
}

sub CryptForHTPasswd
{
	my ($pw) = @_;

	my @salt_set = ('a'..'z','A'..'Z','0'..'9','.','/');
	srand();
	my $idx1 = int(rand(63));
	my $idx2 = int(rand(63));
	my $salt = $salt_set[$idx1] . $salt_set[$idx2];
	my $encpw =crypt($pw, $salt);
	return $encpw;
}

sub Crypt
{
	my ($method, $key, @strings) = @_;
	if($method =~ /plain/i) {
		return $strings[0];
	}
	elsif($method =~ /md5/i) {
		return md5_base64(@strings, $key);
	}
	elsif($method =~ /sha-?1/i) {
		return sha1_base64(@strings, $key);
	}
	return crypt($strings[0], $key);
}

sub MakePath2
{
	my ($dir, $pfnames, $separator, $DoTerminate, $QuotationMode) = @_;
	$QuotationMode = '' if(!defined $QuotationMode);

	return $dir if(!defined $pfnames or @$pfnames == 0);
	my $path = &MakePath($dir, $pfnames->[0], $separator, $DoTerminate);
	for(my $i = 1 ; $i < @$pfnames ; $i++) {
		$path = &MakePath($path, $pfnames->[$i], $separator, $DoTerminate, "");
	}
	if($QuotationMode eq 'auto') {
		$path = "\"$path\"" if($path =~ /\s/);
	}
	if($QuotationMode eq 'quote') {
		$path = "\"$path\"";
	}
	return $path;
}

sub MakePath
{
	my ($dir, $fname, $separator, $DoTerminate, $QuotationMode) = (@_);
	$QuotationMode = '' if(!defined $QuotationMode);

	if(ref $fname eq 'ARRAY') {
		return &MakePath2($dir, $fname, $separator, $DoTerminate);
	}

	my $RegSep = &RegExpQuote($separator);
	my $IsHeadSep = 0;

#print "[$dir] ($fname) : $RegSep : ";
	$fname =~ s/^$RegSep//;
	$fname =~ s/$RegSep$//;
#print "($fname)\n";

	if($dir =~ /$RegSep$/) {
		$dir .= $fname;
	}
	elsif($dir eq '') {
		$dir = $fname;
	}
	else {
		$dir .= $separator . $fname;
	}
	if($DoTerminate) {
		unless($dir =~ /$RegSep$/) {
			$dir .= $separator;
		}
	}
	else {
		if($dir ne '/' and $dir =~ /$RegSep$/) {
			$dir =~ s/$RegSep$//;
		}
	}

	if($QuotationMode eq 'auto') {
		$dir = "\"$dir\"" if($dir =~ /\s/);
	}
	if($QuotationMode eq 'quote') {
		$dir = "\"$dir\"";
	}
	return $dir;
}

sub ConvertDirectorySeparator
{
	my ($path, $src, $target, $DoTerminate) = (@_);

	Utils::DelSpace($path);
	return $_[0] = $path if($path eq '');

	$src = &RegExpQuote($src);
	my $RegTarget = &RegExpQuote($target);

	my $CharCodeConverted = 0;
	my $code = Jcode::getcode($path);
	if($code ne 'ascii' and $code ne 'euc') {
		$CharCodeConverted = 1;
		Jcode::convert(\$path, 'euc');
	}

	$path =~ s/$src/$target/g;
	if($DoTerminate) {
		unless($path =~ /$RegTarget$/) {
			$path = "$path$target";
		}
	}
	else {
		if($path =~ /$RegTarget$/) {
			$path =~ s/$target$//;
		}
	}

	if($CharCodeConverted) {
		Jcode::convert(\$path, $code, 'euc');
	}

	return $_[0] = $path;
}

sub ReduceDirectory {
	my ($dir, $sep, $App) = @_;
#$App->print("dir[$dir]\n") if($App);
	$sep       = '/' if(!defined $sep);
	my $RegSep = &RegExpQuote($sep);

my $code = Jcode::getcode($dir);
my $workcode = 'utf8';
Jcode::convert(\$dir, $workcode, $code) if($code ne '' and $code ne 'ascii');

	if($dir eq '.') {
		return cwd();
	}
#$App->print("dir[$dir]\n") if($App);
	my ($drive, $dir0) = ($dir =~ /^([a-zA-Z]:)?(.*)$/);
#$App->print("[$drive][$dir0]\n") if($App);
	if($dir0 !~ /^[\\\/]/) {
		$dir = Deps::MakePath(cwd(), $dir0);
		if($drive ne '') {
			$dir = "$drive$dir";
		}
	}
#$App->print("d[$dir]\n") if($App);
	$dir =~ s/[\\\/]/$sep/g;
#$App->print("d[$dir]\n") if($App);
	my $IsHeadSep = 0;
	my $IsLastSep = 0;
	$IsHeadSep = 1 if($dir =~ /^$RegSep/);
	$IsLastSep = 1 if($dir =~ /$RegSep$/);

	my @d = split(/$RegSep/, $dir);
	my @d2;
	for(my $i = 0 ; $i < @d ; $i++) {
		next if($d[$i] eq '.');
		if($d[$i] eq '..') {
			pop(@d2);
			next;
		}
		push(@d2, $d[$i]);
	}

	if($IsHeadSep) {
		$dir = $sep;
	}
	else {
		$dir = '';
	}

	foreach my $dd (@d2) {
		if($dir eq '') {
			$dir = $dd;
			next;
		}
		next if($dd eq '');
		$dir = Utils::MakePath($dir, $dd, $sep, 0);
	}
	$dir = Utils::MakePath($dir, $sep, $sep, 0) if($IsLastSep);

Jcode::convert(\$dir, $code, $workcode) if($code ne '' and $code ne 'ascii');

	return $_[0] = $dir;
}

sub MakeRelativePath
{
	my ($SourceURL, $ParentURL, $Separator, $ForceDir) = (@_);
	$ForceDir = 0 if(!defined $ForceDir);

	if(!defined $Separator or $Separator eq '') {
		$Separator = $DirectorySeparator;
		if($Separator ne '\\') {
			$SourceURL =~ s/\\/$Separator/g;
			$ParentURL =~ s/\\/$Separator/g;
		}
		elsif($Separator ne '/') {
			$SourceURL =~ s/\//$Separator/g;
			$ParentURL =~ s/\//$Separator/g;
		}
	}
	my $RegSeparator = &RegExpQuote($Separator);

	my $IsDir = ($ParentURL =~ /$RegSeparator$/ or -d $ParentURL)? 1 : 0;
	$IsDir = 1 if($ForceDir);
	my $HeadLevel = 1; #2;
	$HeadLevel = 3 if($SourceURL =~ m|://|);

#$Debug=1;
if($Debug) {
	print "*IsDir: $IsDir\n";
	print "*HeadLevel: $HeadLevel\n";
	print "*SourceURL: $SourceURL\n";
	print "*ParentURL: $ParentURL\n";
	print "*Separator: $Separator\n";
}
	my @EachSourceStr = split(/$RegSeparator/, $SourceURL);
	my @EachParentStr = split(/$RegSeparator/, $ParentURL);
	my $pt = 0;
	for(my $i = 0 ; $i < @EachSourceStr ; $i++) {
if($Debug) {
	print "  es[$i]: ", lc $EachSourceStr[$i], "\n";
	print "  ep[$i]: ", lc $EachParentStr[$i], "\n";
}

		if(lc $EachSourceStr[$i] eq lc $EachParentStr[$i]) {
		}
		else {
			$pt = $i;
			last;
		}
		$pt = $i;
	}
if($Debug) {
	print "PT: $pt\n";
}
#絶対パスしかない場合
	return "" if(($EachSourceStr[0] =~ /^\w:/ and $pt < $HeadLevel) or
		     ($EachSourceStr[0] !~ /^\w:/ and $pt < $HeadLevel-1) );

	my $TotalLevel = @EachParentStr - $pt - 1 + $IsDir;
if($Debug) {
	print "TotalLevel: $TotalLevel\n";
}

	my $RelPath = '';
	for(my $i = 0 ; $i < $TotalLevel ; $i++) {
		$RelPath = Utils::MakePath($RelPath, "..", $Separator, 0);
	}
	for(my $i = $pt ; $i < @EachSourceStr ; $i++) {
		$RelPath = '.' if($RelPath eq '');
		$RelPath = Utils::MakePath($RelPath, $EachSourceStr[$i], $Separator, 0);
	}
if($Debug) {
	print "*RelPath: $RelPath\n";
}

	return $RelPath;
}

# <IN>  年、月
# <OUT> その月の最初の曜日、その月の合計日数
# 基準: (Sun)10/17/1582
sub GetFirstWday
{
	my ($yyyy, $mm) = @_;
	my ($y, $m, $d);
	my ($days, @ydays, $ydays, $wday);

	if ($yyyy eq '') {
		($yyyy, $mm) = getDate();
	}

	my ($leap) = 0;

	@ydays = Utils::leap($yyyy) ? Utils::LeapYear() : Utils::NormYear();
	my $l  = Utils::leap($yyyy);
	return Utils::getDayOfWeek($yyyy, $mm, 1), $ydays[$mm];
	return Utils::getDayOfWeek($yyyy, $mm, 1), Utils::getDaysOfMonth($mm);
}

sub LocalTimeToTime
{
	my ($year, $month, $mday, $hour, $min, $sec, $DiffHours, $StartYear) = @_;
	$DiffHours = 0 if(!defined $DiffHours);
	$StartYear = 1970 if(!defined $StartYear);

	my $offset = 0;
#	if($hour >= 24) {
#		$offset = -$hour * 60 * 60;
#		$hour = 0;
#	}
	my $hour1 = $hour - $DiffHours;
	my $reshour = $hour1 % 24;
	my $i24     = int($hour1 / 24);
#print "h: $hour, $hour1, $reshour, $i24<br>\n";
	$year = 1970 if($year < 1970);
	$month = 1 if($month < 1 or $month > 12);
	my ($FirstDayOfMonday, $DaysInMonth) = Utils::GetFirstWday($year, $month);
	$mday = 1            if($mday <= 0);
	$mday = $DaysInMonth if($mday > $DaysInMonth);
	$sec  = 0            if($sec <= 0 or $sec > 60);
#print "dif=$DiffHours: $year/$month/$mday $hour:$min:$sec<br>\n";
	my $time;
#print "m: $year/$month/$mday $hour1:$min:$sec\n";
	$time = &timelocal($sec, $min, $reshour, $mday, $month-1, $year) + $i24*24*60*60 + $offset;  #JST
#	eval('$time = &timelocal($sec, $min, $hour1, $mday, $month-1, $year) + $offset');  #JST
return $time;


	my $TotalDay = 0;
	for(my $y = $StartYear ; $y <= $year - 1 ; $y++) {
		my $IsLeapYear = Utils::leap($y);
		for(my $m = 1 ; $m <= 12 ; $m++) {
			$TotalDay += Utils::getDaysOfMonth($y, $m);
		}
#print "$y: $IsLeapYear ($TotalDay)\n" if($y > 1990);
	}
	for(my $m = 1 ; $m <= $month-1 ; $m++) {
		$TotalDay += Utils::getDaysOfMonth($year, $m);
	}
	$TotalDay += $mday - 1;
	my $TotalSec = $TotalDay * 24 * 60 * 60 + $hour1 * 60 * 60 + $min * 60 + $sec;
#print "TotalSec: $TotalSec\n";
	return $TotalSec;
}

sub Execute
{
	my ($cmd, $IsPrint) = @_;
	$IsPrint = 1 if(!defined $IsPrint);
	print("  Execute [$cmd]...\n") if($IsPrint);
	my $ret = system($cmd);
	if($ret and $IsPrint) {
		print("    Error: execute [$cmd] failed with ret=$ret\n");
	}
	return $ret;
}

sub ExecuteWithPipe
{
	my ($cmd, $sourcecharcode, $targetcharcode, $LineByLine, $PrintCmdForError, $IsPrint, $App) = @_;
	$sourcecharcode   = 'sjis' if($sourcecharcode eq '');
	$targetcharcode   = 'sjis' if($targetcharcode eq '');
	$LineByLine       = 1      if(!defined $LineByLine);
	$PrintCmdForError = 1      if(!defined $PrintCmdForError);
	$IsPrint          = 1      if(!defined $IsPrint);

	print("  Execute [$cmd]...\n") if($IsPrint);
	my $ret = open(IN, "$cmd |");
	if($ret and $IsPrint) {
		print("    Error: execute [$cmd] failed with ret=$ret\n");
		return $ret;
	}

	my $s = '';
	my $s0;
	while(1) {
		my $line = <IN>;
		last if(!defined $line);
		Utils::DelSpace($line);
		next if($line eq '');

		if($PrintCmdForError and $line =~ /ERR/i) {
			$s0 = "$line [$cmd]\n"
		}
		else {
			$s0 = "$line\n";
		}

		if($LineByLine) {
Jcode::convert(\$line, $targetcharcode, $sourcecharcode);
			if($App) {
				$App->print($s0);
			}
			else {
				print($s0);
			}
		}
		else {
			if($PrintCmdForError and $line =~ /ERR/i) {
				$s .= $s0;
			}
			else {
				$s .= $s0;
			}
		}
	}
	close(IN);
	if(!$LineByLine) {
Jcode::convert(\$s, $targetcharcode, $sourcecharcode);
		if($App) {
			$App->print($s);
		}
		else {
			print($s);
		}
	}

	return 0;
}

sub DecomposeMailFrom
{
	my ($From) = @_;

	$From =~ s/&quot;/\"/g;
	$From =~ s/&lt;/\</g;
	$From =~ s/&gt;/\>/g;
	my ($EMail, $Sender) = ('', '');
	if($From =~ /<(.*?\@.*?)>/) {
		$EMail = $1;
		$From =~ s/<(.*?\@.*?)>//;
		DelSpace($EMail);
		DelSpace($From);
		DelQuote($From);
		return ($EMail, $From);
	}
	if($From =~ /\((.*)\)/) {
		$Sender = $1;
		$From =~ s/\((.*)\)//;
		DelSpace($Sender);
		DelQuote($Sender);
		DelSpace($From);
		return ($From, $Sender);
	}
	DelSpace($From);
	DelQuote($From);
	return ($From, '');
}

sub MailDateToDateString
{
	my ($date) = @_;
#Wed, 27 Aug 2008 07:08:21 +0900
	my %MonthName = ("Jan" => 1, "Feb" => 2, "Mar" => 3, "Apr" => 4, "May" => 1, "Jun" => 6, 
			 "Jul" => 7, "Aug" => 8, "Sep" => 9, "Oct" => 10, "Nov" => 11, "Dec" => 12);
	my ($wday, $mday, $mon, $year, $hour, $min, $sec, $timediff) = Utils::Split("[\\s:,]+", $date);
	return sprintf("%04d/%02d/%02d %02d:%02d:%02d", $year, $MonthName{$mon}, $mday, $hour, $min, $sec);
}

sub GetDateTime
{
	my ($time, $UseGengo) = (@_);
	$UseGengo = 1 if(!defined $UseGengo);
	$time = time() if(!defined $time);
	my ($sec, $min, $hour, $mday, $mon, $year, $wday, $yday, $isdst) = localtime($time);
	$year += 1900;
	$mon++;
	if($UseGengo) {
		if(($year == 2019 and $mon >= 5) or $year >= 2020) {
			return ($year, $mon, $mday, $hour, $min, $sec, $year-2018, $wday, $yday, $isdst);
		}
		elsif($year >= 1989) {
			return ($year, $mon, $mday, $hour, $min, $sec, $year-1988, $wday, $yday, $isdst);
		}
	}
	return ($year, $mon, $mday, $hour, $min, $sec, $year, $wday, $yday, $isdst);
}

sub GetYear
{
	my ($time, $UseGengo) = (@_);
	my ($year, $mon, $mday, $hour, $min, $sec, $year2, $wday, $yday, $isdst) = &GetDateTime($time, $UseGengo);
	return $year;
}

sub BuildDateString
{
	my ($time, $language, $format) = (@_);
	my @MonthName = ("Jan", "Feb", "Mar", "Apr", "May", "Jun", 
			 "Jul", "Aug", "Sep", "Oct", "Nov", "Dec");
	my @WeekDayName = ("Sun", "Mon", "Tue", "Wed", "Thu", "Fri", "Sat");

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

	if($time =~ /^\s*(\d+)\/(\d+)\/(\d+)\s+(\d+):(\d+):?(\d+)?/) { #2007/02/11  09:41:17
		($year, $mon, $mday, $hour, $min, $sec) = ($1, $2, $3, $4, $5, $6);
		$sec = 0 if(!defined $sec);
	}
	if($time =~ /^\s*(\d+)s*,\s*(\w+)s*,\s*(\d+)\s+(\d+):(\d+):?(\d+)?/) { #15, Mar, 2007  23:52:53
		($mday, $mon, $year, $hour, $min, $sec) = ($1, $2, $3, $4, $5, $6);
		for(my $i = 0 ; $i < 12 ; $i++) {
			if($MonthName[$i] =~ /$mon/i) {
				$mon = $i+1;
				last;
			}
		}
		$sec = 0 if(!defined $sec);
	}
#print "t:$time [$year/$mon/$mday $hour:$min:$sec]<br>\n";
	my $str;
	if($format) {
		$str = $format;
		$str =~ s/{year}/$year/g;
		$str =~ s/{month}/$mon/g;
		$str =~ s/{monthZero}/sprintf("%02d", $mon)/eg;
		$str =~ s/{day}/$mday/g;
		$str =~ s/{dayZero}/sprintf("%02d", $mday)/eg;
		$str =~ s/{hour}/$hour/g;
		$str =~ s/{hourZero}/sprintf("%02d", $hour)/eg;
		$str =~ s/{min}/$min/g;
		$str =~ s/{minZero}/sprintf("%02d", $min)/eg;
		$str =~ s/{sec}/$sec/g;
		$str =~ s/{secZero}/sprintf("%02d", $sec)/eg;
	}
	elsif(defined $language and $language =~ /SMTP(.*)$/i) {
		my $timediff = $1;
		$str = sprintf("%s, %d %s %04d %02d:%02d:%02d %s", 
			$WeekDayName[$wday], $mday, $MonthName[$mon-1], $year, 
			$hour, $min, $sec, $timediff);
	}
	elsif(defined $language and $language =~ /British\s?English/i) {
		$str = sprintf("%3s, %02d, %02d  %02d:%02d:%02d", 
			$MonthName[$mon-1], $mday, $year, $hour, $min, $sec);
	}
	elsif(defined $language and $language =~ /English/i) {
		$str = sprintf("%02d, %3s, %02d  %02d:%02d:%02d", 
			$mday, $MonthName[$mon-1], $year, $hour, $min, $sec);
	}
	else {
		$str = sprintf("%02d/%02d/%02d  %02d:%02d:%02d", 
			$year, $mon, $mday, $hour, $min, $sec);
	}
	return $str;
}

sub AddCommasToMoney
{
	my ($num) = @_;
	return &SeparateStringBy($num, ',', 3);
}

#$str を $nsep桁ごとに$sepで区切る
sub SeparateStringBy
{
	my ($str, $sep, $nsep) = @_;
	$str =~ s/\G((?:^[-+])?\d{1,$nsep})(?=(?:\d{$nsep})+(?!\d))/$1$sep/g;
	return $str;
}

sub GetSimplifiedSize
{
	my ($size, $factor, $ReturnInt, $nAddCommas) = @_;
	$factor = 10 if(!defined $factor);

	my $unit = '';
	if($size > 1024*$factor) {
		$size /= 1024;
		$unit = "K";
	}
	if($size > 1024*$factor) {
		$size /= 1024;
		$unit = "M";
	}
	if($size > 1024*$factor) {
		$size /= 1024;
		$unit = "G";
	}
	if($size > 1024*$factor) {
		$size /= 1024;
		$unit = "T";
	}
	$size = int($size) if($ReturnInt);
	$size = Utils::SeparateStringBy($size, ',', $nAddCommas);
	return ($size, $unit);
}

sub convert
{
	my ($pStr, $targetcharcode, $sourcecharcode) = @_;
	return ''     if(!defined $pStr or $pStr eq '');
	return $$pStr if(!defined $targetcharcode or $targetcharcode eq '' or $targetcharcode eq 'ascii' or $targetcharcode eq 'binary');

	$sourcecharcode = Jcode::getcode($$pStr) if(!defined $sourcecharcode);
	return $$pStr if(!defined $sourcecharcode or $sourcecharcode eq '' or $sourcecharcode eq 'ascii' or $sourcecharcode eq 'binary');

	Jcode::convert($pStr, $targetcharcode, $sourcecharcode);
	return $$pStr;
}

sub ConvertToValidFileName
{
	my ($fname) = @_;
	my ($drive, $directory, $filename, $ext1, $lastdir, $filebody) = Deps::SplitFilePath($fname);
	$filename =~ s/[\s:\\\/\*\?\|]/_/g;
	return Deps::MakePath("$drive$directory", $filename, 0);
}

sub FindExistingPath
{
	my (@paths) = @_;

	for(my $i = 0 ; $i < @paths ; $i++) {
		return $paths[$i] if(-e $paths[$i]);
	}
	return undef;
}

sub FindExistingDir
{
	my (@paths) = @_;

	for(my $i = 0 ; $i < @paths ; $i++) {
		return $paths[$i] if(-d $paths[$i]);
	}
	return undef;
}

sub FindExistingFile
{
	my (@paths) = @_;

	for(my $i = 0 ; $i < @paths ; $i++) {
		return $paths[$i] if(-f $paths[$i]);
	}
	return undef;
}

sub DeleteFile
{
	my ($infile, $DeleteDirectory) = (@_);

	if(-d $infile) {
		if(!$DeleteDirectory) {
			return 0;
		}
		return 0 if(!rmdir($infile));
		return 1;
	}
	return 0 if(!unlink($infile));
	return 1;
}

sub MoveFile
{
	my ($infile, $outfile) = (@_);

	if(-d $infile) {
		return 0 if(!rename($infile, $outfile));
		return 1;
	}
return move($infile, $outfile);

	my $ret = &CopyFile($infile, $outfile);
	return $ret if($ret != 1);
	return -3 if(!unlink($infile));
	return 1;
}

sub CopyFileRecursive
{
	my ($infile, $outfile, $buf) = (@_);
#fcopy($Source, $CopyTarget) or die $!;
if($buf) {
	return rcopy($infile, $outfile, $buf);
}
else {
	return rcopy($infile, $outfile);
}
#dircopy($Source, $CopyTarget) or die $!;
}

sub CopyFile
{
	my ($infile, $outfile, $buf) = (@_);

	my ($drive, $directory, $filename, $ext, $lastdir, $filebody) = Deps::SplitFilePath($outfile);
	$directory = "$drive$directory" if(defined $drive and $drive ne '');
	if(!-e $directory) {
		Deps::CreateDirecotry($directory);
	}
if($buf) {
	return copy($infile, $outfile);
}
else {
	return copy($infile, $outfile);
}

	open(IN, "<$infile") or return -1;
	binmode(IN);
	open(OUT, ">$outfile") or return -2;
	binmode(OUT);
	my @content = <IN>;
	print OUT @content;
	close(OUT);
	close(IN);
	my $time = GetWriteDate($infile);
	if($time) {
		utime($time, $time, $outfile) 
	}
	return 1;
}

sub DeleteDirectory
{
	my ($infile) = (@_);
	return 0 if(!rmdir($infile));
	return 1;
}

sub CreateDirectory
{
	my ($dir, $dirsep, $IsPrint) = @_;
	$IsPrint = 1 if(!defined $IsPrint);

	my $directorysep = $DirectorySeparator;
	$directorysep = $dirsep if($dirsep ne '');;

	$dir =~ s/\\/\//g;
#$Debug=1;
if($Debug) {
	print "CreateDirectory: $dir<br>\n";
}
#	my $IsHeadSep = 0;
#	$IsHeadSep = 1 if($dir =~ /^\//);

	my $IsRelative = 1;
	$IsRelative = 0 if($dir =~ /^[A-Za-z]:\// or $dir =~ /^\//);
#print "IsRelative: $IsRelative\n";
	my @eachpath = split(/\//, $dir);
	
	my $i = 0;
	my $path = "";
	if($eachpath[$i] =~ /^[A-Za-z]:/) {
		$path = $eachpath[$i];
		$i++;
	}
	$path .= $directorysep unless($IsRelative);

	for( ; $i < @eachpath ; $i++) {
		$path .= $eachpath[$i] . $directorysep;
if($Debug) {
	print "path: $path<br>\n";
}
		next if(-d $path);
		if(-f $path) {
			print "Can not create [$path]: $path is a file.\n" if($IsPrint);
			return 0;
		}
if($Debug) {
	print "    Create $path [$directorysep]<br>\n";
}
		mkdir($path);
	}
	return 1;
}

sub Glob
{
	my ($dir, $fmask, $Sort) = @_;

	my $pwd = getcwd();
	return () if(!chdir($dir));
	my @files = glob($fmask);
	@files = sort @files if($Sort);
	for(my $i = 0 ; $i < @files ; $i++) {
		$files[$i] = Utils::MakePath($dir, $files[$i], '/', 0);
#print "<b>f[$files[$i]]</b><br>\n";
	}
	chdir($pwd);

	return @files;
}

sub MyFindFile
{
	my ($dir, $RegExp) = @_;

	my @f;

	opendir my $dh, $dir or return undef;
	while (my $file = readdir $dh) {
		next if($file eq '.' or $file eq '..');
		push(@f, $file) if($RegExp eq '' or $file =~ /$RegExp/i);
	}
	closedir $dh;

	return @f;
}

my @FileArrayForSearchFilesRecursive;
sub AddFileForSearchFilesRecursive
{
	push(@FileArrayForSearchFilesRecursive, $File::Find::name);
}

sub SearchFilesRecursive
{
	my ($dir, $pFiles) = @_;
	@FileArrayForSearchFilesRecursive = ();
	find(\&AddFileForSearchFilesRecursive, $dir);
	return @$pFiles = @FileArrayForSearchFilesRecursive;
}

sub SearchFilesRecursive2
{
	my ($dir, $fmask, $nLevel, $pFiles, $Sort, $func, %arg) = @_;
	$fmask  = '*' if(!defined $fmask);
	$nLevel = 1   if(!defined $nLevel);
	$Sort   = 0   if(!defined $Sort);

	my $path0    = Deps::MakePath($dir, $fmask, 0);
	my $DirPath0 = Deps::MakePath($dir, '*', 0);
#print "Path[$path0]\n";

	my @dir = glob($DirPath0);
#	my @dir = Utils::Glob($dir, '*');
	for my $path (@dir) {
#print("path: $path\n");
		if($path =~ /[\\\/]\.$/ or $path =~ /[\\\/]\.\.$/) {
#print("path [$path] is . or ..: skip\n");
			next;
		}
		if(!-d $path) {
#print("path [$path] is not dir: skip\n");
			next;
		}
#print "Utils::SearchFilesRecursive2: Found Dir [$path]\n";
print "Utils::SearchFilesRecursive2: Found Dir [$path]\n" if($arg{Debug});

		if(!defined $func or &$func($path) == 1) {
			push(@$pFiles, $path);
		}

		if($nLevel != 0) {
			&SearchFilesRecursive2($path, $fmask, $nLevel-1, $pFiles, $Sort, $func, %arg);
		}
	}

	my @files = glob($path0);
#	my @files = Utils::Glob($dir, $fmask);
	for my $path (@files) {
		next if(-d $path and !$arg{SearchDir});
print "Utils::SearchFilesRecursive2: Found File [$path]\n" if($arg{Debug});

#		my $path = Utils::MakePath($dir, $f, '/', 0);
#print "File [$path]\n";
		if(!defined $func or &$func($path) == 1) {
			push(@$pFiles, $path);
		}
	}
	@$pFiles = sort { $a cmp $b; } @$pFiles if($Sort);
	return @$pFiles;
}

sub SearchFilesRecursive3
{
	my ($dir, $fmask, $nLevel, $pFiles, $Sort, $func, %arg) = @_;
	$fmask  = '*' if(!defined $fmask);
	$nLevel = 1   if(!defined $nLevel);
	$Sort   = 0   if(!defined $Sort);

	my $path0    = Deps::MakePath($dir, $fmask, 0);
	my $DirPath0 = Deps::MakePath($dir, '*', 0);
print "Search path [$path0]\n";

	my @dir = Utils::MyFindFile($dir, '');
	for my $path (@dir) {
		next if($path eq '.' or $path eq '..');
		my $path1 = Utils::MakePath($dir, $path, '/', 0);
print "Utils::SearchFilesRecursive3: Found Dir [$path1]\n" if($arg{Debug});
		next if(!-d $path1);

		if($nLevel != 0) {
			&SearchFilesRecursive3($path1, $fmask, $nLevel-1, $pFiles, $Sort, $func, %arg);
		}
	}

	my @files = Utils::MyFindFile($dir, $fmask);
	for my $path (@files) {
		my $path1 = Utils::MakePath($dir, $path, '/', 0);
		next if(-d $path1);
print "Utils::SearchFilesRecursive3: Found File [$path1]\n" if($arg{Debug});

#print "File [$path1]\n";
		if(!defined $func or &$func($path1) == 1) {
			push(@$pFiles, $path1);
		}
	}
	@$pFiles = sort { $a cmp $b; } @$pFiles if($Sort);
	return @$pFiles;
}

sub FindFuncForSearchFilesRecursive4
{
    my $path = $File::Find::dir . '/' . $_;
print "Check path [$path]\n";
	return 1;
};

sub SearchFilesRecursive4
{
	my ($dir, $func) = @_;
	find($func, ($dir));
}

sub ChangeMode
{
	my ($path, $mode) = @_;
	return chmod(oct($mode), $path);
}

sub PrintList
{
	my (@a) = @_;
	for(my $i = 0 ; $i < @a ; $i++) {
		print "$i: [$a[$i]]\n";
	}
}

sub PrintHash
{
	my (%hash) = @_;
	foreach my $key (keys %hash) {
		print "$key: [$hash{$key}]\n";
	}
}

#==========================================
#
# For HTML
#
#==========================================

sub HTMLRedirectTo
{
	my ($url, $wait, $target, $charset) = @_;
	$wait = 0 if(!defined $wait);
	$target = "_self" if(!defined $target);
	$charset = 'iso-8859-1' if(!defined $charset);

	Utils::InitHTML();
	print <<EOT
<html>
<head>
<meta http-equiv="Refresh" content="$wait;URL=$url" target="$target">
<meta http-equiv="Content-Type" content="text/html; charset=$charset">
<title>Jump to $url</title>
</head>

<body>
<h2 align="center">Click the following link if this page is not redirected automatically</h2>
<h1 align="center"><a href="$url">$url<br></a></h1>
</body>
</html>
EOT
}

sub PrintHTMLHeader
{
	my($CharSet, $outJFile, $pbuffer) = (@_);
	if($CharSet eq '') {
		$CharSet = 'x-sjis';
	}
	if($outJFile) {
		$outJFile->print("Content-type: text/html; charset=$CharSet\n\n");
	}
	elsif($pbuffer) {
		$$pbuffer .= "Content-type: text/html; charset=$CharSet\n\n";
	}
	else {
		print "Content-type: text/html; charset=$CharSet\n\n";
	}
}

# http://www.animegif.net/tips/html/doctype-html-public.html
my %DOCTYPE = (
# HTMLでは「DOCTYPE HTML」で、XHTMLでは「DOCTYPE html」と大文字と小文字の違いがあります
	'HTML 1.0 DTD'                => '', #HTML 1.0用のDOCTYPEなし'
#	'HTML 2.0 DTD'                => '<!DOCTYPE HTML PUBLIC "-//IETF//DTD HTML//EN">', #  (RFC1866) [1994年に標準化]
	'HTML 2.0 DTD'                => '<!DOCTYPE HTML PUBLIC "-//IETF//DTD HTML 2.0//EN">', #  (RFC1866) [1994年に標準化]
	'HTML 2.x DTD'                => '<!DOCTYPE HTML PUBLIC "-//IETF//DTD HTML i18n//EN">', #  (RFC2070)
	'HTML 3.0 DTD'                => '<!DOCTYPE HTML PUBLIC "-//IETF//DTD HTML 3.0//EN">', 
	'HTML 3.2 DTD'                => '<!DOCTYPE HTML PUBLIC "-//W3C//DTD HTML 3.2//EN">', # [1996年のW3C勧告]
	'HTML 3.2 DTD'                => '<!DOCTYPE HTML PUBLIC "-//W3C//DTD HTML 3.2 Final//EN">', #  [1997年1月のW3C勧告]
#	'HTML 4.01 STRICT DTD'        => '<!DOCTYPE HTML PUBLIC "-//W3C//DTD HTML 4.01//EN">', # (厳密な) [1999年12月のW3C勧告]
	'HTML 4.01 STRICT DTD'        => '<!DOCTYPE HTML PUBLIC "-//W3C//DTD HTML 4.01//EN" "http://www.w3.org/TR/html4/strict.dtd">', # (厳密な) [1999年12月のW3C勧告]
#	'HTML 4.01 Transitional DTD'  => '<!DOCTYPE HTML PUBLIC "-//W3C//DTD HTML 4.01 Transitional//EN">', # (移行期)
	'HTML 4.01 Transitional DTD'  => '<!DOCTYPE HTML PUBLIC "-//W3C//DTD HTML 4.01 Transitional//EN" "http://www.w3.org/TR/html4/loose.dtd">', # (移行期)
#	'HTML 4.01 Frameset DTD'      => '<!DOCTYPE HTML PUBLIC "-//W3C//DTD HTML 4.01 Frameset//EN">', # (フレームセット用)
	'HTML 4.01 Frameset DTD'      => '<!DOCTYPE HTML PUBLIC "-//W3C//DTD HTML 4.01 Frameset//EN" "http://www.w3.org/TR/html4/frameset.dtd">', # (フレームセット用)
#	'ISO-HTML' => '<!DOCTYPE HTML PUBLIC "ISO/IEC 15445:2000//DTD HTML//EN">',
	'ISO-HTML' => '<!DOCTYPE HTML PUBLIC "ISO/IEC 15445:2000//DTD HyperText Markup Language//EN">',
	'XHTML 1.0 Strict DTD'        => '<!DOCTYPE html PUBLIC "-//W3C//DTD XHTML 1.0 Strict//EN" "http://www.w3.org/TR/xhtml1/DTD/xhtml1-strict.dtd">', # [2000年1月26日のW3C勧告]
	'XHTML 1.0 Transitional DTD'  => '<!DOCTYPE html PUBLIC "-//W3C//DTD XHTML 1.0 Transitional//EN" "http://www.w3.org/TR/xhtml1/DTD/xhtml1-transitional.dtd">', # [2000年1月26日のW3C勧告]
	'XHTML 1.0 Frameset DTD'      => '<!DOCTYPE html PUBLIC "-//W3C//DTD XHTML 1.0 Frameset//EN" "http://www.w3.org/TR/xhtml1/DTD/xhtml1-frameset.dtd">', # [2000年1月26日のW3C勧告]
	'XHTML 1.1 Strict DTD'        => '<!DOCTYPE html PUBLIC "-//W3C//DTD XHTML 1.1//EN" "http://www.w3.org/TR/xhtml11/DTD/xhtml11.dtd">',   
	'XHTML Basic 1.0 DTD'         => '<!DOCTYPE html PUBLIC "-//W3C//DTD XHTML Basic 1.0//EN" "http://www.w3.org/TR/xhtml-basic/xhtml-basic10.dtd">', # [2000年11月19日のW3C勧告]
	'XHTML Mobile Profile1.0 DTD' => '<!DOCTYPE html PUBLIC "-//WAPFORUM//DTD XHTML Mobile 1.0//EN" "http://www.wapforum.org/DTD/xhtml-mobile10.dtd">',
	'WML1.3 DTD'                  => '<!DOCTYPE wml PUBLIC "-//OPENWAVE.COM//DTD WML 1.3//EN" "http://www.openwave.com/dtd/wml13.dtd">',
	'WML2.0 DTD'                  => '<!DOCTYPE html PUBLIC "-//WAPFORUM//DTD WML 2.0//EN" "http://www.wapforum.org/DTD/wml20.dtd">', # [2001年9月11日のW3C勧告]
# HTML5では大文字と小文字は区別しない
	'HTML5'                       => '<!DOCTYPE html>',

#	'XHTML1 BASIC'       => '<!DOCTYPE html PUBLIC "-//W3C//DTD XHTML Basic 1.0//EN" "http://www.w3.org/TR/xhtml-basic/xhtml-basic10.dtd">',
#	'HTML4'              =>'<!DOCTYPE PUBLIC "-//W3C//DTD HTML 4.0//EN">',
#	'HTML4'              => '<!DOCTYPE HTML PUBLIC "-//W3C//DTD HTML 4.01//EN">',
#	'HTML4 STRICT'       => '<!DOCTYPE HTML PUBLIC "-//W3C//DTD HTML 4.01//EN" "http://www.w3.org/TR/html4/strict.dtd">',
#	'HTML4 TRANSITIONAL' => '<!DOCTYPE HTML PUBLIC "-//W3C//DTD HTML 4.01 Transitional//EN">',
#	'HTML4 TRANSITIONAL' => '<!DOCTYPE HTML PUBLIC "-//W3C//DTD HTML 4.01 Transitional//EN" "http://www.w3.org/TR/html4/loose.dtd">',
#	'HTML4 TRANSITIONAL FRAMSEST' => '<!DOCTYPE HTML PUBLIC "-//W3C//DTD HTML 4.01 Frameset//EN" "http://www.w3.org/TR/html4/frameset.dtd">',
	);

sub GetDOCTYPEStr
{
	my ($key) = @_;
	return $DOCTYPE{$key} if($DOCTYPE{$key});
	return $DOCTYPE{'HTML 4.01 Transitional DTD'};
}

sub InitHTML
{
	my($WebTitle, $CharSet, $LinkTarget, $CSS, $PrintHTMLHeader, %args) = (@_);
	$PrintHTMLHeader = 1 if(!defined $PrintHTMLHeader);

	my $DOCTYPEString = ($args{DOCTYPEKey})? $DOCTYPE{$args{DOCTYPEKey}} : $DOCTYPE{'HTML 4.01 Transitional DTD'};
#	my $DOCTYPEString = $DOCTYPE{HTML5};

	if($WebTitle eq ''){
		$WebTitle = "No title";
	}
	if($CharSet eq '') {
		$CharSet = 'x-sjis';
	}
	if($LinkTarget eq '') {
		$LinkTarget = '_blank';
	}

	&PrintHTMLHeader($CharSet, $args{pOUTJFile}, $args{pOUTBuffer}) if($PrintHTMLHeader);

	my $out     = $args{pOUTJFile};
	my $pbuffer = $args{pOUTBuffer};
	if($out) {
		$out->print("$DOCTYPEString\n");
#		$out->print("<!DOCTYPE HTML PUBLIC \"-//W3C//DTD HTML 4.01 Transitional//EN\">\n");
##		$out->print("<!DOCTYPE html PUBLIC \"-//W3C//DTD XHTML Basic 1.0//EN\" \"http://www.w3.org/TR/xhtml-basic/xhtml-basic10.dtd\">\n");
##		$out->print("<!DOCTYPE HTML PUBLIC \"-//W3C//DTD HTML 4.01//EN\">\n");
##		$out->print("<!DOCTYPE PUBLIC \"-//W3C//DTD HTML 4.0//EN\">\n");
		$out->print("<html>\n");
		$out->print("<head>\n");
		if((defined $CSS and $CSS ne '') or $args{pHeaderFiles}) {
			$out->print(" <meta http-equiv=\"Content-Type\" content=\"text/css\" />\n");
			$out->print(" <meta http-equiv=\"Content-Type\" content=\"text/html; charset=\"$CharSet\" />\n");
		}
		else {
			$out->print(" <meta http-equiv=\"Content-Type\" content=\"text/html; charset=\"$CharSet\" />\n");
		}
		if($args{pHeaderFiles}) {
			my $pf = $args{pHeaderFiles};

			for(my $i = 0 ; $i < @$pf ; $i++) {
				my $f = $pf->[$i];
				if($f =~ /^\</) {
					$out->print(" $f\n");
				}
				elsif($f =~ /\.css$/i) {
					$out->print(" <link type=\"text/css\" rel=\"stylesheet\" href=\"$f\" />\n");
				}
				else {
					$out->print(" <script type=\"text/javascript\" src=\"$f\"></script>\n");
				}
			}
		}
		if(defined $CSS and $CSS ne '') {
			$out->print(" <link type=\"text/css\" rel=\"stylesheet\" href=\"$CSS\" />\n");
		}

		$out->print(" <title>$WebTitle</title>\n");
		$out->print(" <base target=\"$LinkTarget\">\n");
		$out->print("</head>\n");
		if($args{BGColor}) {
			$out->print("<body bgcolor=\"$args{BGColor}\">\n");
		}
		else {
			$out->print("<body>\n");
		}
	}
	elsif($pbuffer) {
		$$pbuffer .= "\n<html>\n<head>\n";
#		$$pbuffer .= "<!DOCTYPE HTML PUBLIC \"-//W3C//DTD HTML 4.01 Transitional//EN\">\n"
##				   . "<!DOCTYPE PUBLIC \"-//W3C//DTD HTML 4.0//EN\">\n"
#				   . "<html>\n"
#				   . "<head>\n";
		if((defined $CSS and $CSS ne '') or $args{pHeaderFiles}) {
			$$pbuffer .= " <meta http-equiv=\"Content-Type\" content=\"text/css\" />\n";
			$$pbuffer .= " <meta http-equiv=\"Content-Type\" content=\"text/html; charset=\"$CharSet\" />\n";
		}
		else {
			$$pbuffer .= " <meta http-equiv=\"Content-Type\" content=\"text/html; charset=\"$CharSet\" />\n";
		}
		if(defined $CSS and $CSS ne '') {
			$$pbuffer .= " <link type=\"text/css\" rel=\"stylesheet\" href=\"$CSS\" />\n";
		}

		if($args{pHeaderFiles}) {
			my $pf = $args{pHeaderFiles};
			for(my $i = 0 ; $i < @$pf ; $i++) {
				my $f = $pf->[$i];
				if($f =~ /^\</) {
					$$pbuffer .= " $f\n";
				}
				elsif($f =~ /\.css$/i) {
					$$pbuffer .= " <link type=\"text/css\" rel=\"stylesheet\" href=\"$f\" />\n";
				}
				else {
					$$pbuffer .= " <script type=\"text/javascript\" src=\"$f\"></script>\n";
				}
			}
		}

		$$pbuffer .= " <title>$WebTitle</title>\n"
				   . " <base target=\"$LinkTarget\">\n"
				   . "</head>\n";
		if($args{BGColor}) {
			$$pbuffer .= "<body bgcolor=\"$args{BGColor}\">\n";
		}
		else {
			$$pbuffer .= "<body>\n";
		}
	}
	else {
		print("$DOCTYPEString\n");
#		print("<!DOCTYPE HTML PUBLIC \"-//W3C//DTD HTML 4.01 Transitional//EN\">\n");
##		print("<!DOCTYPE html PUBLIC \"-//W3C//DTD XHTML Basic 1.0//EN\" \"http://www.w3.org/TR/xhtml-basic/xhtml-basic10.dtd\">\n");
##		print("<!DOCTYPE HTML PUBLIC \"-//W3C//DTD HTML 4.01//EN\">\n");
##		print "<!DOCTYPE PUBLIC \"-//W3C//DTD HTML 4.0//EN\">\n";
		print "<html>\n";
		print "<head>\n";
		if((defined $CSS and $CSS ne '') or $args{pHeaderFiles}) {
			print(" <meta http-equiv=\"Content-Type\" content=\"text/css\" />\n");
			print(" <meta http-equiv=\"Content-Type\" content=\"text/html; charset=\"$CharSet\" />\n");
		}
		else {
			print(" <meta http-equiv=\"Content-Type\" content=\"text/html; charset=\"$CharSet\" />\n");
		}
		if($args{pHeaderFiles}) {
			my $pf = $args{pHeaderFiles};
			for(my $i = 0 ; $i < @$pf ; $i++) {
				my $f = $pf->[$i];
				if($f =~ /^\</) {
					print(" $f\n");
				}
				elsif($f =~ /\.css$/i) {
					print(" <link type=\"text/css\" rel=\"stylesheet\" href=\"$f\" />\n");
				}
				else {
					print(" <script type=\"text/javascript\" src=\"$f\"></script>\n");
				}
			}
		}
		if(defined $CSS and $CSS ne '') {
			print(" <link type=\"text/css\" rel=\"stylesheet\" href=\"$CSS\" />\n");
		}

		print " <title>$WebTitle</title>\n";
		print " <base target=\"$LinkTarget\">\n";
		print "</head>\n";
		if($args{BGColor}) {
			print "<body bgcolor=\"$args{BGColor}\">\n";
		}
		else {
			print "<body>\n";
		}
	}

#print("<br>args: [$WebTitle, $CharSet, $LinkTarget, $CSS, $PrintHTMLHeader, ", join('=>', %args), "]<br>\n");
}

sub InitHTML5
{
	my($WebTitle, $CharSet, $LinkTarget, $CSS, $PrintHTMLHeader, %args) = (@_);
	$PrintHTMLHeader = 1 if(!defined $PrintHTMLHeader);

	my $DOCTYPEString = $DOCTYPE{HTML5};

	if($WebTitle eq ''){
		$WebTitle = "No title";
	}
	if($CharSet eq '') {
		$CharSet = 'x-sjis';
	}
	if($LinkTarget eq '') {
		$LinkTarget = '_blank';
	}

	&PrintHTMLHeader($CharSet, $args{pOUTJFile}, $args{pOUTBuffer}) if($PrintHTMLHeader);

	my $out     = $args{pOUTJFile};
	my $pbuffer = $args{pOUTBuffer};
	if($out) {
		$out->print("$DOCTYPEString\n");
		$out->print("<html>\n");
		$out->print("<head>\n");
		if((defined $CSS and $CSS ne '') or $args{pHeaderFiles}) {
#			$out->print(" <meta http-equiv=\"Content-Type\" content=\"text/css\" />\n");
			$out->print(" <meta charset=\"$CharSet\" />\n");
		}
		else {
			$out->print(" <meta charset=\"$CharSet\" />\n");
		}
		if($args{pHeaderFiles}) {
			my $pf = $args{pHeaderFiles};

			for(my $i = 0 ; $i < @$pf ; $i++) {
				my $f = $pf->[$i];
				if($f =~ /^\</) {
					$out->print(" $f\n");
				}
				elsif($f =~ /\.css$/i) {
					$out->print(" <link rel=\"stylesheet\" href=\"$f\" />\n");
				}
				else {
					$out->print(" <script type=\"text/javascript\" src=\"$f\"></script>\n");
				}
			}
		}
		if(defined $CSS and $CSS ne '') {
			$out->print(" <link rel=\"stylesheet\" href=\"$CSS\" />\n");
		}

		$out->print(" <title>$WebTitle</title>\n");
		$out->print(" <base target=\"$LinkTarget\">\n");
		$out->print("</head>\n");
		if($args{BGColor}) {
			$out->print("<body bgcolor=\"$args{BGColor}\">\n");
		}
		else {
			$out->print("<body>\n");
		}
	}
	elsif($pbuffer) {
		$$pbuffer .= "\n<html>\n<head>\n";
#		$$pbuffer .= "<!DOCTYPE HTML PUBLIC \"-//W3C//DTD HTML 4.01 Transitional//EN\">\n"
##				   . "<!DOCTYPE PUBLIC \"-//W3C//DTD HTML 4.0//EN\">\n"
#				   . "<html>\n"
#				   . "<head>\n";
		if((defined $CSS and $CSS ne '') or $args{pHeaderFiles}) {
#			$$pbuffer .= " <meta http-equiv=\"Content-Type\" content=\"text/css\" />\n";
			$$pbuffer .= " <meta charset=\"$CharSet\" />\n";
		}
		else {
			$$pbuffer .= " <meta charset=\"$CharSet\" />\n";
		}
		if(defined $CSS and $CSS ne '') {
			$$pbuffer .= " <link rel=\"stylesheet\" href=\"$CSS\" />\n";
		}

		if($args{pHeaderFiles}) {
			my $pf = $args{pHeaderFiles};
			for(my $i = 0 ; $i < @$pf ; $i++) {
				my $f = $pf->[$i];
				if($f =~ /^\</) {
					$$pbuffer .= " $f\n";
				}
				elsif($f =~ /\.css$/i) {
					$$pbuffer .= " <link rel=\"stylesheet\" href=\"$f\" />\n";
				}
				else {
					$$pbuffer .= " <script type=\"text/javascript\" src=\"$f\"></script>\n";
				}
			}
		}

		$$pbuffer .= " <title>$WebTitle</title>\n"
				   . " <base target=\"$LinkTarget\">\n"
				   . "</head>\n";
		if($args{BGColor}) {
			$$pbuffer .= "<body bgcolor=\"$args{BGColor}\">\n";
		}
		else {
			$$pbuffer .= "<body>\n";
		}
	}
	else {
		print("$DOCTYPEString\n");
#		print("<!DOCTYPE HTML PUBLIC \"-//W3C//DTD HTML 4.01 Transitional//EN\">\n");
##		print("<!DOCTYPE html PUBLIC \"-//W3C//DTD XHTML Basic 1.0//EN\" \"http://www.w3.org/TR/xhtml-basic/xhtml-basic10.dtd\">\n");
##		print("<!DOCTYPE HTML PUBLIC \"-//W3C//DTD HTML 4.01//EN\">\n");
##		print "<!DOCTYPE PUBLIC \"-//W3C//DTD HTML 4.0//EN\">\n";
		print "<html>\n";
		print "<head>\n";
		if((defined $CSS and $CSS ne '') or $args{pHeaderFiles}) {
#			print(" <meta http-equiv=\"Content-Type\" content=\"text/css\" />\n");
			print(" <meta charset=\"$CharSet\" />\n");
		}
		else {
			print(" <meta http-equiv=\"Content-Type\" content=\"text/html; charset=$CharSet\" />\n");
		}
		if($args{pHeaderFiles}) {
			my $pf = $args{pHeaderFiles};
			for(my $i = 0 ; $i < @$pf ; $i++) {
				my $f = $pf->[$i];
				if($f =~ /^\</) {
					print(" $f\n");
				}
				elsif($f =~ /\.css$/i) {
					print(" <link rel=\"stylesheet\" href=\"$f\" />\n");
				}
				else {
					print(" <script type=\"text/javascript\" src=\"$f\"></script>\n");
				}
			}
		}
		if(defined $CSS and $CSS ne '') {
			print(" <link rel=\"stylesheet\" href=\"$CSS\" />\n");
		}

		print " <title>$WebTitle</title>\n";
		print " <base target=\"$LinkTarget\">\n";
		print "</head>\n";
		if($args{BGColor}) {
			print "<body bgcolor=\"$args{BGColor}\">\n";
		}
		else {
			print "<body>\n";
		}
	}

#print("<br>args: [$WebTitle, $CharSet, $LinkTarget, $CSS, $PrintHTMLHeader, ", join('=>', %args), "]<br>\n");
}

sub EndHTML
{
	my ($outJFile, $pbuffer) = @_;
	if($outJFile) {
		$outJFile->print("</body>\n");
		$outJFile->print("</html>\n");
	}
	elsif($pbuffer) {
		$$pbuffer .= "</body>\n"
				   . "</html>\n";
	}
	else {
		print "</body>\n";
		print "</html>\n";
	}
}

sub RecoverHTMLChar
{
	my ($s, $charset) = @_;
	
	$s =~ s/&#([0-9]+);/pack('I', $1)/eg;
	Jcode::convert(\$s, $charset) if($charset ne '');
	return $s;
}

sub ConvertHTMLSpecialCharacters {
	my ($s, $ConvMiddot) = @_;
	if($ConvMiddot) {
		$_[0] =~ s/\&middot\;/<span style=\'mso-char-type\:symbol\;mso-symbol-font-family:Symbol\'>×<\/span>/ig;
	}
	$_[0] =~ s/\&Ordm\;/<sup>o<\/sup>/ig;
	$_[0] =~ s/&nbsp;/ /g;
	$_[0] =~ s/&amp;/&/g;
	$_[0] =~ s/&lt;/</g;
	$_[0] =~ s/&gt;/>/g;
	$_[0] =~ s/%20/ /g;
	$_[0] =~ s/&quot;/"/g;
	$_[0] =~ s/&#39;/'/g;
	return $_[0];
}

sub ConvertHTMLSpecialCharactersMinimum {
	my ($s, $ConvMiddot) = @_;
	if($ConvMiddot) {
		$_[0] =~ s/\&middot\;/<span style=\'mso-char-type\:symbol\;mso-symbol-font-family:Symbol\'>×<\/span>/ig;
	}
	$_[0] =~ s/\&Ordm\;/<sup>o<\/sup>/ig;
	$_[0] =~ s/%20/&nbsp;/g;
	return $_[0];
}

sub ConvertToHTMLString {
	my ($s, $ConvSpecialCharacters) = @_;
	$ConvSpecialCharacters = 1 if(!defined $ConvSpecialCharacters);

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

	if($ConvSpecialCharacters) {
		$s =~ s/&/&amp;/g;
		$s =~ s/</&lt;/g;
		$s =~ s/>/&gt;/g;
		$s =~ s/"/&quot;/g;
		$s =~ s/'/&#39;/g;
	}

	$s =~ s/\n/<br \/>\n/g;
	$s =~ s/  / &nbsp;/g;
	return $s;
}

sub GetHTMLParagraph
{
	my ($str) = (@_);
	$str =~ /^([\w\W\n]*?)(<p [\w\W]*?<\/p>)([\w\W]*)$/mi;
	my $line = $1;
	my $paragraph = $2;
	my $len = length($line) + length($paragraph);
	my $content = substr($str, $len);

	return ($line, $paragraph, $content);
}

sub DequoteXML
{
	my ($str,$DoDecode) = (@_);
	
	$str =~ s/<[\w\W]*?>//gmi;
	$str =~ s/\n//gm;
	if($DoDecode) {
		$str =~ s/&quot;/\"/gmi;
		$str =~ s/&nbps;/ /gmi;
	}
	return $_[0] = $str;
}

sub IsJapanese
{
	my($str) = (@_);
	Jcode::convert(\$str, 'euc');
	if($str =~ /[\x8E\xA1-\xFE]/) {
		return 1;
	}
	return 0;
}

sub GetFileSize
{
	my ($path, $unitconv, $format) = @_;
	$format = '%g' if(!defined $format);

	my ($dev, $ino, $mode, $nlink, $uid, $gid, $rdev, $size, $atime, $mtime, $ctime, $blksize, $blocks)
			= stat($path);
	return $size if(!defined $unitconv);

	$unitconv = lc $unitconv;
	$format = "%d" if(!defined $format);
	my $unit = "Bytes";
	if($unitconv eq 'auto') {
		if($size > 10240) {
			$size /= 1024;
			$unit = "KB";
		}
		if($size > 10240) {
			$size /= 1024;
			$unit = "MB";
		}
		if($size > 10240) {
			$size /= 1024;
			$unit = "GB";
		}
		if($size > 10240) {
			$size /= 1024;
			$unit = "TB";
		}
	}
	elsif($unitconv eq 'kb') {
		$size /= 1024;
		$unit = "KB";
	}
	elsif($unitconv eq 'mb') {
		$size /= (1024*1024);
		$unit = "MB";
	}
	elsif($unitconv eq 'gb') {
		$size /= (1024*1024*1024);
		$unit = "GB";
	}
	elsif($unitconv eq 'tb') {
		$size /= (1024*1024*1024*1024);
		$unit = "TB";
	}
	$size = sprintf($format, $size); #int($size);
	return ($size, $unit);
}

sub GetWriteDate
{
	my ($path, $target) = @_;

	my ($dev, $ino, $mode, $nlink, $uid, $gid, $rdev, $size,
		$atime, $mtime, $ctime, $blksize, $blocks) = stat($path);
	if($target eq 'ctime') {
		return $ctime;
	}
	elsif($target eq 'mtime') {
		return $mtime;
	}
	elsif($target eq 'atime') {
		return $atime;
	}
	return $mtime;
}

#==========================================
# require "mycgi.pl";
#
# &mycgi'PrintWithReplaced($infile, $outfile, "{EMail}", $a, "{Code}", $b);
#           ex. $infile = '-', 'a.in', $outfile="> a.out", ">> a.append", ">-"
#==========================================
sub PrintWithReplacedForHTML
{
	return PrintWithReplaced2(1, @_);
}

sub PrintWithReplaced
{
	return PrintWithReplaced2(0, @_);
}

sub PrintWithReplaced2
{
	my $QuoteForHTML = shift;
	my $narg = @_;
	my @a = @_;
	my $infile = $a[0];
	my $outfile = $a[1];
	my($org,$target);

#print "narg: $narg : infile: $infile<br>\n";
	if($QuoteForHTML) {
		for(my $i = 2 ; $i < $narg ; $i += 2){
			InvalidateHTMLTags($a[$i+1]);
		}
	}

	open(INFILE, $infile) or die "$infile: $!";
	open(OUTFILE, $outfile) or die "$outfile: $!";
	my($line);
	while(defined($line = <INFILE>)){
		for(my $i = 2 ; $i < $narg ; $i += 2){
#print "change($i): [ $a[$i] ] to [ " . $a[$i+1] . " ]<br>\n";
			$line =~ s/$a[$i]/$a[$i+1]/g;
		}
		print OUTFILE $line;
	}
	close(INFILE);
	close(OUTFILE);
}

sub PrintWithReplacedByCharCode
{
	my $narg = @_;
	my @a = @_;
	my $CharCode = $a[0];
	my $infile   = $a[1];
	my $outfile  = $a[2];
	my($org,$target);
	
	open(INFILE, $infile) or die "$infile: $!";
	open(OUTFILE, $outfile) or die "$outfile: $!";
	my($line);
	while(defined($line = <INFILE>)){
		for(my $i = 3 ; $i < $narg ; $i += 2){
			$line =~ s/$a[$i]/$a[$i+1]/g;
		}
		Jcode::convert(\$line, $CharCode);
		print OUTFILE $line;
	}
	close(INFILE);
	close(OUTFILE);
}

#==========================================
# require "mycgi.pl";
#
# &mycgi'PrintStringWithReplaced($str, $outfile, "{EMail}", $a, "{Code}", $b);
#           ex. $infile = '-', 'a.in', $outfile="> a.out", ">> a.append", ">-"
#==========================================
sub PrintStringWithReplaced2
{
	my ($str, $outfile, $Conv, @a) = @_;

	my($org,$target);
	open(OUTFILE, ">$outfile") or die "$outfile: $!";
	for(my $i = 0 ; $i < @a ; $i += 2){
		my $key = $Conv;
		$key =~ s/%key%/$a[$i]/gi;
		$str =~ s/$key/$a[$i+1]/g;
	}
	print OUTFILE $str;
	close(OUTFILE);
}

sub PrintStringWithReplaced
{
	return &PrintStringWithReplaced2(@_) if($_[2] =~ /\%.*\%/);

	my $narg = @_;
	my @a = @_;
	my $str = $a[0];
	my $outfile = $a[1];
	my($org,$target);

	open(OUTFILE, ">$outfile") or die "$outfile: $!";
	for(my $i = 2 ; $i < $narg ; $i += 2){
		$str =~ s/$a[$i]/$a[$i+1]/g;
	}
	print OUTFILE $str;
	close(OUTFILE);
}

#==========================================
# &mycgi'ConvertString($str, "{EMail}", $a, "{Code}", $b);
#==========================================
# $Conv: expl. "{%key%}"
sub ConvertString2
{
	my ($str, $Conv, @a) = @_;

	for(my $i = 0 ; $i < @a ; $i += 2){
		my $key = $Conv;
		$key =~ s/%key%/$a[$i]/gi;
		$str =~ s/$key/$a[$i+1]/g;
	}
	return $_[0] = $str;
}

sub ConvertString
{
	return &ConvertString2(@_) if($_[1] =~ /\%.*\%/);

	my $narg = @_;
	my @a = @_;
	my $str = $a[0];

	for(my $i = 1 ; $i < $narg ; $i += 2){
		$str =~ s/$a[$i]/$a[$i+1]/g;
	}
	return $_[0] = $str;
}

sub IsValidPassword
{
	my ($password) = (@_);
	if($password =~ /^[a-zA-Z0-9_]+$/){
		return 1;
	}
	return 0;
}

sub IsValidEMailAddress
{
	my ($email, $UseEMailValid, $CheckMX) = (@_);
	$UseEMailValid = 1 if(!defined $UseEMailValid);
	$CheckMX       = 1 if(!defined $CheckMX);

	return 0 if($email =~ /[\s\(\)\{\}\[\]\<\>\"\':\/]/);
#	if($UseEMailValid) {
#		return Email::Valid->address($email, -mxcheck => $CheckMX);
#	}

	if($email =~ /^[a-zA-Z0-9._\-+\%\$#!&~]+@[a-zA-Z0-9._\-+]+$/){
		return 1;
	}
	return 0;
}

#===============================================
# HTML / Cookie関係
#===============================================

my %COOKIE;

my $CGIFiles = "(\.cgi|\.pl|\.php)[^/]*\$";
my @IndexFiles = ("index.html", "index.htm", "Index.html", "Index.htm",
		  "Default.htm", "Default.html", "default.htm", "default.html");


#
# Cookieの値を読み出す
#
sub getCookie {
    my($xx, $name, $value);
    foreach my $xx (split(/; */, $ENV{'HTTP_COOKIE'})) {
        ($name, $value) = split(/=/, $xx);
        $value =~ s/%([0-9A-Fa-f][0-9A-Fa-f])/pack("C", hex($1))/eg;
        $COOKIE{$name} = $value;
    }
}

#
# Cookieに値を書き込むためのSet-Cookie:ヘッダを生成する
#
sub setCookie {
    my($tmp, $val);
    $val = $_[1];
    $val =~ s/(\W)/sprintf("%%%02X", unpack("C", $1))/eg;
    $tmp = "Set-Cookie: ";
    $tmp .= "$_[0]=$val; ";
    $tmp .= "expires=Tue, 1-Jan-2030 00:00:00 GMT;";
    return($tmp);
}

#
# Cookieを削除するためのSet-Cookie:ヘッダを生成する
#
sub clearCookie {
    my $tmp = "Set-Cookie: ";
    $tmp .= "$_[0]=xx; ";
    $tmp .= " expires=Tue, 1-Jan-1980 00:00:00 GMT;";
    return($tmp);
}


# Cookieの値を読み出す
#
sub MyGetCookie {
#print "Env: ", $ENV{'HTTP_COOKIE'}, "<br>\n";
    foreach my $xx (split(/; */, $ENV{'HTTP_COOKIE'})) {
#print "xx: $xx<br>\n";
        my ($name, $value) = split(/=/, $xx);
        $value =~ s/%([0-9A-Fa-f][0-9A-Fa-f])/pack("C", hex($1))/eg;
        $COOKIE{$name} = $value if $COOKIE{$name} eq '';
#print "Name: $name, ", $COOKIE{$name}, "<br>\n";
    }
}

sub ConvertHTMLToFullURL
{
	my ($Content, $SourceURL, $Debug) = (@_);
	my $res;
	my $ConvContent;
	
	$res = $Content;
	$ConvContent = "";
	while(1) {
		my $count = 
		($res =~ /^(.*?)(\<a\s+href=\")(.*?)(\".*?\>)(.*?)(\<\/a.*?\>)(.*)$/si);
		if($count == 0) {
			$ConvContent .= $res;
			last;
		}
		my $header  = $1;
		my $tag1    = $2;
		my $linkurl = $3;
		my $tag2    = $4;
		my $linkstr = $5;
		my $tag3    = $6;
		$res     = $7;
if($Debug) {
	print "    URL: $linkurl\n";
}
		my $convurl = &ConvertURLtoFullURL($linkurl, $SourceURL);
if($Debug) {
	print "ConvURL: $convurl\n";
}
		$ConvContent .= "$1$2$convurl$4$5$6";
	}

	$res = $ConvContent;
	$ConvContent = "";
	while(1) {
		my $count = 
			($res =~ /^(.*?(background|image|src)\s*=\s*\")(.*?)(\".*)$/si);
			if($count == 0) {
			$ConvContent .= $res;
			last;
		}
		my $header  = $1;
		my $linkurl = $3;
		$res        = $4;
if($Debug) {
	print "    URL: $linkurl\n";
}
		my $convurl = &ConvertURLtoFullURL($linkurl, $SourceURL);
if($Debug) {
	print "ConvURL: $convurl\n";
}
		$ConvContent .= "$1$convurl";
	}

	return $_[0] = $ConvContent;;
}

sub DecomposeURI
{
	my ($URI) = @_;
	my ($protocol, $server, $directory, $filename)
		= ($URI =~ /^(.*?:\/\/)([^\/]+?)(\/|$)(.*?)([^\/]*?)$/i);
	return ($protocol, $server, $directory, $filename);
}

sub ConvertURLtoFullURL
{
	my ($linkurl, $url) = (@_);
	my $convurl;

	return $linkurl if($linkurl =~ /:\/\//i);

	my $protocol;
	my $server;
	my $directory;
	my $filename;
#	$url =~ /^(.*?:\/\/)([^\/]+?)([^\?\&]*?)([^\/]*?)$/i;
	$url =~ /^(.*?:\/\/)([^\/]+?)(\/|$)(.*?)([^\/]*?)$/i;
	$protocol  = $1;
	$server    = $2;
	$directory = "/$4";
	$filename  = $5;
	if($directory =~ /[\?\&]/) {
		$directory =~ /^(.*?)([\?\&].*$)/;
		$directory = $1;
		my $res1   = $2;
		$directory =~ /^(.*)\/([^\/]*?)$/;
		$directory = $1;
		my $res2   = $2;
		$filename = "$res2$res1$filename";
	}

#print "URL   : $url\n";
#print "pro   : $protocol\n";
#print "server: $server\n";
#print "dir   : $directory\n";
#print "file  : $filename\n";

	my $path;
	if($linkurl =~ /^\//) {
		$path = &MakePath($server, $linkurl, "/", 0);
	}
	else {
		$path = &MakePath($server, $directory, "/", 0);
		$path = &MakePath($path, $linkurl, "/", 0);
		&ReduceDirectory($path);
	}
#print "path: $path\n";
	$convurl = "$protocol$path";
	return $convurl;
}

sub GetURLwithoutFilePath {
	my ($url) = @_;

	my $ret;

#CGIの場合はそのままreturn
	return 1 if($url =~ /$CGIFiles/i or $url =~ /[\?\&]/);

	for(my $i = 0 ; $i < @IndexFiles ; $i++) {
		my $s = &MakePath($url, $IndexFiles[$i], "/", 0);
#print "url: $s\n";
		$ret = head($s);
#		$ret = get($s);
		if($ret) {
			$_[0] = $s;
			return $ret;
		}
	}
	return $ret;
}

sub DownloadBuffer
{
	my ($CGIForm, $Contents, $DownloadFileName, $App) = @_;
#print "F[$DownloadFileName]<br>\n";
#return;
	my $Length = length($Contents);
	binmode(IN);
	binmode(STDOUT);

	print(STDOUT
		$CGIForm->header(
			-Content_Disposition => "attachment; filename=$DownloadFileName",
			-Content_Length      => $Length,
			-type                => "application/octet-stream",
#			-type                => "application/download",
			)
		);
	print STDOUT $Contents;
	close IN;
}

sub DownloadFile
{
	my ($CGIForm, $LocalPath, $DownloadFileName, $App) = @_;

	my $Length = Utils::GetFileSize($LocalPath);
	if(open (IN, $LocalPath)) {
	}
	else {
		$App->print("Error: Can not read [$LocalPath]\n.") if($App);
		return;
	}

	binmode(IN);
	binmode(STDOUT);

	print(STDOUT
		$CGIForm->header(
			-Content_Disposition => "attachment; filename=$DownloadFileName",
			-Content_Length      => $Length,
			-type                => "application/octet-stream",
#			-type                => "application/download",
			)
		);

	while (my $line = <IN>) {
		print STDOUT $line;
	}
	close IN;
}

sub DownloadFile_better
{
	my ($CGIForm, $LocalPath, $DownloadFileName) = @_;
#$DownloadFileName はアスキー文字で構成されている必要がある。
#日本語が含まれているとうまくいかない可能性が高い

#Utils::InitHTML("check", "x-sjis", "_blank");
#print "<H3>$LocalPath</H3>\n";
	my $in = new JFile();
	my $Contents = $in->ReadFile($LocalPath, undef, "rb");
	if(!defined $Contents) {
		print("Error: Can not read [$LocalPath]\n.");
		return;
	}

	my $Length   = length $Contents;
#	$Length -= 100000;
#print "<br>length: $Length<br>";
#ファイル用のヘッダを書き出し
#ブラウザのバージョンや設定によって、期待した動作とならない場合もある
	binmode(STDOUT);
	print(
		$CGIForm->header(
			-Content_Disposition => "attachment; filename=$DownloadFileName",
			-Content_Length      => $Length,
			-type                => "application/octet-stream",
#			-type                => "application/download",
			)
		);
	print($Contents);
	return 1;
}

sub DownloadFromURL
{
	my ($url) = @_;

	my $Content;
	my $agent     = LWP::UserAgent->new;
	my $newagent = 'Mozilla/4.7 [en]  (PalmOS)';
	$agent->agent($newagent);
	my $jar = $agent->cookie_jar(new HTTP::Cookies);

	my $request = HTTP::Request->new(GET => $url);
	my $response = $agent->request($request);
	unless($response->is_success) {
		my $s = $response->message;
		print "Error: $s!<br>\n";
		return -1;
	}

	$Content = $response->content;
	&ConvertHTMLToFullURL($Content, $url, 0);

	return $Content;
}

sub ExtractHTMLBody
{
	my ($Content) = @_;
	
	$Content =~ /\<body.*?\>(.*)\<\/body\>/si;
	return $1;
}

#==========================================
# 「Ultimate Perl」、ソシム発行
#==========================================

sub ReadFile
{
	my $fname = @_;
	
	open(FILE, "<$fname") or return -1;
	my $str = do { local $/; <FILE>; };
	close(FILE);
	
	return $str;
}

#12文字ごとにファイルを読み込み、" "で区切って返す
sub ReadFixedColumnFile
{
	my $fname = @_;
	
	open(FILE, "<$fname") or return -1;
	local $/ = \12;
	local $\ = "\n";
	my $str = "";
	while(<FILE>) {
		$str .= " $_";
	}
	close(FILE);
	return $str;
}

#リストをタブ区切りで出力
sub PrintWithTab1
{
	my @list = @_;
	local ($") = "\t";
	print "@list\n";
}

#文字列を固定長で区切る
sub SplitToFixedStrs
{
	my $s = @_;
	my @list;
	$s =~ s/(.{1,8})/push(@list,$1)/eg;
	return @list;
}

#括弧で囲まれた部分をきちんと抽出
sub ExtractByParentheses
{
	my $str = @_;
	my $balance;
	$balance = qr/\([^()]*(?:(??{$balance})[^()]*)*\)/;
	
	my $ret = "";
	while($str =~ /($balance)/g) {
		$ret .= "$1\n";
	}
	return $ret;
}

#クレジットカードの番号をチェック
sub CheckCreditCardNumber
{
#	my ($s) = @_;
#	my @a;
#	if($s =~ s/[ -]//g) {
#		@a = split(//, $s);
#	}
#	return "Wrong number" if($a[0] =~ /\D/ || length($a[0]) |~ /^1[356]$/);
#
#	my $x;
#	map {
#		$x = 0;
#		map { $x += $_ } split //, $_[$_]*2;
#		$_[$_] = $x;
#	} map {
#		$_%2 ?() : $_;
#	} (length)%2..(length)-1;
#	$x = 0;
#	map { $x += $_ } @_;
#	return $x % 10 ?
#		"Wrong nubmer" :
#		"Correct number";
}

#タグの外側だけを置換
sub ReplaceHTMLBodyOnly
{
	my ($str, $source, $target) = @_;
	$str =~ s/((?:\G|>)[^<]*?)$source/$1$target/g;
	return $str;
}

#OSの判定
sub GetOSName
{
	return $^O;
}

#Configの表示
sub PrintConfig
{
	use Config;
	for my $key (keys(%Config)) {
		print "$key : $Config{$key}\n";
	}
}

#データ中のHTMLタグを無力化
sub EncodeHTMLTags
{
	return &InvalidateHTMLTags(@_);
}

sub InvalidateHTMLTags
{
	my ($input, $DoUpdate, $ConvertSpace) = @_;
	$DoUpdate = 1 if(!defined $DoUpdate);
	$ConvertSpace = 0 if(!defined $ConvertSpace);
	$input =~ s/&/&amp;/g;
	$input =~ s/</&lt;/g;
	$input =~ s/>/&gt;/g;
	$input =~ s/ /&nbsp;/g if($ConvertSpace);
	$input =~ s/"/&quot;/g;
	$input =~ s/'/&#39;/g;
	$_[0] = $input if($DoUpdate);
	return $input;
}

sub RemoveEncodedHTMLTags
{
	my ($input, $RemoveSubSup, $App) = @_;
	$RemoveSubSup = 1 if(!defined $RemoveSubSup);
	if(!$RemoveSubSup) {
		$input =~ s/&lt;(\/?\s*(sub|sup)\s*)&gt;/\<$1\>/sig;
	}
#	$App->PrintRawHTML("before: $input<br>\n");
	$input =~ s/&lt;.*?&gt;//sig;
#	$App->PrintRawHTML("after: $input<br>\n");
	return $input;
}

sub SafeDecodeHTMLTags
{
	my ($input, $DoUpdate) = @_;
	$input = &DecodeHTMLTags($input, $DoUpdate);
	$DoUpdate = 1 if(!defined $DoUpdate);
	$input =~ s/(<)(\/*[^>]*script\/*)(>)/&lt;$2&gt;/sgi;
	$_[0] = $input if($DoUpdate);
	return $input;
}

sub DecodeHTMLTags
{
	my ($input, $DoUpdate) = @_;
	$DoUpdate = 1 if(!defined $DoUpdate);
	$input =~ s/&amp;/&/gi;
	$input =~ s/&lt;/</gi;
	$input =~ s/&gt;/>/gi;
	$input =~ s/&nbsp;/ /gi;
	$input =~ s/&quot;/"/gi;
	$input =~ s/&#39;/'/g;
	$_[0] = $input if($DoUpdate);
	return $input;
}

#URLから危険な要素を排除
sub GetSafeURL
{
	my $url = @_;
	return '' if($url =~ m|[^;/?:@&=+\$,A-Za-z0-9\-_.!~*'()%]|);
	if($url =~ /^([A-Za-z][A-Za-z0-9+\-.]*):/) {
		my $scheme = lc($1);
		my $allowed = 0;
		$allowed = 1 if($scheme eq 'http');
		$allowed = 1 if($scheme eq 'https');
		$allowed = 1 if($scheme eq 'mailto');
		return '' if(not $allowed);
	}
	$url =~ s/&/&amp;/g;
	$url =~ s/'/&#39;/g;
	return $url;
}

#ファイル名のチェック（ヌル文字がある場合、ディレクトリィトラバーサルがある場合は０
sub CheckSecureFileName
{
	my $fname = @_;

	return 0 if($fname =~ <\.\./>);
	return 0 if($fname =~ /\0/);

	return 1;
}

sub StringToHex
{
    my ($s) = @_;
    $s = '='.unpack("H2",$s);
    tr/a-f/A-F/;
    return $s;
}


#タイムアウトの設定
#alarm(20); #20秒
#SIG{ALRM} = 'time_out';
#sub time_out {
#	print "Time out\n";
#	return;
#}

#関数のオーバーライド
#use subs qw(lc uc);　など

#コマンドをサブルーチンでつかう
#sub AUTOLOAD
#{
#	my $program = $AUTOLOAD;
##パッケージ名をはずす
#	$program =~ s/.*:://;
#	qx/$program @_/;
#}

# ツェラーの公式より曜日を求める
# グレゴリウス暦(1582年10月15日(金)午後以後)で有効
#
# <IN> 年、月、日
# <OUT> 曜日 (0:日曜日 - 6:土曜日)
sub getDayOfWeekString
{
	my($year, $month, $day, $n, $Language, $charcode) = @_;
	my @weekday_en = ("Sunday", "Monday", "Tuesday", "Wednsday", "Thursday", "Friday", "Saturday");
	my @weekday_jp = ("日", "月", "火", "水", "木", "金", "土");
my $SourceCharCode = Jcode::getcode("月火水木金土日　");
#print("cs: $SourceCharCode => $charcode<br>\n");
	my $w = getDayOfWeek($year, $month, $day);
	my $s;
	if($Language eq 'jp' or $Language eq 'Japanese' ) {
		 if($n > 0) {
			$s = substr($weekday_jp[$w], 0, $n);
		}
		else {
			$s = $weekday_jp[$w];
		}
		Jcode::convert(\$s, $charcode, $SourceCharCode) if($charcode and $SourceCharCode ne $charcode);
	}
	else {
		if($n > 0) {
			$s = substr($weekday_en[$w], 0, $n);
		}
		else {
			$s = $weekday_en[$w];
		}
	}
	return $s;
}

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;	#平年
			}
		}
	}
}

# <IN>  年、月
# <OUT> その月の合計日数
sub getDaysOfMonth
{
	my($year, $month) = @_;

	return leap($year) ? $LeapYear[$month] : $NormYear[$month];
}

1;