page top

package k2;

;# -----------------------------------------------------------------------------
;# K2/LIB::PERL LIBRARY++                                                      .
;#                                                                             .
;#       Utility Library                                                       .
;#          1. HTML Helper                                                     .
;#          2. Mathematics Library                                             .
;#          3. Multi Strings Library                                           .
;#                                                                             .
;#                             All Right Reserved, CopyRight (C) 2008 by Dr.K  .
;# -----------------------------------------------------------------------------

;#//////////////////////////////////////////////////////////////////////////////
;# Perl Package Module Import
;#//////////////////////////////////////////////////////////////////////////////
 #use strict;
 use Jcode;
 use Switch;
;#//////////////////////////////////////////////////////////////////////////////


;#//////////////////////////////////////////////////////////////////////////////
;# Prototype
;#//////////////////////////////////////////////////////////////////////////////
;# ＨＴＭＬ関数 x 6
;# Out($pt, $dt)
;# OutHtml($fd, $fr, $ic, $tt, $bd, $dt)
;# HtmlHead($ttl, $cpy, @css)
;# HtmlFoot()
;# fixDoc($doc, $pre)
;# fixFont($fn)

;# ＷＥＢ関数 x 10
;# isAgent();
;# AgentName()
;# IPaddress()
;# IP2URL($IP)
;# LoginName()
;# Domain($sw)
;# Query()
;# SetCookie($nam, $va;, $exp, $dom, $pth)
;# GetCookie()
;# ClearCookie($nam)

;# コード変換 x 14
;# EncodeURL($s)
;# DecodeURL($s)
;# OmitRetAll($s)
;# OmitRetLast($s)
;# ReturnTo1($s)
;# Return2br($s)
;# Space2nbsp($s)
;# OmitRetAllEx(\@s)
;# OmitRetLastEx(\@s)
;# ReturnTo1Ex(\@s)
;# Return2brEx(\@s)
;# Space2nbspEx(\@s)
;# Csv2Array($csv)
;# Array2Csv(@dat)

;# 文字コード関数 x 6
;# cnv2euc($s)
;# cnv2utf($s)
;# cnv2sjis($s)
;# cnv2eucEx(\@s)
;# cnv2utfEx(\@s)
;# cnv2sjisEx(\@s)

;# 文字列変換関数 x 17
;# Trim($s)
;# TrimA($s)
;# TrimS($s)
;# TrimL($s)
;# TrimR($s)
;# Space1($s)
;# LowerCase($s)
;# UpperCase($s)
;# LowerCaseW($s)
;# UpperCaseW($s)
;# CutOff($sep, $s)
;# Joint($sep, $s)
;# FillChar($s, $ln)
;# FixStr($s)
;# FixInt($s)
;# FixStrEx(\$s)
;# FixIntEx(\$s)

;# 文字列操作関数 x 11
;# PosStr($s, $a, $n)
;# LeftStr($s, $ln)
;# RightStr($s, $ln)
;# MidStr($s, $st, $ln)
;# TextA2B($s, $a, $b)
;# Text2MaxLen($s, $ln, $sw)
;# InsertStr($txt, $s, $no)
;# ChangeStr($txt, $s, $no)
;# RemoveStr($txt, $no, $ln)
;# Char2CodeStr($s)
;# Code2CharStr($s)

;# ワイド文字列操作関数 x 7
;# _get_wideChar($s)
;# LengthW($s)
;# PosStrW($a, $s, $n)
;# LeftStrW($s, $ln)
;# RightStrW($s, $ln)
;# MidStrW($s, $st, $ln)
;# Text2MaxLenW($s, $ln, $sw)

;# 文字判定関数 x 14
;# isReal($s)
;# isFloat($s)
;# isInteger($s)
;# isNumeric($s)
;# isFigure($s)
;# isAlphabet($s)
;# isKana($s)
;# isRealEx(@s)
;# isFloatEx(@s)
;# isIntegerEx(@s)
;# isNumericEx(@s)
;# isFigureEx(@s)
;# isAlphabet(@s)
;# isKana(@s)

;# マルチバイト文字の判定 x 7
;# isNumericW($s)
;# isAlphabetW($s)
;# isKanaW($s)
;# isHira($s)
;# isKanji($s, $sw)
;# isKanjiIn($s);
;# isKanji1($s);

;# 半角全角関数 x 6
;# zen2hanSp($s)
;# han2zenSp($s)
;# han2zenk($s)
;# zen2hank($s)
;# han2zen($s)
;# zen2han($s)

;# リファレンスの型判定関数 x 8
;# isScalar(\$dt)
;# isArray(\$dt)
;# isHash(\$dt)
;# isRef(\$dt)
;# isGlob(\$dt)
;# isCode(sub{})
;# isLvalue(\pos())
;# isHandle(*HD{IO})

;# 配列操作関数 x 17
;# HitOf($s, @dat)
;# IndexOf($s, @dat)
;# IncludeOf($s, @dat)
;# DeleteOf(\@dat, $no, $ln)
;# InsertOf(\@dat, $no, $s)
;# MargeOf(\$d1, \$d2, $sw)
;# SortStrOf($sw, @dat)
;# SortIntOf($sw, @dat)
;# MinLenStrOf(@dt)
;# MaxLenStrOf(@dt)
;# MinIntOf(@dt)
;# MaxIntOf(@dt)
;# MinStrOf(@dt)
;# MaxStrOf(@dt)
;# PickUpOf(@dt)
;# DelDupOf(@dt)
;# ShuffleOf(@dt)

;# ハッシュ操作関数 x 9
;# GetHash(%h, $ky)
;# PutHash(%h, $ky, $dt)
;# DeleteHash(%h, $ky)
;# Array2Hash(@dt)
;# Hash2Array(%dt)
;# MargeHash($h1, $h2, $sw)
;# ValsHash(%h)
;# KeysHash(%h)
;# KeysInHash(%h)

;# バッファ::LIFO,FIFO x 4
;# Push($v)
;# Pop()
;# UnShift($v)
;# Shift()

;# 数値関数 x 7
;# Hi(@v)
;# Lo(@v)
;# Swap($a, $b)
;# SwapEx($a, $b)
;# Min($a, $b)
;# Max($a, $b)
;# MinMax($s, $a, $b)

;# 丸め関数 x 4
;# Round($v, $r)
;# RoundOff($v)
;# Trunc($v, $r)
;# Ceil($v, $r)

;# 計算用関数 x 3
;# Div($x, $y)
;# Mod($x, $y)
;# Sqr($v, $n)

;# ３ケタコンマ x 3
;# CommaStr($v, $ln)
;# CommaInt($v, $ln)
;# CommaFloat($v, $n, $ln)

;# Total = 154
;#//////////////////////////////////////////////////////////////////////////////


;#//////////////////////////////////////////////////////////////////////////////
;# ＨＴＭＬ関数
;#//////////////////////////////////////////////////////////////////////////////


# ＨＴＭＬアウトプット
# $fd=DOCTYPE(1:strict);
# $fr=robots(0:nofollow, 1:follow);
# $ic=ファビコンパス
# $tt=HTMLタイトル
# $bd=BODYデータ(リファレンス)
# $dt=HTMLデータ(リファレンス)
sub OutHtml{
	my ($fd, $fr, $ic, $tt, $bd, $dt) = @_;

	my ($fs, $em, $fn);
	$tt = 'K2/IDE:2008' unless($tt);

	if(@$bd){
		$fn = fixFont(shift(@$bd));
		$fs = shift(@$bd);
		$em = shift(@$bd);
	}else{
		$fn = fixFont('g');
		$fs = 16;
		$em = 1.2;
		@$bd = ('margin: 8', 'padding: 8');
	}
	push(@$bd, 'font: '.$fs.'px/'.$em.'em '.$fn);

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

	if($fd){
		print "<!DOCTYPE html PUBLIC '-//W3C//DTD XHTML 1.0 Strict//EN' 'http://www.w3.org/TR/xhtml1/DTD/xhtml1-strict.dtd'>\n";
	}else{
		print "<!DOCTYPE html PUBLIC '-//W3C//DTD HTML 4.01 Transitional//EN'>\n";
	}

	print "<HTML lang='ja'>\n";
	print "<HEAD>\n";

	print "<META http-equiv='Content-Type' content='text/html; charset=Shift_JIS'>\n";
	print "<META http-equiv='Content-Style-Type' content='text/css'>\n";
	print "<META name='GENERATOR' content='K2/IDE::2008'>\n";
	print "<META name='copyright' content='Dr.K'>\n";

	if($fr){
		print "<META name='robots' content='index,follow'>\n";
	}else{
		print "<META name='robots' content='noindex,nofollow'>\n";
	}

	if($ic){
		print "<LINK rel='SHORTCUT ICON' href=$ico>\n";
	}

	print "<TITLE>$tt</TITLE>\n";

	print "<style type='text/css'><!--\n";
	print "\t"."body{\n";
	foreach(@$bd){print "\t\t$_\n"}
	print "\t}\n";
	print "--></style>\n";

	print "</HEAD>\n";
	print "<BODY>\n";

	my ($fg, $wk, $ct);
	my @tag = (
		'DIV',
		'CENTER',
		'FORM', 'SELECT',
		'TABLE', 'THEAD', 'TFOOT', 'TBODY', 'TR', 'TD'
	);

	foreach(@$dt){
		$fg = 1;
		my $s = cnv2sjis($_);

		unless(isTagOnly($s)){
			if($s eq ''){
				if($wk eq '</UL>' || $wk eq '</OL>'){
					$fg = 0;
				}
			}
			$s = "$s<BR>";
		}

		if($fg){
			my $uc = Trim(uc($s));
			foreach(@tag){
				if(index($uc, '</'.$_) == 0){
					$ct--;
					last;
				}
			}
			foreach(@tag){
				if(index($wk, '<'.$_) == 0){
					$ct++;
					last;
				}
			}
			if($ct < 0){
				$ct = 0;
			}else{
				my $tb = "\t" x ($ct + 1);
				$s = $tb.$s;
			}
		}

		$wk = Trim(uc($s));
		print "$s\n";
	}

	print "</BODY>\n";
	print "</HTML>\n";
}

# Print配列にデータ配列を代入
# $pt = Print配列(リファレンス)
# $dt = データ配列(リファレンス)
sub Out{
	my ($pt, $dt) = @_;
	foreach(@{$dt}){push(@{$pt}, $_)}
}

# Html Header
# $ttl = Htmlタイトル
# @css = css生データ
sub HtmlHead{
	my ($ttl, $cpy, @css) = @_;

	$ttl = 'K2/LIB'if($ttl eq '');
	$cpy = 'Dr.K2'if($cpy eq '');

	print "Content-type: text/html\n\n";
	print "<!DOCTYPE HTML PUBLIC '-//W3C//DTD HTML 4.01//EN' 'http://www.w3.org/TR/html4/strict.dtd'>\n";

	print "<HTML lang='ja'>\n";
	print "<HEAD>\n";

	print "<META http-equiv='Content-Type' content='text/html; charset=shift_jis'>\n";
	print "<META http-equiv='Content-Style-Type' content='text/css'>\n";
	print "<META name='GENERATOR' content='K2/IDE::2008'>\n";
	print "<META name='copyright' content='$cpy'>\n";
	print "<META name='robots' content='noindex'>\n";
	print "<TITLE>$ttl</TITLE>\n";

	print "<style type='text/css'>\n";
	if(@css){
		foreach(@css){print "$_\n"}
	}else{
		print "	body{\n";
		print "		margin: 0;\n";
		print "		padding: 0;\n";
		print "		background-color: snow;\n";
		print "		font: 13px ＭＳ Ｐゴシック, ＭＳ ゴシック, MSP Gothic, MS Gothic;\n";
		print "	}\n";
		print "	a:hover{\n";
		print "		color: #ff0000;\n";
		print "		background-color: #ccccff;\n";
		print "		text-decoration:underline overline;\n";
		print "	}\n";
		print "	a:active{\n";
		print "		color: #000000;\n";
		print "		background-color: #ddddff;\n";
		print "	}\n";
		print "	a{\n";
		print "		text-decoration: none;\n";
		print "	}\n";
	}
	print "</style>\n";

	print "</HEAD>\n";
	print "<BODY>\n";
	print "	<CENTER>\n";
}

# Html Header
# 引数なし
sub HtmlFoot{
	print "	</CENTER>\n";
	print "</BODY>\n";
	print "</HTML>\n";
}

# ドキュメント等の整形
# $doc = ドキュメント
# $pre = 開始マーク
# $s = fixDoc(<<EOL, '*');
#	*	<DIV>
#	*		$txt<BR>
#	*	</DIV>
#EOL
sub fixDoc{
	my ($doc, $pre) = @_;
	$doc =~ s/^[^\S\n]+//gm;
	$doc =~ s/^$pre+//gm;
	return($doc);
}

# フォントを得る
# $fn = フォント名(g, gp, m, mp)
sub fixFont{
	my ($fn) = @_;
	my $f = lc($fn);
	$fn = 'ＭＳ 明朝'if($f eq 'm');
	$fn = 'ＭＳ Ｐ明朝'if($f eq 'mp');
	$fn = 'ＭＳ ゴシック'if($f eq 'g');
	$fn = 'ＭＳ Ｐゴシック'if($f eq 'gp');
	$fn = 'ＭＳ ゴシック'unless($fn);
	return($fn);
}


;#//////////////////////////////////////////////////////////////////////////////
;# ＷＥＢ関数
;#//////////////////////////////////////////////////////////////////////////////


# キャリアの取得
sub isAgent{
	my $env = $ENV{'HTTP_USER_AGENT'};
	# DoCoMo
	return('d')if($env =~ /DoCoMo/i);
	# au
	return('a')if($env =~ /^UP.Browser|^KDDI/i);
	# SoftBank
	return('s')if($env =~ /^J-PHONE|^Vodafone|^SoftBank/i);
	# pc
	return('p');
}

# エージェントの取得
sub AgentName{
	$_ = $ENV{'HTTP_USER_AGENT'};
	s/,/./g;
	s/</&lt;/g;
	s/>/&gt;/g;
	return($_);
}

# IPアドレスの取得
sub IPaddress{
	return($ENV{'REMOTE_ADDR'});
}

# IPからURLを取得
sub IP2URL{
	my($IP) = @_;
	my(@add) = split(/\./, $IP);
	my($packed) = pack("C4", $add[0], $add[1], $add[2], $add[3]);
	my($name, $aliases, $addrtype, $length, @addrs) = gethostbyaddr($packed, 2);
	return($name);
}

# ログイン名の取得
sub LoginName{
	return(getlogin());
}

# ドメインの取得
# ($sw=1):IPアドレスを含むフルアドレス
# ($sw=2):IPアドレスを削除したドメイン名
sub Domain{
	my ($sw) = @_;
	$sw = MinMax($sw, 1, 2);
	my $add = $ENV{'REMOTE_ADDR'};
	my $dom = gethostbyaddr(pack("C4",split(/\./,$add)),2);
	if($dom eq ''){
		$dom = $add;
	}else{
		if($sw == 2){
			if(/.+\.(.+)\.(.+)\.(.+)$/){
				$dom = "\*\.$1\.$2\.$3";
			}elsif(/.+\.(.+)\.(.+)$/){
				$dom = "\*\.$1\.$2";
			}elsif (/.+\.(.+)$/){
				$dom = "\*\.$1";
			}else{
				$dom = "on the internet";
			}
		}
	}
	return($dom);
}

# クエリの取得
sub Query{
	my (%ret, $buff, @pair, $key, $val);
	if($ENV{'REQUEST_METHOD'} eq 'GET'){
		$buff = $ENV{'QUERY_STRING'};
	}elsif($ENV{'REQUEST_METHOD'} eq 'POST'){
		read(STDIN, $buff, $ENV{'CONTENT_LENGTH'});
		print STDIN '';
	}
	if($buff){
		foreach(CutOff('&',$buff)){
			($key, $val) = CutOff('=', $_);
			$key = DecodeURL($key);
			$val = DecodeURL($val);
			$val =~ s/\n//g;
			$key = cnv2sjis($key);
			$val = cnv2sjis($val);
			$ret{$key} = $val;
		}
		return(%ret);
	}else{
		return();
	}
}

# クッキー発行
# ($days)= ExpireDays
# ($hour)= ExpireHour
# ($mint)= Expireminute
# ($name)= CookieName
# (@cook)= @('key=Value')
sub SetCookie{
	my ($days, $hour, $mint, $name, @cook) = @_;

	my ($cookies, $gmt, @t, @m, @w);
	 @m = ('Jan','Feb','Mar','Apr','May','Jun','Jul','Aug','Sep','Oct','Nov','Dec');
	 @w = ('Sun','Mon','Tue','Wed','Thu','Fri','Sat');
	 @t = gmtime(time + $days * 24 * 60 * 60 + $hour * 60 * 60 + $mint * 60);

	 $gmt = sprintf("%s, %02d-%s-%04d %02d:%02d:%02d GMT",
						$w[$t[6]], $t[3], $m[$t[4]], $t[5]+1900, $t[2], $t[1], $t[0]);
	foreach(@cook){
		s/(\W)/sprintf("%%%02X", unpack("C", $1))/eg;
		$cookies .= "$_<>";
	}
	print "Set-Cookie: $name=$cookies; expires=$gmt\n";
}

# クッキー取得
# ($name)= CookieName
# ($sepa)= Separator
sub GetCookie{
    my ($name, $sepa) = @_;

	my ($key, $val, %id, %cookie);
    @dat = CutOff(';', $ENV{'HTTP_COOKIE'});
	foreach(@dat){
		($key, $val) = CutOff('=', $_);
		$key =~ s/\s//g;
		$id{$key} = $val;
	}

	foreach(CutOff('<>', $id{$name})){
        tr/\+/ /;
        s/%([a-fA-F0-9][a-fA-F0-9])/pack('H2', $1)/eg;
        ($key, $val) = CutOff($sepa, $_);
        $cookie{$key} = $val;
	}
	return(%cookie);
}

# クッキーのクリア
# ($name)= CookieName
# 有効期限を1970年1月1日(火)0時0分0秒に設定
sub ClearCookie{
	my ($name) = @_;
	my $exp = 'Thu, 01-Jan-1970 00:00:00 GMT';
	print "Set-Cookie: $name=clear; expires=$exp;";
}


;#//////////////////////////////////////////////////////////////////////////////
;# コード変換
;#//////////////////////////////////////////////////////////////////////////////


# エンコード::URLエスケープ
sub EncodeURL{
	my ($s) = @_;
	$s =~ s/([^\w ])/'%'.unpack('H2', $1)/eg;
	$s =~ tr/ /+/;
	return($s);
}

# デコード::URLエスケープ
sub DecodeURL{
	my ($s) = @_;
	$s =~ tr/+/ /;
	$s =~ s/%([0-9a-fA-F][0-9a-fA-F])/pack("C", hex($1))/eg;
	return($s);
}

# 全ての改行コードを削除する
# UNIX, Windows 改行コード対応
sub OmitRetAll{
	my ($s) = @_;
	$s =~ tr/\x0D\x0A//d;
	return($s);
}

# 行末の改行コードを削除する
# UNIX, Windows 改行コード対応
sub OmitRetLast{
	my ($s) = @_;
	$s =~ s/\x0D?\x0A?$//;
	return($s);
}

# 改行コード変換
# '0D0A','0D','0A' -> '\n'(x0A)
sub ReturnTo1{
	my ($s) = @_;
	$s =~ s/\x0D\x0A|\x0D|\x0A/\n/g;
	return($s);
}

# 改行コードを<BR>に変換
# UNIX, Windows 改行コード対応
sub Return2br{
	my ($s) = @_;
	$s =~ s/\x0D\x0A|\x0D|\x0A/<BR>/g;
	return($s);
}

# 半角スペースを'&nbsp;'に変換
sub Space2nbsp{
	my ($s) = @_;
	my ($p, $l) = (index($s, ' ') + 1);
	while($p){
		$l = length($s) - $p;
		$s = substr($s, 0, $p - 1).'&nbsp;'.substr($s, length($s) - $l, $l);
		$p = index($s, ' ') + 1;
	}
	return($s);
}


;#------------------------------------------------------------------------------
;# コード変換配列版
;#------------------------------------------------------------------------------


# 全ての改行コードを削除する
# 配列版(リファレンス)
sub OmitRetAllEx{
	my ($s) = @_;
	for(my $i = 0; $i < @$s; $i++){
		@$s[$i] =~ tr/\x0D\x0A//d;
	}
}

# 行末の改行コードを削除する
# 配列版(リファレンス)
sub OmitRetLastEx{
	my ($s) = @_;
	for(my $i = 0; $i < @$s; $i++){
		@$s[$i] =~ s/\x0D?\x0A?$//;
	}
}

# 改行コード変換
# 配列版(リファレンス)
sub ReturnTo1Ex{
	my ($s) = @_;
	for(my $i = 0; $i < @$s; $i++){
		@$s[$i] =~ s/\x0D\x0A|\x0D|\x0A/\n/g;
	}
}

# 改行コードを<BR>に変換
# 配列版(リファレンス)
sub Return2brEx{
	my ($s) = @_;
	for(my $i = 0; $i < @$s; $i++){
		@$s[$i] =~ s/\x0D\x0A|\x0D|\x0A/<BR>/g;
	}
}

# 半角スペースを'&nbsp'に変換
# 配列版(リファレンス)
sub Space2nbspEx{
	my ($s) = @_;
	for(my $i = 0; $i < @$s; $i++){
		@$s[$i] = TextA2B(@$s[$i], ' ', '&nbsp;');
	}
}

# コンマ文字列から配列に変換
# $csv='1,2,3,"a,bc"'
# return=([1], [2], [3], [a,bc])
sub Csv2Array{
	my ($csv) = @_;
	$csv =~ s/(?:\x0D\x0A|[\x0D\x0A])?$/,/;
	my @ary = map{/^"(.*)"$/ ? scalar($_ = $1, s/""/"/g, $_) : $_}
					($csv =~ /("[^"]*(?:""[^"]*)*"|[^,]*),/g);
	return(@ary);
}

# 配列から"コンマ文字列"に変換
# @dat=([1], [2], [3], [a,bc])
# return=("1","2","3","a,bc")
sub Array2Csv{
	my (@dat) = @_;
	return('"'.Joint('","', @dat).'"');
}

;#//////////////////////////////////////////////////////////////////////////////
;# 文字コード関数
;#//////////////////////////////////////////////////////////////////////////////


# eucに変換
sub cnv2euc{
	my ($s) = @_;
	$s = Jcode->new($s)->euc;
	return($s);
}

# utf8に変換
sub cnv2utf{
	my ($s) = @_;
	$s = Jcode->new($s)->utf8;
	return($s);
}

# sjisに変換
sub cnv2sjis{
	my ($s) = @_;
	# ú±、û¹、ûüに対応
	my $js = jcode($s);
	$js->can("fallback") and $js->fallback(Jcode::FB_XMLCREF());
	$s = $js->sjis;
	return($s);
}

# eucに変換
# 配列版(リファレンス)
sub cnv2eucEx{
	my ($s) = @_;
	for(my $i = 0; $i < @$s; $i++){
		@$s[$i] = cnv2euc(@$s[$i]);
	}
}

# utf8に変換
# 配列版(リファレンス)
sub cnv2utfEx{
	my ($s) = @_;
	for(my $i = 0; $i < @$s; $i++){
		@$s[$i] = cnv2utf(@$s[$i]);
	}
}

# sjisに変換
# 配列版(リファレンス)
sub cnv2sjisEx{
	my ($s) = @_;
	for(my $i = 0; $i < @$s; $i++){
		@$s[$i] = cnv2sjis(@$s[$i]);
	}
}


;#//////////////////////////////////////////////////////////////////////////////
;# 文字列変換関数
;#//////////////////////////////////////////////////////////////////////////////


# 半角全角空白文字、全角文字正規表現
my $UTY_HANSP = '[\x20]';
my $UTY_ZENSP = '(?:\x81\x40)';
my $UTY_BYTE1 = '[\x00-\x7F\xA1-\xDF]';
my $UTY_BYTE2 = '(?:[\x81-\x9F\xE0-\xFC][\x40-\x7E\x80-\xFC])';
my $UTY_JIS2B = "(?:$UTY_BYTE1|$UTY_BYTE2)";
my $UTY_EUC2B = '[\xA1-\xFE][\xA1-\xFE]';


# 前後の空白とエスケープ文字を除去(全角含む)
# '\t_abc_\n_' -> 'abc'
sub Trim{
	my ($s) = @_;
	$s = TrimS($s);
	$s =~ s/^\s*(.*?)\s*$/$1/;
	return($s);
}

# 全ての空白とエスケープ文字を除去(全角含む)
# '__abc___' -> 'abc'
sub TrimA{
	my ($s) = @_;
	$s = cnv2sjis($s);
	$s =~ s/($UTY_JIS2B*?)(?:\s|$UTY_ZENSP)/$1/og;
	return($s);
}

# 前後の空白文字を除去(全角含む)
# '__abc___' -> 'abc'
sub TrimS{
	my ($s) = @_;
	$s = cnv2sjis($s);
	$s =~ s/^(?:$UTY_HANSP|$UTY_ZENSP)+//o;
	$s =~ s/^($UTY_JIS2B*?)(?:$UTY_HANSP|$UTY_ZENSP)+$/$1/o;
	return($s);
}

# 先頭部分の空白文字を除去(全角含む)
# '__abc___' -> 'abc___'
sub TrimL{
	my ($s) = @_;
	$s = cnv2sjis($s);
	$s =~ s/^(?:$UTY_HANSP|$UTY_ZENSP)+//o;
	return($s);
}

# 末尾部分の空白文字を除去(全角含む)
# '__abc___' -> '___abc'
sub TrimR{
	my ($s) = @_;
	$s = cnv2sjis($s);
	$s =~ s/^($UTY_JIS2B*?)(?:$UTY_HANSP|$UTY_ZENSP)+$/$1/o;
	return($s);
}

# スペースを半角１文字にまとめる(全角含む)
# '__ABC___DE__' -> '_ABC_DE_'
sub Space1{
	my ($s) = @_;
	$s = zen2hanSp($s);
	do{
		$s = TextA2B($s, '  ', ' ');
	}while(PosStr('  ', $s) > 0);
	return($s);
}

# 小文字変換
# 'ABCabc' -> 'abcabc'
sub LowerCase{
	my ($s) = @_;
	#$s = cnv2sjis($s);
	return(lc($s));
}

# 大文字変換
# 'ABCabc' -> 'ABAABC'
sub UpperCase{
	my ($s) = @_;
	#$s = cnv2sjis($s);
	return(uc($s));
}

# 全角小文字変換
# 'ＡＢＣABC'->'ａｂｃABC'
sub LowerCaseW{
	my ($s) = @_;
	$s = cnv2sjis($s);
	my $ret = '';
	my @chr = _get_wideChar($s);
	for(my $i = 0; $i < @chr; $i++ ){
		if($chr[$i] =~ /$UTY_EUC2B/){
			$ret .= han2zen(lc(zen2han(cnv2sjis($chr[$i]))));
		}else{
			$ret .= cnv2sjis($chr[$i]);
		}
	}
	return($ret);
}

# 全角大文字変換
# 'ａｂｃabc'->'ＡＢＣabc'
sub UpperCaseW{
	my ($s) = @_;
	$s = cnv2sjis($s);
	my $ret = '';
	my @chr = _get_wideChar($s);
	for(my $i = 0; $i < @chr; $i++ ){
		if($chr[$i] =~ /$UTY_EUC2B/){
			$ret .= han2zen(uc(zen2han(cnv2sjis($chr[$i]))));
		}else{
			$ret .= cnv2sjis($chr[$i]);
		}
	}
	return($ret);
}

# 区切りで要素を分解
# CutOff('/', 'abc/123') = @(abc, 123)
# $sep=','の場合"a,b"が変換できる
sub CutOff{
	my ($sep, $s) = @_;
	$s = cnv2sjis($s);
	$sep = cnv2sjis($sep);
	if($sep eq ','){
		return(Csv2Array($s));
	}else{
		return(split(/$sep/, $s));
	}
}

# 区切り付きで要素を加算
# Join('/', @('abc', '123)) = 'abc/123'
sub Joint{
	my ($sep, @s) = @_;
	my $nn = 0;
	my $ret = '';
	cnv2sjisEx(\@s);
	$sep = cnv2sjis($sep);
	$ret = join($sep, @s);
	return($ret)
}

# 指定文字で指定文字長を作成(マルチバイト対応)
# FillChar('\', 5) = '\\\\\'
sub FillChar{
	my ($s, $ln) = @_;
	$s = cnv2sjis($s);
	$s x= $ln;
	return($s);
}

# 文字列を整える
# '$s'はレファレンス
sub FixStr{
	my ($s) = @_;
	$$s = zen2han(Trim($$s));
}

# 数字文字列を整える
# '$s'はレファレンス
sub FixInt{
	my ($s) = @_;
	my $v = zen2han(TrimA($$s));
	$$s =~ s/[^\-|\d|\.]//g;
}

# 数字文字列を整える
# '$s'はレファレンス
sub FixIntEx{
	my ($s) = @_;
	for(my $i = 0; $i < @$s; $i++){
		@$s[$i] = zen2han(Trim(@$s[$i]));
		@$s[$i] =~ s/[^\-|\d|\.]//g;
	}
}

# 文字列を整える
# '$s'はレファレンス
sub FixStrEx{
	my ($s) = @_;
	for(my $i = 0; $i < @$s; $i++){
		@$s[$i] = zen2han(Trim(@$s[$i]));
	}
}


;#//////////////////////////////////////////////////////////////////////////////
;# 文字列操作関数(１バイト系)
;#//////////////////////////////////////////////////////////////////////////////


# $n文字目から検索し最初から文字が含まれる位置
# $nが無い場合文字列の最初から検索
# 戻り値::0=なし、1=１文字目
# PosStr('1', 'abc1234') = 4
sub PosStr{
	my ($a, $s, $n) = @_;
	$a = cnv2sjis($a);
	$s = cnv2sjis($s);
	$n= 1 unless($n);
	$n--;
	$s = RightStr($s, length($s) - $n);
	my $p = index($s, $a) + 1;
	return($p);
}

# 文字列の指定範囲を取得
# '$s'の'$st'文字目から'$ln'文字取得
# MidStr('1234567890', 4, 2) = '45'
sub MidStr{
	my ($s, $st, $ln) = @_;
	$s = cnv2sjis($s);
	my $ret = substr($s, $st - 1, $ln);
	return($ret);
}

# 文字列の左側を取得
# '$s'の左から'$ln'文字取得
# LeftSr('1234567890', 3) = '123'
sub LeftStr{
	my ($s, $ln) = @_;
	$s = cnv2sjis($s);
	my $ret = substr($s, 0, $ln);
	return($ret);
}

# 文字列の右側を取得
# '$s'の右から'$ln'文字取得
# RightStr('1234567890', 3) = '890'
sub RightStr{
	my ($s, $ln) = @_;
	$s = cnv2sjis($s);
	my $ret = substr($s, length($s) - $ln, $ln);
	return($ret);
}

# 文字列SのAをBに変換(マルチバイト対応)
# マルチバイト対応の為マッチングはさけた
# TextA2B('123a567', 'a', '(A)') = '123(A)567'
sub TextA2B{
	my ($s, $a, $b) = @_;

	$s = cnv2sjis($s);
	$a = cnv2sjis($a);
	$b = cnv2sjis($b);

	my $p;
	my $n = LengthW($a);

	# 'tr' の方が早いが２バイト文字が危ない
	do{
		$p = PosStrW($a, $s);
		if($p){
			$s = LeftStrW($s, $p-1).$b.RightStrW($s, LengthW($s)-($n + $p)+1);
		}
	}while($p);

	return($s);
}

# 固定長の文字列を取得
# '$s'を'$ln'文字数で'$sw(1:左,2:右)'よせで返す
# Text2MaxLen('12345AB', 12, 1) = '12345AB_____'
# Text2MaxLen('12345AB', 12, 2) = '_____12345AB'
sub Text2MaxLen{
	my ($s, $ln, $sw) = @_;
	$s = cnv2sjis($s);
	$sw = MinMax($sw, 1, 2);
	my $sp = FillChar(' ', $ln);

	switch($sw){
		case 1 {$s = LeftStr($s.$sp, $ln)}
		case 2 {$s = RightStr($sp.$s, $ln)}
	}
	return($s);
}

# 文字列'$txt'の'$no'文字目から'$s'の長さ分$s'に交換(マルチバイト対応)
# ChangeStr('1234567890', 5, 'xyz') = '1234xyz890'
sub ChangeStr{
	my ($txt, $s, $no) = @_;
	$s = cnv2sjis($s);
	$txt = cnv2sjis($txt);
	my $ln = LengthW($s);
	my $lw = LengthW($txt);
	$txt = LeftStrW($txt, $no - 1).$s.RightStr($txt, $lw - $ln - $no + 1);
	return($txt);
}

# 文字列'$s'を文字列'$txt'の'$no'文字目の後ろに挿入(マルチバイト対応)
# InsertStr('12345', 'X', 3) = '123X45'
sub InsertStr{
	my ($txt, $s, $no) = @_;
	$s = cnv2sjis($s);
	$txt = cnv2sjis($txt);
	my $lw = LengthW($txt);
	$txt = LeftStr($txt, $no).$s.RightStr($txt, $lw - $no);
	return($txt);
}

# 文字列'$txt'の'$no'文字目から'$ln'文字削除(マルチバイト対応)
# RemoveStr('12345', 3, 2) = '125'
sub RemoveStr{
	my ($txt, $no, $ln) = @_;
	$txt = cnv2sjis($txt);
	my $lw = LengthW($txt);
	$txt = LeftStrW($txt, $no - 1).RightStrW($txt, $lw - $no - $ln + 1);
	return($txt);
}

# 文字のコードを得る
# コードは１６進数(マルチバイト対応)
sub Char2CodeStr{
	my ($s) = @_;
	$s =~ s/(.)/sprintf "%X", ord($1)/eg;
	return($s);
}

# コードから文字を得る
# コードは１６進数(マルチバイト対応)
sub Code2CharStr{
	my ($s) = @_;
	$s =~ s/([0-9A-Fa-f][0-9A-Fa-f])/pack("C", hex($1))/eg;
	return($s);
}


;#//////////////////////////////////////////////////////////////////////////////
;# ワイド文字列操作関数
;# 半角でも全角でも１文字として扱う(WideChar)
;# perl は文字関数・マッチング等において２バイト文字が非常に弱いので
;# ２バイトが含まれる可能性がある場合、以下の関数で処理を行うようにする事
;#//////////////////////////////////////////////////////////////////////////////


# ワイド文字数の取得
# 半角でも全角でも１文字として計算
# LengthW('1２3４5６7８9０') = 10
sub LengthW{
	$_ = $_[0];
	$_ = cnv2sjis($_);
	my $lz = s/[\x81-\x9f\xe0-\xfc][\x40-\x7e\x80-\xfc]//g;
	my $lh = length($_);
	return($lz + $lh);
}

# ワイド文字列の$n文字目から検索し最初から文字が含まれる位置
# $nが無い場合文字列の最初から検索
# 戻り値::0=なし、1=１文字目
# PosStrW('1', 'abc1234', 4) = 4
sub PosStrW{
	my ($a, $s, $n) = @_;
	$a = cnv2sjis($a);
	$s = cnv2sjis($s);
	$n = 1 unless($n);
	my $p = 0;
	my $ls = LengthW($s);
	my $la = LengthW($a);
	for(my $i = $n; $i <= $ls; $i++){
		if(MidStrW($s, $i, $la) eq $a){
			$p = $i - $n + 1;
			last;
		}
	}
	return($p);
}

# ワイド文字列の指定範囲を取得
# '$s'の'$st'文字目から'$ln'文字取得
# MidStrW('1２3４5６7８9０', 4, 3) = '４5６'
sub MidStrW{
	my ($s, $st, $ln) = @_;

	my $ret = '';
	my @txt = _get_wideChar($s);

	for(my $i = $st - 1; $i < $st + $ln - 1; $i++){
		$ret .= $txt[$i];
	}
	$ret = cnv2sjis($ret);
	return($ret);
}

# ワイド文字列の左側を取得
# '$s'の左から'$ln'文字取得
# LeftStrW('1２3４5６7８9０', 3) = '1２3'
sub LeftStrW{
	my ($s, $ln) = @_;
	$s = cnv2sjis($s);
	my $ret = MidStrW($s, 1, $ln);
	return($ret);
}

# ワイド文字列の右側を取得
# '$s'の右から'$ln'文字取得
# RighttStrW('1２3４5６7８9０', 3) = '８9０'
sub RightStrW{
	my ($s, $ln) = @_;
	$s = cnv2sjis($s);
	my $ret = MidStrW($s, LengthW($s) - $ln + 1, $ln);
	return($ret);
}

# ２バイト文字を考慮し固定長の文字列を取得
# '$s'を'$ln'文字数で'$sw(1:左,2:右)'よせで返す
# ２バイト文字の場合'$ln'が短いと最後の文字が消える
sub Text2MaxLenW{
	my ($dt, $ln, $sw) = @_;
	if(isKanji1($dt, $ln) == 1){
		$dt = LeftStr($dt, $ln - 1);
	}else{
		$dt = LeftStr($dt, $ln);
	}
	$dt = Text2MaxLen($dt, $ln, $sw);
	return($dt);
}

# ワイド文字変換(内部関数)
# EUC-JP変換するので文字列として使用する場合はsjisに変換
sub _get_wideChar{
	my ($s) = @_;
	$s = cnv2euc($s);
	my ($ascii, $UTY_BYTE2, $byte3, @chars);
	$ascii = '[\x00-\x7F]';
	$UTY_BYTE2 = '[\x8E\xA1-\xFE][\xA1-\xFE]';
	$byte3 = '\x8F[\xA1-\xFE][\xA1-\xFE]';
	@chars = $s =~ /$ascii|$UTY_BYTE2|$byte3/og;
	return(@chars);
}


;#//////////////////////////////////////////////////////////////////////////////
;# 文字列判定関数
;#//////////////////////////////////////////////////////////////////////////////


# 実数で出来た文字列か判定(非常に厳しい判定)
# 'isReal' は余り使用する会はないと思うが
# 'isFloat' で使用するので一応作成しみた
# '10000' -> OK
# '100.1' -> OK
# '100.A' -> NG
# '1.1.2' -> NG
# '1000.' -> NG
# '100..' -> NG
sub isReal{
	my ($s) = @_;
	# 'looks_like_number' はめっちゃ早い、しかし…
	# my $ret = Scalar::Util::looks_like_number($s);
	# $ret = ($s =~ /\.$/) ? 0 : 1 if($ret); がないとNG
	my $ret = ($s =~ /^[+-]?\d+(?:\.?\d+)?$/) ? 1 : 0;
	return($ret);
}

# 少数点を含む数字文字列か判定
# '100.1' -> OK
# '100.A' -> NG
# '10000' -> NG
sub isFloat{
	my ($s) = @_;
	my $ret = (! isInteger($s) && isReal($s)) ? 1 : 0;
	return($ret);
}

# 整数のみの数字文字列か判定
# '10000' -> OK
# '1000A' -> NG
# '100.1' -> NG
sub isInteger{
	my ($s) = @_;
	my $ret = ($s =~ /^[+-]?\d+$/) ? 1 : 0;
	return($ret);
}

# 数字文字列の判定
# '12345' -> OK
# '100.1' -> OK
# '1234A' -> NG
sub isNumeric{
	my ($s) = @_;
	my $ret = ($s =~ /^\d+$/) ? 1 : 0;
	return($ret);
}

# 数値として扱える文字列の判定
# 半角、全角数値用
# '\ , 円' は許す
# '012345' -> OK
# '\12345' -> OK
# '1234円' -> OK
# '+1,234' -> OK
# '-123.4' -> OK
# '12345A' -> NG
sub isFigure{
	my ($s) = @_;
	$s = k2::TrimA($s);
	$s = k2::zen2han($s);
	$s =~ s/[\\|\,|円]//g;
	my $ret = (k2::isReal($s)) ? 1 : 0;
}

# ±Ù̧ÍÞ¯Äの判定
# 'abcde' -> OK
# 'ABCDE' -> OK
# '123de' -> NG
sub isAlphabet{
	my ($s) = @_;
	$s = cnv2sjis($s);
	my $ret = ($s =~ /^[a-z]+$/i) ? 1 : 0;
	return($ret);
}

# 半角カナの判定
# '±²³´µ' -> OK
# '±²³´1' -> NG
# '±²³ア' -> NG
sub isKana{
	my ($s) = @_;
	$s = cnv2sjis($s);
	my $hk = '[\xA6-\xDF]';
	$s =~ s/^($hk*?)+$/$1/o;
	my $ret = ($s) ? 0 : 1;
	return($ret);
}


;#------------------------------------------------------------------------------
;# 拡張版
;#------------------------------------------------------------------------------


# 実数か判定(非常に厳しい判定)
# 配列版
sub isRealEx{
	my (@s) = @_;
	my $ret = (@s) ? 1 : 0;
	foreach(@s){
		unless(/^[+-]?\d+(?:\.?\d+)?$/){
			$ret = 0;
			last;
		}
	}
	return($ret);
}

# 少数点を含む数字文字列か判定
# 配列版
sub isFloatEx{
	my (@s) = @_;
	my (@s) = @_;
	my $ret = (@s) ? 1 : 0;
	foreach(@s){
		unless((/^[+-]?\d+(?:\.?\d+)?$/) && !(/^[+-]?\d+$/)){
			$ret = 0;
			last;
		}
	}
	return($ret);
}

# 整数のみの数字文字列か判定
# 配列版
sub isIntegerEx{
	my (@s) = @_;
	my $ret = (@s) ? 1 : 0;
	foreach(@s){
		unless(/^[+-]?\d+$/){
			$ret = 0;
			last;
		}
	}
	return($ret);
}

# 数字文字列の判定
# 配列版
sub isNumericEx{
	my (@s) = @_;
	my $ret = (@s) ? 1 : 0;
	foreach(@s){
		unless(/^\d+$/){
			$ret = 0;
			last;
		}
	}
	return($ret);
}

# 数値として扱える文字列の判定
# 配列版
sub isFigureEx{
	my (@s) = @_;
	my $ret = (@s) ? 1 : 0;
	foreach(@s){
		unless(isFigure($_)){
			$ret = 0;
			last;
		}
	}
	return($ret);
}

# ±Ù̧ÍÞ¯Äの判定
# 配列版
sub isAlphabetEx{
	my (@s) = @_;
	my $ret = (@s) ? 1 : 0;
	foreach(@s){
		unless(/^[a-z]+$/i){
			$ret = 0;
			last;
		}
	}
	return($ret);
}

# 半角カナの判定
# 配列版
sub isKanaEx{
	my (@s) = @_;
	my $ret = (@s) ? 1 : 0;
	foreach(@s){
		unless(/^[\xA6-\xDF]+$/){
			$ret = 0;
			last;
		}
	}
	return($ret);
}


;#//////////////////////////////////////////////////////////////////////////////
;# マルチバイト文字の判定
;#//////////////////////////////////////////////////////////////////////////////


# 全角数字の判定
# isIntegerZ()とisFloatZ()は
# isKanjiしLowerCase後半角用関数を使う
# 全角数字は文字として使用する事はあるが
# 計算用数値として使用する機会が少ないので！！
sub isNumericW{
	my ($s) = @_;
	$s = cnv2sjis($s);
	my $zk = '(?:\x82[\x4F-\x58])';
	$s =~ s/^($zk*?)+$/$1/o;
	my $ret = ($s) ? 0 : 1;
	return($ret);
}

# 全角±Ù̧ÍÞ¯Äの判定
# 半角に同じ
sub isAlphabetW{
	my ($s) = @_;
	$s = cnv2sjis($s);
	my $zk = '(?:\x82[\x60-\x79\x81-\x9A])';
	$s =~ s/^($zk*?)+$/$1/o;
	my $ret = ($s) ? 0 : 1;
	return($ret);
}

# 全角カナの判定
# 半角に同じ
sub isKanaW{
	my ($s) = @_;
	$s = cnv2sjis($s);
	my $zk = '(?:\x83[\x40-\x96])';
	$s =~ s/^($zk*?)+$/$1/o;
	my $ret = ($s) ? 0 : 1;
	return($ret);
}

# 全角ひらがなの判定
# 'あいう' -> OK
# 'あいウ' -> NG
sub isHira{
	my ($s) = @_;
	$s = cnv2sjis($s);
	my $zk = '(?:\x82[\x9F-\xF1])';
	$s =~ s/^($zk*?)+$/$1/o;
	my $ret = ($s) ? 0 : 1;
	return($ret);
}

# マルチバイト全般の判定
# ('123ABC', 1, 2) -> 0
# ('123あいう', 1) -> 0
# ('123あいう', 2) -> 1
# ('１Ａあ', 1, 2) -> 1
sub isKanji{
	my ($s, $sw) = @_;

	my $ret = 0;
	$sw = MinMax($sw, 1, 2);
	my @chr = _get_wideChar($s);

	my ($zn, $hn);
	for(my $i = 0; $i < @chr; $i++ ){
		if($chr[$i] =~ /$UTY_EUC2B/){
			$zn++;
		}else{
			$hn++;
		}
	}
	if($zn){
		switch($sw){
			case 1{$ret = ($hn == 0) ? 1 : 0}
			case 2{$ret = 1}
		}
	}
	return($ret);
}

# '$'sの'$no'文字目は漢字か判定
sub isKanjiIn{
	my ($s, $no) = @_;

	my $ret = 0;
	if( ($s) && ($no >= 1) && ($no <= LengthW($s)) ){
		my @chr = _get_wideChar($s);
		if($chr[$no - 1] =~ /$UTY_EUC2B/){$ret = 1}
	}
	return($ret);
}

# '$'sの'$no'バイト目は漢字の何バイト目か判定
# １バイト目は＝１、２バイト目は＝２が返る
sub isKanji1{
	my ($s, $no) = @_;

	my $ret = 0;
	my $byte = 0;
	my @chr = _get_wideChar($s);
	for(my $i = 0; $i < @chr; $i++){
		$byte++;
		if($chr[$i] =~ /$UTY_EUC2B/){
			if($byte == $no){$ret = 1}
			$byte++;
			if($byte == $no){$ret = 2}
		}
		if($byte >= $no){last}
	}
	return($ret);
}


;#//////////////////////////////////////////////////////////////////////////////
;# 半角全角変換関数
;#//////////////////////////////////////////////////////////////////////////////


# 空白文字を全角から半角に変換
# '＿あ＿い＿う' -> '_あ_い_う'
sub zen2hanSp{
	my ($s) = @_;
	$s = cnv2sjis($s);
	$s =~ s/　/ /g;
	return($s);
}

# 空白文字を半角から全角に変換
# '_あ_い_う' -> '＿あ＿い＿う'
sub han2zenSp{
	my ($s) = @_;
	$s = cnv2sjis($s);
	$s =~ s/ /　/g;
	return($s);
}

# 半角カナを全角に変換
# '±²³' -> 'アイウ'
sub han2zenk{
	my ($s) = @_;
	$s = cnv2euc($s);
	$s = jcode($s, 'euc')->h2z->sjis;
	return($s);
}

# 全角カナを半角に変換
# 'アイウ' -> '±²³'
sub zen2hank{
	my ($s) = @_;
	$s = cnv2euc($s);
	$s = jcode($s, 'euc')->z2h->sjis;
	return($s);
}

# 半角をに全角変換(英数記号)
# '12AB+%' -> '１２ＡＢ＋％'
sub han2zen{
	my ($s) = @_;
	my $ret = '';
	$s = cnv2sjis($s);
	my $ls = LengthW($s);
	for(my $i = 1; $i <= $ls; $i++){
		my $d = MidStrW($s, $i, 1);
		unless(isKanji($d)){
			$d =~ s/([0-9A-Za-z])/pack("C*", 0xA3, ord($1) + 0x80)/eg;
		}
		$ret .= Trim($d);
	}
	return($ret);
}

# 全角を半角に変換(英数記号)
# '１２ＡＢ＋％' -> '12AB+%'
# ちょっとデカイ！！
sub zen2han{
	my ($s) = @_;
	my ($ln) = length($s);
	my ($i, $j, $unpack, $pack);

	my (@ASCII) = (
		'64-32' , '73-33' , '104-34', '148-35', '144-36' , '147-37', '149-38' ,'102-39',
		'105-40', '106-41', '150-42', '123-43', '67-44'  , '124-45', '68-46'  , '94-47' ,
		'70-58' , '71-59' , '131-60', '129-61', '132-62' , '72-63' , '151-64' , '109-91',
		'143-92', '110-93', '79-94' , '81-95' , '111-123', '98-124', '112-125', '96-126'
	);

	local($_);
	for($i = 0; $i < $ln; $i++){
		$j = substr($s, $i, 1);
		$_ .= "!". unpack("C", $j);
	}

	foreach my $ascii (@ASCII){
		($unpack, $pack) = split(/\-/, $ascii);
		s/!129!$unpack/!$pack/g;
	}

	my $st;
	while(/(^|!(\d+))!130!(\d+)/){
		if( ($3 >= 63 && $3 <= 88)||($3 >= 96 && $3 <= 121) ){
			$st = $3 - 31;
			$_ =~ s/!130!(\d+)/!$st/;
		}elsif($3 >= 129 && $3 <= 154 && $2 < 129){
			$st = $3 - 32;
			$_ =~ s/!130\!(\d+)/!$st/;
		}else{
			$_ =~ s/!130!(\d+)/;130!$1/;
		}
	}

	s/;(\d+)/pack("C", $1)/eg;
	s/!(\d+)/pack("C", $1)/eg;
	s/、/,/g;

	return($_);
}


;#//////////////////////////////////////////////////////////////////////////////
;# リファレンスの型判定関数
;#//////////////////////////////////////////////////////////////////////////////


# Scalarの判定
# isScalar(\$dt)
# '$dt'はリファレンス
sub isScalar{
	my ($dt) = @_;
	my $ret = (ref($dt) eq 'SCALAR') ? 1 : 0;
	return($ret);
}

# 配列の判定
# isArray(\@dt)
# '$dt'はリファレンス
sub isArray{
	my ($dt) = @_;
	my $ret = (ref($dt) eq 'ARRAY') ? 1 : 0;
	return($ret);
}

# Hashの判定
# isHash(\%dt)
# '$dt'はリファレンス
sub isHash{
	my ($dt) = @_;
	my $ret = (ref($dt) eq 'HASH') ? 1 : 0;
	return($ret);
}

# Referenceの判定
# isRef(\\10)
# '$dt'はリファレンス
sub isRef{
	my ($dt) = @_;
	my $ret = (ref($dt) eq 'REF') ? 1 : 0;
	return($ret);
}

# Globの判定
# isGlob(\*dt)
# '$dt'はリファレンス
sub isGlob{
	my ($dt) = @_;
	my $ret = (ref($dt) eq 'GLOB') ? 1 : 0;
	return($ret);
}

# Codeの判定
# isCode(sub{@_[0]})
sub isCode{
	my ($dt) = @_;
	my $ret = (ref($dt) eq 'CODE') ? 1 : 0;
	return($ret);
}

# Lvalueの判定
# isLvalue(\pos())
# '$dt'はリファレンス
sub isLvalue{
	my ($dt) = @_;
	my $ret = (ref($dt) eq 'LVALUE') ? 1 : 0;
	return($ret);
}

# Handleの判定
# isHandle(*HD{IO})
# '$dt'はリファレンス
sub isHandle{
	my ($HD) = @_;
	my $ret = (ref($HD) eq 'IO::Handle') ? 1 : 0;
	return($ret);
}


;#//////////////////////////////////////////////////////////////////////////////
;# 配列操作関数
;#//////////////////////////////////////////////////////////////////////////////


# 配列で文字列が一致する行
# HitOf('Abc', 'abc') => OK
# HitOf('ab3', 'abc') => NG
sub HitOf{
	my ($s, @dat) = @_;
	my $i = 0;
	my $ret = -1;
	$s = lc(cnv2sjis($s));
	#cnv2sjisEx(\@dat);
	foreach(@dat){
		if($s eq lc($_)){
			$ret = $i;
			last;
		}
		$i++;
	}
	return($ret);
}

# 配列で行頭から文字列が含まれる行
# IndexOf('Abc123', 'abc') => OK
# IndexOf('123abc', 'abc') => NG
sub IndexOf{
	my ($s, @dat) = @_;
	my $i = 0;
	my $ret = -1;
	$s = lc(cnv2sjis($s));
	#cnv2sjisEx(\@dat);
	foreach(@dat){
		#if($_ =~ /^$s/i){ last; }
		if(index(lc($_), $s) == 0){
			$ret = $i;
			last;
		}
		$i++;
	}
	return($ret);
}

# 配列で行に文字列が含まれる行
# IncludeOf('abc123'), 'abc' => OK
# IncludeOf('123ABC'), 'abc' => OK
sub IncludeOf{
	my ($s, @dat) = @_;
	my $i = 0;
	$s = lc(cnv2sjis($s));
	#cnv2sjisEx(\@dat);
	foreach(@dat){
		$_ = lc($_);
		if($_ =~ /$s/i){last}
		$i++;
	}
	return($i);
}

# 配列の'$no'行から'$ln'行削除
# '$dat'はリファレンス
sub DeleteOf{
	my ($dat, $no, $ln) = @_;
	splice(@$dat, $no, $ln);
	return(1);
}

# 配列の'$no'行に'$s'を挿入
# '$dat'はリファレンス
sub InsertOf{
	my ($dat, $no, $s) = @_;
	$s = cnv2sjis($s);
	splice(@$dat, $no, 0, $s);
	return(1);
}

# 配列の連結
# ($d1, $d2) リファレンス
# ($sw=1)::'$d1'の前に'$d2'を連結
# ($sw=2)::'$d1'の後に'$d2'を連結
sub MargeOf{
	my ($d1, $d2, $sw) = @_;
	my @ret = ();
	$sw = MinMax($sw, 1, 2);
	switch($sw){
		case 1 {@ret = (@$d1, @$d2)}	# unshift($dt1, $dt2)
		case 2 {@ret = (@$d2, @$d1)}    # push(($dt1, $dt2)
	}
	return(@ret);
}

# 文字配列のソーティング
# (sw=1) ? 昇順 : 降順
sub SortStrOf{
	my ($sw, @dat) = @_;
	$sw = MinMax($sw, 1, 2);
	switch($sw){
		case 1 {return(sort{$a cmp $b} @dat)}
		case 2 {return(sort{$b cmp $a} @dat)}
	}
}

# 数字配列のソーティング
# (sw=1) ? 昇順 : 降順
sub SortIntOf{
	my ($sw, @dat) = @_;
	$sw = MinMax($sw, 1, 2);
	switch($sw){
		case 1 {return(sort{$a <=> $b} @dat)}
		case 2 {return(sort{$b <=> $a} @dat)}
	}
}

# 文字配列の最小のバイト数を得る
sub MinLenStrOf{
	my $min = 999999999999999;
	foreach(@_){
		my $ln = length($_);
		if($ln < $min){$min = $ln}
	}
	return($min);
}

# 文字配列の最大のバイト数を得る
sub MaxLenStrOf{
	my $max = 0;
	foreach(@_){
		my $ln = length($_);
		if($ln > $max){$max = $ln}
	}
	return($max);
}

# 数字配列の最小値を得る
# @(1, 2, 3, 4, 5) -> 1
sub MinIntOf{
	my (@dt) = @_;
	return('')unless(@dt);
	#@dt = SortIntOf(@dt);
	#return($dt[0]);
	my $min = 999999999999999;
	foreach my $val (@dt){
		next if($val eq '');
		if($val < $min){
			$min = $val;
		}
	}
	return($min);
}

# 数字配列の最大値を得る
# @(1, 2, 3, 4, 5) -> 5
sub MaxIntOf{
	my (@dt) = @_;
	return('')unless(@dt);
	#@dt = SortIntOf(@dt);
	#return($dt[$#dt]);
	my $max = -999999999999999;
	foreach my $val (@dt){
		next if($val eq '');
		if($val > $max){
			$max = $val;
		}
	}
	return($max);
}

# 文字配列の最小値を得る
# @('a', 'b', 'c') -> 'a'
sub MinStrOf{
	my (@dt) = @_;
	return('')unless(@dt);
	my $min = shift(@dt);
	foreach my $val (@dt){
		if($min gt $val){
			$min = $val;
		}
	}
	return($min);
}

# 文字配列の最大値を得る
# @('a', 'b', 'c') -> 'c'
sub MaxStrOf{
	my (@dt) = @_;
	return('')unless(@dt);
	my $max = shift(@dt);
	foreach my $val (@dt){
		if($max lt $val){
			$max = $val;
		}
	}
	return($max);
}

# 配列の部分取得
sub PickUpOf{
	my ($no, $ln, @dt) = @_;
	@dt = @dt[$no..$no + $ln - 1];
	return(@dt);
}

# 配列の重複要素辞去
sub DelDupOf{
	my (@dt) = @_;
	my %ct;
	@dt = grep(!$ct{$_}++, @dt);
	return(@dt);
}

# 配列のシャフル
sub ShuffleOf{
	my (@dt) = @_;
	@dt = List::Util::shuffle(@dt);
	return(@dt);
}


;#//////////////////////////////////////////////////////////////////////////////
;# ハッシュ操作関数(マルチバイト対応)
;#//////////////////////////////////////////////////////////////////////////////


# ハッシュの参照
sub GetHash{
	my ($ky, %h) = @_;
	$ky = cnv2euc($ky);
	if(exists $h{$ky}){
		return($h{$ky});
	}else{
		return(0);
	}
}

# ハッシュに代入
sub PutHash{
	my ($ky, $dt, %h) = @_;
	$ky = cnv2euc($ky);
	unless(exists $h{$ky}){
		$h{$ky} = $dt;
		return(%h);
	}else{
		return(0);
	}
}

# ハッシュの削除
sub DeleteHash{
	my ($ky, %h) = @_;
	delete($h{$ky});
	return(%h);
}

# 配列からハッシュへ変換
# @([key], [value]) -> %h{key} = value
sub Array2Hash{
	my (@dt) = @_;
	my %ret = ();
	for(my $i = 0; $i < @dt; $i++){
		$ret{cnv2euc($dt[0][$i])} = $dt[1][$i];
	}
	return(%ret);
}

# ハッシュから配列へ変換
# (%h{key} = value) -> @([key], [value])
sub Hash2Array{
	my (%dt) = @_;
	my @ret = ();
	foreach my $key (sort keys %dt){
		$ret[@ret][0] = cnv2sjis($key);
		$ret[@ret][1] = $dt{$key};
	}
	return(@ret);
}

# ハッシュの連結
# ($h1, $h2) リファレンス
# ($sw=1)::'$h1'の前に'$h2'を連結
# ($sw=2)::'$h1'の後に'$h2'を連結
sub MargeHash{
	my ($h1, $h2, $sw) = @_;
	my %ret = ();
	$sw = MinMax($sw, 1, 2);
	switch($sw){
		case 1 {%ret = (%$h1, %$h2)}
		case 2 {%ret = (%$h2, %$h1)}
	}
	return(%ret);
}

# ハッシュの値取得
# ソーティングして返す
sub ValsHash{
	my (%h) = @_;
	my @ret = ();

	foreach my $key (sort keys %h){
		$ret[@ret] = $h{$key};
	}
	return(@ret);
}

# ハッシュのキー取得
sub KeysHash{
	my (%h) = @_;
	my @ret = ();
	foreach my $key (sort keys %h){
		$ret[@ret] = cnv2sjis($key);
	}
	return(@ret);
}

# ハッシュの要素数
sub KeysInHash{
	my (%h) = @_;
	my $ret = keys(%h);
	return($ret);
}


;#//////////////////////////////////////////////////////////////////////////////
;# バッファ::LIFO(スタック),FIFO(キュー)
;#//////////////////////////////////////////////////////////////////////////////


# スタック::LIFO(ライフォ)
# 最後に入力されたデータが最初に出力される
# キュー::FIFO(ファイフォ)
# 最初に入力されたデータが最初に出力される
# データの一時退避、メモリー代わりとして利用できる(Swap()参照)
my @UTY_STACK;


# LIFO::スタックイン
# 引数'-1'で初期化
sub Push{
	my $v = $_[0];
	if($v == -1){
		@UTY_STACK = ();
		return(1);
	}else{
		return(push(@UTY_STACK, $v));
	}
}

# LIFO::スタックアウト
# 引数'-1'で初期化
sub Pop{
	my $v = $_[0];
	if($v == -1){
		@UTY_STACK = ();
		return(1);
	}else{
		return(pop(@UTY_STACK));
	}
}

# FIFO::キューイン
# 引数'-1'で初期化
sub UnShift{
	my $v = $_[0];
	if($v == -1){
		@UTY_STACK = ();
		return(1);
	}else{
		return(unshift(@UTY_STACK, $v));
	}
}

# FIFO::キューアウト
# 引数'-1'で初期化
sub Shift{
	my $v = $_[0];
	if($v == -1){
		@UTY_STACK = ();
		return(1);
	}else{
		return(shift(@UTY_STACK));
	}
}


;#//////////////////////////////////////////////////////////////////////////////
;# 数値関数
;#//////////////////////////////////////////////////////////////////////////////


# 配列の大きさ(最大値)を取得
# @V(0,1,2,3,4) = 5
sub Hi{
	my (@v) = @_;
	my $ln = @v;
	return($ln);
}

# 配列要素の大きさ(最大値)を取得
# @V(0,1,2,3,4) = 4
sub Lo{
	my (@v) = @_;
	return($#v);
}

# データの交換($a <-> $b)
# Swap($a, $b) = ($b, $a)
# 参照渡し(リファレンス)
# 引数が直接交換される
sub Swap{
	my ($a, $b) = @_;
	($$b, $$a) = ($$a, $$b);
	return(1);
}

# データの交換($a <-> $b)
# SwapEx($a, $b) -> ($b, $a)
# 値渡しタイプ
sub SwapEx{
	my ($a, $b) = @_;
	# 返り値はリスト
	return($b, $a);
}

# 最小値を得る
# Min(1, 5) = 1
sub Min{
	my ($a, $b) = @_;
	my $x = ($a < $b) ? $a : $b;
	return($x);
}

# 最大値を得る
# Min(1, 5) = 5
sub Max{
	my ($a, $b) = @_;
	my $x = ($a > $b) ? $a : $b;
	return($x);
}

# 制限付き最小最大値を得る
# MinMax(3, 1, 5) = 3
# MinMax(0, 1, 5) = 1
# MinMax(7, 1, 5) = 5
sub MinMax{
	my ($s, $a, $b) = @_;
	$s = 0 unless($s);
	Swap(\$a, \$b) if ($a > $b);
	$s = ($s < $a) ? $a : $s;
	$s = ($s > $b) ? $b : $s;
	return($s);
}


;#//////////////////////////////////////////////////////////////////////////////
;# 数値丸め関数
;#//////////////////////////////////////////////////////////////////////////////


# 四捨五入
# 値'$v'、四捨五入する桁数'$r'
# '$r' が無い場合は少数点以下を計算
# Round(+1000.4) = +1000
# Round(-1000.4) = -1000
sub Round{
	my ($v, $r) = @_;
	$r = Power(10, $r);
	my $x = ($v) ? 0.5 : -0.5;
	return(int($v * $r + $x) / $r);
}

# 四捨五入
# 金額計算等に使用
# 値'$v'、四捨五入する桁数'$r'
# '$r' が無い場合は少数点以下を計算
# RoundOff(+1000.4) = +1000
# RoundOff(-1000.4) = -1001
sub RoundOff{
	my ($v, $r) = @_;
	$r = Power(10, $r);
	my $x = ($v) ? 0.5 : -0.5;
	return(Trunc($v * $r + $x) / $r);
}

# 切り捨て
# 金額計算等に使用
# 値'$v'、切り捨てる桁数'$r'
# '$r' が無い場合は少数点以下
# Trunc(+1000.4) = +1000
# Trunc(-1000.4) = -1001
sub Trunc{
	my ($v, $r) = @_;
	$r = Power(10, $r);
	my $ret;

	if($v){
		$ret = int($v * $r) / $r;
	}else{
		my $x = $v * $r;
		if($x == int($x)){
			$ret = $x / $r;
		}else{
			$ret = int($x - 1) / $r;
		}
	}
	return($ret);
}

# 切り上げ
# 値'$v'、切り上げる桁数'$r'
# '$r' が無い場合は少数点以下
# Ceil(+1000.4) = +1001
# Ceil(-1000.4) = -1000
sub Ceil{
	my ($v, $r) = @_;
	$r = Power(10, $r);
	my $ret;

	if($v){
		my $x = $v * $r;
		if($x == int($x)){
			$ret = $x / $r;
		}else{
			$ret = int($x + 1) / $r;
		}
	}else{
		$ret = int($v * $r) / $r;
	}
	return($ret);
}


;#//////////////////////////////////////////////////////////////////////////////
;# 計算用関数
;#//////////////////////////////////////////////////////////////////////////////


# 整数除算
# Div(10, 3) = 3
sub Div{
	my ($x, $y) = @_;
	$x = ($y) ? int($x / $y) : 0;
	return($x);
}

# 整数乗除
# Mod(10, 3) = 1
sub Mod{
	my ($x, $y) = @_;
	$x = $x % $y;
	return($x);
}

# 指数計算
# $v^$p
sub Power{
	my ($v, $p) = @_;
	return($v ** $p);
}

# √の計算
# $vの$n乗根($nが無い場合２乗根)
# 虚数は負の値が返る(Sqr(-4, 2) = -2 = 2i)
sub Sqr{
	my ($v, $n) = @_;
	$n = 2 unless($n);
	my $i = ($v < 0) ? -1 : 1;
	$v = $i * Power(abs($v), (1 / $n));
	return($v);
}


;#//////////////////////////////////////////////////////////////////////////////
;# ３ケタコンマ
;#//////////////////////////////////////////////////////////////////////////////


# ３ケタコンマ(文字)
# $v =数値
# $ln=全体の桁数(固定長)
# CommaStr(1000000) = 1,000,000
# CommaStr(1000000.12345) = 1,000,000.12,345
# CommaStr(1000000.12345, 18) = __1,000,000.12,345
sub CommaStr{
	my ($v, $ln) = @_;
	if($v ne ''){
		1 while($v =~ s/(\d+)(\d\d\d)/$1,$2/);

		if(isInteger($ln) && $ln != 0){
			$v = Text2MaxLen($v, $ln, 2);
		}
	}
	return($v);
}

# ３ケタコンマ(数値)
# $v =数値
# $ln=全体の桁数(固定長)
# CommaInt(1000000) = 1,000,000
# CommaInt(1000000.12345) = 1,000,000.12345
# CommaInt(1000000.12345, 18) = __1,000,000.12,345
sub CommaInt{
	my ($v, $ln) = @_;
	if($v ne ''){
		$v = reverse($v);
		$v =~ s/(\d{3})(?=\d)(?!\d*\.)/$1,/g;
		$v = reverse($v);

		if(isInteger($ln) && $ln != 0){
			$v = Text2MaxLen($v, $ln, 2);
		}
	}
	return($v);
}

# ３ケタコンマ少数点以下の桁数制限
# $v =数値
# $n =数点以下の桁数
# $ln=全体の桁数(固定長)
# CommaFloat(1000000.12345, 2) = 1,000,000.12
# CommaFloat(1000000.12345, 4) = 1,000,000.125
# CommaFloat(1000000.12345, 18) = ___1,000,000.12345
sub CommaFloat{
	my ($v, $n, $ln) = @_;
	my ($p, $d, $h, $l, $r);

	if($v ne ''){
		#$d = '1'.FillChar('0', $n);
		$d = Power(10, $n);
		$v = Round($v * $d);
		$v = $v / $d;

		$p = PosStr('.', $v);
		if($p){
			$h = LeftStr($v, $p - 1);
			$l = RightStr($v, length($v) - $p);
			$l = LeftStr($l.FillChar('0', $n), $n);
			$r = CommaInt($h).'.'.LeftStr($l, $n);
		}else{
			$r = CommaInt($v).'.'.FillChar('0', $n);
		}

		if(isInteger($ln) && $ln != 0){
			$r = Text2MaxLen($r, $ln, 2);
		}
	}else{
		$r = '';
	}
	return($r);
}

## K2/LIB::PERL LIBRARY++ ------------------------------------------------------
1;                                                      ## Presented by Dr.k2 ##
## EOF -------------------------------------------------------------------------