package webdb;

;#--- pod Start -----------------------------------------------------------#
=pod

=head1 NAME

webdb.pm - 共通サブルーチン群

=head1 概要

DBアクセス用サブルーチン、文字変換ルーチン
オーク共通処理用サブルーチン、その他細かいルーチンの集まり

=head1 サブルーチン

=cut
;#--- pod Start -----------------------------------------------------------#

;; our $VERSION = '0.00';
@ISA = qw(DBI);
use strict;
use CGI qw/:standard :html3 -no_xhtml/;
use DBI;
use Socket;
use myconstant;
use lib '/sei/sne/jnet/hori/wiki/lib';
use Jcode;
use Net::SMTP;
use MIME::Base64 qw(encode_base64);
require 'webdb-param.pl';

our $AUTOLOAD;
our $lineCount = 20;

#------------------------------------------------------------------
sub new {
#------------------------------------------------------------------

=head2 ＤＢオープン [new]

webdb-param.plの内容でＤＢをオープンして
データベースハンドルを返す

=cut
	my $class = shift;
        my (
                $hostname,              #
                $driver,                # DBパラメータセット
                $database,              #  webdb-param.plにシステム固有
                $user,                  #  パラメータをセット
                $password) = initset ();

        my $dsn = _dsn_set(-driver=>$driver,
                        -database=>$database,
                        -host=>$hostname);
        my $self ;
        eval{
                $self->{'dbh'} = DBI->connect($dsn,$user,$password)
                                        or die $DBI::errstr;
		$self->{'dbh'}->do("set names utf8");
        };
        bless $self,$class;
	$self->{dbname} = $database;
	$self->{cons} = new myconstant;
        return  $self ;
}
sub _dsn_set{
        my %a = @_;
        if ($a{-driver} eq "mysql"){
                return "DBI:$a{-driver}:database=$a{-database};host=$a{-host}";
        }
        if ($a{-driver} eq "Pg"){
                return "DBI:$a{-driver}:dbname=$a{-database}";
        }
}

#sub AUTOLOAD {
#        my $self = shift;
#        $AUTOLOAD =~ s/^webdb:://;
#        return $self->{'dbh'}->$AUTOLOAD(@_);
#}
#------------------------------------------------------------------
sub random_str{
#------------------------------------------------------------------

=head2 ランダム文字列作成 [random_str]

=over 2

ランダムな文字列を作成する(WEB POWERのstdio.plより参照)

=item C<$text = ramdom_str(-length,-str)>

 -length: 作成文字数 デフォルト８文字
 -str: ランダム文字構成文字種 デフォルト(A..Z,a..z,0-9)
 $text: 作成文字列 $str内の文字を$length個の文字列を作成

=back

=cut 

	my $self = shift;
        my %arg = (-length =>8,
                        -str => (join '',('A'..'Z','a'..'z','0'..'9')),
                        @_);
        my @str = split //,$arg{'-str'};
        my $str = "";
        for(1 .. $arg{'-length'}){$str .= $str[int rand($#str+1)];}
        return $str;
}

#------------------------------------------------------------------
sub secure{
#------------------------------------------------------------------

=head2 セキュリティーチェック [secure]

=over 2

セキュリティーチェックを行う

=item secure($in)

 $in: CGI.pmのオブジェクト

=back

=cut

	my $self = shift;
	my $in = shift;
	my $id = $in->param('id') || $in->cookie('sessionID');
	my ($user,$ref) = $self->session_check(-id=>$id);
	$self->login() unless ($user);
	my $menu = $in->param('menu')||$in->cookie('menu');
	my $check;
	my $sql = qq{select m.flag,m.group_id from allow m,allow a
		where a.id = ? and m.id = ? and a.group_id = m.group_id};
	my $sth = $self->{dbh}->prepare($sql);
	$menu =~ m|([^/]*)$|;
	$check = $1 || $menu;
	$sth->execute($self->{ID},$check);
#	print "Content-Type:text/html\n\n";
#	print "[$sql][$user][$check]";
#	exit;
	my $ref;
	if($ref = $sth->fetchrow_hashref()){
	}else{	$self->login("menu.cgi?menu=$menu");
		exit;
	}
	$self->{GROUP} = $ref->{group_id};
	$sth->finish();
}
#------------------------------------------------------------------
sub session_check{
#------------------------------------------------------------------

=head2 セッションチェック [session_check]

=over 2

セッションＩＤでセッションテーブルを参照しユーザーＩＤを返す

=item $user_id = session_check(-id)

 -id: セッションチェックを行なうセッションＩＤ
 $user_id: セッションチェックＯＫの時ユーザーＩＤを返す

=back

=cut

	my $self = shift;
	my %a =@_;
	my ($user,$cnt,$boss,$ID);
	my $sth = $self->{'dbh'}->prepare(q{
		select userid from session where sessionid = ?
		});
	$sth->execute($a{-id});
	$sth->bind_col(1,\$ID);
	$sth->fetch;
#	$user = 'Guest' if($user eq '');
	if($ID =~ /^\D+(\d+)$/){
		$user = $1;
	}else{	$user = $ID;
	}	
#	$sth->finish;
	my $ref;
	$sth = $self->{'dbh'}->prepare(q{
		select id from user_tbl where userid = ?
		});
	$sth->execute($ID);
	while($ref = $sth->fetchrow_hashref()){
		if($ref->{id} != 0){$user = $ref->{id};}
	}
#
	$sth = $self->{dbh}->prepare(q{
		insert into accesslog
			 (user_id,remote_addr,user_agent,url,UPD_TIME)
			values (?,?,?,?,now())});
	$sth->execute($user||"Bad",$ENV{'REMOTE_ADDR'},
			substr($ENV{'HTTP_USER_AGENT'},0,60),
			$ENV{'REQUEST_URI'});
	$sth->finish;
#	$sth = $self->{dbh}->prepare(q{select * from 人事マスタ,user_tbl
#				where 氏名コード = ?
#				and curdate() between 適用開始日
#				  and subdate(NEXT適用日,interval 1 day)
#				and userid = ?});
#	$sth->execute($user,$ID);
#	my $ref = $sth->fetchrow_hashref(); 
	$self->{ID} = $ID;
	$self->{user} = $user+0;
	return $user,$ref;
}
#------------------------------------------------------------------
sub login{
#------------------------------------------------------------------

=head2 スタート画面 [login]

=over 2

ログイン画面へリダイレクトする

=item login($url)

 $url: リダイレクトすurl デフォルトlogin.cgi

=back

=cut
	my $self = shift;
	my $next = shift || "login.cgi";
	print "Location: ${next}\n\n";
	print <<END;
<head>
<meta http-equiv="refresh" content="0; url=$next">
</head>
<body>
</body>
</html>
END

}
#------------------------------------------------------------------
sub csv_split{
#------------------------------------------------------------------

=head2 csv形式の行を分割する [csv_split]

=over 2

=item @values csv_split($text)

=back

=cut

	my $s = shift;
	my $text = shift;
	$text =~ s/(?:\x0D\x0A|[\x0D\x0A])?$/,/;
  	return map {/^"(.*)"$/ ? scalar($_ = $1, s/""/"/g, $_) : $_}
                ($text =~ /("[^"]*(?:""[^"]*)*"|[^,]*),/g);
}
#------------------------------------------------------------------
sub z2h{
#------------------------------------------------------------------

=head2 euc -> 全角半角 変換 [z2h]

=over 2

euc -> 全角半角 変換

=item $sjis = z2h($euc)

 $euc: euc文字列
 $han: $euc文字列を半角に変換した文字列

=back

=cut
	my $self = shift;
        my $text = shift;
        #return encode("shiftjis",decode("euc-jp",$text));
        return jcode($text,"euc")->tr("Ａ-Ｚ０-９．／＋−","A-Z0-9./+-");
}	
#------------------------------------------------------------------
sub euc2sj{
#------------------------------------------------------------------

=head2 euc -> Shift_JIS 変換 [euc2sj]

=over 2

euc -> shift_JIS 変換

=item $sjis = euc2sj($euc)

 $euc: euc文字列
 $sjis: $euc文字列をShift_JISに変換した文字列

=back

=cut
	my $self = shift;
        my $text = shift;
        #return encode("shiftjis",decode("euc-jp",$text));
        return jcode($text,"euc")->sjis;
}	
#------------------------------------------------------------------
sub sj2euc{
#------------------------------------------------------------------

=head2 Shift_JIS -> euc 変換 [sj2euc]

=over 2

Shift_JIS -> euc 変換

=item $euc = sj2euc($sjis)

 $sjis: Shift_JIS文字列
 $euc: $sjis文字列をeucに変換した文字列

=back

=cut
	my $self = shift;
        my $text = shift;
        return jcode($text,"sjis")->euc;
#        return encode("euc-jp",decode("shiftjis",$text));
}
#------------------------------------------------------------------
sub utf2euc{
#------------------------------------------------------------------

=head2 utf -> euc 変換 [utf2euc]

=over 2

utf -> euc 変換

=item $euc = utf2euc($utf)

 $sjis: utf文字列
 $euc: $utf文字列をeucに変換した文字列

=back

=cut
	my $self = shift;
        my $text = shift;
        return jcode($text,"utf8")->euc;
#        return encode("euc-jp",decode("shiftjis",$text));
}
#------------------------------------------------------------------
sub euc2utf{
#------------------------------------------------------------------

	my $self = shift;
        my $text = shift;
        return jcode($text,"euc")->utf8;
}
#------------------------------------------------------------------
sub ucs2euc{
#------------------------------------------------------------------

=head2 unicode -> euc 変換 [ucs2euc]

=over 2

unicode -> euc 変換

=item $euc = ucs2euc($ucs)

 $ucs: unicode文字列
 $euc: $ucs文字列をeucに変換した文字列

=back

=cut
	my $self = shift;
        my $text = shift;
        return jcode($text,"ucs2")->euc;
#        return encode("euc-jp",decode("shiftjis",$text));
}
#------------------------------------------------------------------
sub euc2ucs{
#------------------------------------------------------------------

	my $self = shift;
        my $text = shift;
        return jcode($text,"euc")->ucs2;
}
#------------------------------------------------------------------
sub euc2jis{
#------------------------------------------------------------------

=head2 euc -> JIS 変換 [euc2jis]

=over 2

euc -> shift_JIS 変換

=item $sjis = euc2sj($euc)

 $euc: euc文字列
 $sjis: $euc文字列をJISに変換した文字列

=back

=cut
	my $self = shift;
        my $text = shift;
        return jcode($text,"euc")->jis;
}
#------------------------------------------------------------------
sub split_char{
#------------------------------------------------------------------
	my $s = shift;
	my $str = shift;
	my $ascii = '[\x00-\x7F]';
	my $twoBytes = '[\x8E\xA1-\xFE][\xA1-\xFE]';
	my $threeBytes = '\x8F[\xA1-\xFE][\xA1-\xFE]';
	my @chars = $str =~ /$ascii|$twoBytes|$threeBytes/go;
	return @chars;
}
#------------------------------------------------------------------
sub n2k{
#------------------------------------------------------------------

=head2 [0-9] -> [０-９]変換 [n2k]

=over 2

数字を漢字の数字に変換する。

=item $kanji = n2k($suuji)

 $kanji: 漢字に変換した数字
 $suuji: 変換元数字

=back

=cut
	my $self = shift;
	my $suuji = shift;
	my @kanji = qw(０ １ ２ ３ ４ ５ ６ ７ ８ ９);
	my $tmp = $suuji;
	$tmp =~ s/(\d)/$kanji[$1]/g;
	return $tmp;
}
#------------------------------------------------------------------
sub n2ks{
#------------------------------------------------------------------
	my $s = shift;
	my $n = shift;
	my $i=0;
	my @k = ('','','拾','百','千');
	my @N = qw(〇 壱 弐 参 四 五 六 七 八 九);
	my @ans = ();
	my $text;
	while($n){
		$i++;
		$a=$n%10;
		if($a){
			push @ans,$k[$i];
			push @ans,$N[$a];
		}elsif($i == 1 and $n%10000){push @ans,$k[$i];}
		if($k[$i] eq ''){$k[$i] = '萬';}
		elsif($k[$i] eq '萬'){$k[$i] = '億';}
		elsif($k[$i] eq '億'){$k[$i] = '兆';}
		$n = ($n-$a)/10;
		$i %= 4;
	}
	$text = join('',reverse @ans);
	return	$text;
}
#------------------------------------------------------------------
sub urlencode{
#------------------------------------------------------------------

=head2 URLエンコード [urlencode]

=over 2

text -> urlencode変換

=item $encodetext = urlencode($text)

 $textをurlエンコードして返す

=back

=cut
	my $self = shift;
	my $text = shift;
	$text =~ s/([^(\w|=|&)])/'%' . unpack('H2',$1)/eg;
	return $text;
}
#------------------------------------------------------------------
sub urlunencode{
#------------------------------------------------------------------

=head2 URLアンエンコード [urlunencode]

=over 2

text -> urlunencode変換

=item $unencodetext = urlunencode($text)

 $textをurlアンエンコードして返す

=back

=cut
	my $self = shift;
	my $text = shift;
	$text =~ s/%([0-9A-Fa-f][0-9A-Fa-f])/pack('H2',$1)/eg;
	return $text;
}
#------------------------------------------------------------------
sub date_supple{
#------------------------------------------------------------------
	my $s = shift;
	my $date = shift;
	my $flag = shift || 0;
	my @part = split(/\D+/,$date);
	my @sep = $date =~ /\d(\D+)\d/;
	my $sep = (@_ >= 1) ? shift : $sep[0];
	my ($y,$m,$d) = today();
	if(@part == 1){
		if($part[0] >=1000000){
			$part[2] = $part[0] % 100;
			$part[1] = ($part[0] - $part[2]) / 100 % 100;
			$part[0] = ($part[0] - $part[1] * 100 - $part[2]) / 10000;
		}else{
			$part[1] = $part[0] % 100;
			$part[0] = ($part[0] - $part[1]) / 100;
		}
	}
	if(@part == 2){
		if($part[0] >= 1900){
			$part[2] = ($flag == 0) ? 1 :$s->end_day("$part[0]/$part[1]");
		}elsif($part[0] % 100 >= 1 and $part[0] % 100 <= 12){
			$part[2] = $part[1];
			$part[1] = $part[0] % 100;
			$part[0] = ($part[0] - $part[1]) / 100;
		}
	}
	if(@part == 3){
		if($part[0] == 0 ){
			$part[0] += $y;
			if($part[1] < $m - 5){
				$part[0] += 1;
			}
		}elsif($part[0] < 100){
			$part[0] += 2000;
		}
		return sprintf("%4d$sep%02d$sep%02d",$part[0],$part[1],$part[2]);
	}
	return $date;
}
#------------------------------------------------------------------
sub chk_date{
#------------------------------------------------------------------

=head2 日付チェック [chk_date]

=over 2

入力日付の月が1から12で日が1から末日かチェックを行う。

=item $ret = chk_date($DATE)

 $DATE: 日付 YYYYMMDD or YYYY/MM/DD
 $ret: OK->1,NG->0

=back

=cut
	my $self = shift;
	my $date = shift;
	my @end = (31,28,31,30,31,30,31,31,30,31,30,31);
	$date =~ /^(\d{1,4})\D*(\d{1,2})\D*(\d{1,2})\D*/;
	my ($y,$m,$d) = ($1,$2,$3);
#	print "[$y][$m][$d]\n";
	$end[1] = 29 if($y % 400 == 0 or $y % 100 != 0 and $y %4 == 0);
	return 0 if($m < 1 or $m > 12);
	return 0 if($d < 1 or $d > $end[$m - 1]);
	return 1;
}
#------------------------------------------------------------------
sub end_day{
#------------------------------------------------------------------

=head2 末日算出 [end_day]

=over 2

入力年月から末日を計算する。

=item $day = end_day($DATE)

 $DATE: 日付 YYYYMM or YYYY/MM
 $day: $DATEの末日(28or29or30or31)

=back

=cut
	my $self = shift;
	my $yymm = shift;
	my @end = (31,28,31,30,31,30,31,31,30,31,30,31);
	$yymm =~ /^(\d{1,4})\D*(\d{1,2})$/;
	my ($y,$m) = ($1,$2);
	if($2 != 2){return $end[$m - 1];}
	if($y % 400 == 0 or $y % 100 != 0 and $y %4 == 0){
		return 29;
	}else{	return $end[$m - 1];}
}
#------------------------------------------------------------------------#
sub FromTo{
#------------------------------------------------------------------------#

=head2 １ヶ月算出 [FromTo]

=over 2

締め年月の開始日付と終了日付を算出する。

=item C<($start,$end) = FromTo('-years'=E<gt>YYYYMM,'-day'=E<gt>DD)>

 -years: 締め年月(YYYYMM) デフォルトシステム日付の年月
 -day: 締日（締め期間の初日） デフォルト(myconstant->{StartDD})
 $start: 該当年月の開始日付(YYYYMMDD)
 $end : 該当年月の終了日(YYYYMMDD)

=back

=cut 

	my $s = shift;
	my ($y,$m,$d) = today();
	my %x = ( -years => sprintf("%04d%02d%02d",$y,$m,$d),
			-day => $s->{cons}->{StartDD},
			@_);
	if($x{-years} =~ /^\d{4}\D?\d{2}$/){
		($y,$m,$d) = $s->ymd_split($x{-years} . "/01");
	}else{
		($y,$m,$d) = $s->ymd_split($x{-years});
		if($d >= $x{-day} and $x{-day} != 1){if(++$m > 12){$m=1;$y++;}}
	}
	if($x{-day} != 1){unless(--$m){--$y;$m=12}}
	my $start = sprintf("%04d%02d%02d",$y,$m,$x{-day});
	my $end = sprintf("%04d%02d%02d",$s->adddate($y,$m,$x{-day},
			(($s->end_day(sprintf("%04d%02d",$y,$m)) - 1))));
	return $start,$end;
}
#------------------------------------------------------------------------#
sub NendoFromTo{
#------------------------------------------------------------------------#

=head2 １ヶ年算出 [NendoFromTo]

=over 2

年度の開始日付と終了日付を算出する。

=item C<($start,$end) = FromTo('-years'=E<gt>YYYY)>

 -years: 年(YYYY)
 $start: 該当年度の開始日付(YYYYMMDD)
 $end : 該当年度の終了日(YYYYMMDD)

=back

=cut 

	my $s = shift;
	my ($y,$m,$d) = today();
	my ($ref,$sth);
	my $StartMD = $s->{cons}->{StartMD};
	my %x = ( -years => sprintf("%04d%02d%02d",$y,$m,$d),
			-day => $s->{cons}->{StartDD},
			@_);
	if($x{-simei}){
		$sth = $s->{dbh}->prepare("select * from 人事マスタ
			where 氏名コード = $x{-simei}
			and $x{-years} between 適用開始日 and
				subdate(NEXT適用日,interval 1 day)");
		$sth->execute();
		while($ref = $sth->fetchrow_hashref()){
			next if($ref->{'職務区分'} ne 'AL');
			($y,$m,$d) = $s->addmon($s->ymd_split(
					$ref->{'入社日'}),6);
			$StartMD = sprintf("%02d%02d",$m,$d);
		}
	}
	if($x{-years} !~ /^\d{4}$/){
		($y,$m,$d) = $s->ymd_split($x{-years});
		--$y if($m*100+$d < $StartMD);
		$x{-years} = $y;
	}
	my $start = $x{-years}*10000+$StartMD;
	($y,$m,$d) = $s->adddate($s->ymd_split($start+10000),-1);
	my $end = $y*10000+$m*100+$d;
	return $start,$end;
}

#------------------------------------------------------------------
sub date_format{
#------------------------------------------------------------------

=head2 日付編集 [date_format]

=over 2

年、月、日を9999/99/99に編集する。

=item $text = date_format($yy,$mm,$dd)

 年($yy)月($mm)日($dd)を受け取り "9999/99/99"に編集する
 年月日が与えられない時は、今日の日付を編集する

=back

=cut

	my ($yy,$mm,$dd,$dumy) = @_;
	($yy,$mm,$dd) = today() unless($dd);
	return sprintf("%04d/%02d/%02d",$yy,$mm,$dd);
}
#------------------------------------------------------------------
sub holiday{
#------------------------------------------------------------------

=head2 祝日計算 [holiday]

=over 2

祝日なら祝日の名前を返す

=item $name = holiday(-date=>YYYYMMDD)

 西暦年月日より祝日の判断を行う

=back

=cut

	my $s = shift;
	my %x = (
		1 => {1 => "元旦",},
		2 => {11 => "建国記念日",},
		4 => {29 => "みどりの日",},
		5 => {3 => "憲法記念日",
			5 => "こどもの日",},
		11 => {3 => "文化の日",
			23 => "勤労感謝の日",},
		12 => {23 => "天皇誕生日",},
		@_);
	my($y,$m,$d) = $s->ymd_split($x{-date});
	$m = $m+0;
	$d = $d+0;
	$x{1}{$s->get_w_day($y,1,2,1)} = "成人の日";
	$x{7}{$s->get_w_day($y,7,3,1)} = "海の日";
	$x{9}{$s->get_w_day($y,9,3,1)} = "敬老の日";
	$x{10}{$s->get_w_day($y,10,2,1)} = "体育の日";
	my ($vernal,$autumnal)=$s->get_equinox_day($y);
	$x{3}{$vernal} = "春分の日";
	$x{9}{$autumnal} = "秋分の日";
	my($yy,$mm,$dd) = $s->adddate($y,$m,$d,-1);
	if($s->getwday($yy,$mm,$dd) == 0 and defined $x{$mm}{$dd}){
		$x{$m}{$d} = "振替の休日";
	}
	if($s->getwday($yy,5,3) != 0){
		$x{5}{4} = "国民の休日";
	}
#	return \%x;
	return $x{$m}{$d};
}
#------------------------------------------------------------------
sub get_w_day{
#------------------------------------------------------------------

=head2 $y年$m月第$n曜日の日を返す [get_w_day]

=over 2

=item $d = get_w_day($y,$m,$n,$wday)

 $y: 年
 $m: 月
 $n: 第何曜日かを指定[1〜5]
 $n: 曜日 [0〜6] (0:日曜 1:月曜 2:火曜 3:水曜 4:木曜 5:金曜 6:土曜)
 $d: 対象の日付を返す 

=back

=cut

	my $s = shift;
	my ($y,$m,$n,$wday) = @_;
	my $st_wday = $s->getwday($y,$m,1);
	my $end_day = $s->end_day($y*100+$m);
	my $d;
	if($wday >= $st_wday){$n--;}
	$d = 7 * $n + $wday + 1 - $st_wday;
	if($d > $end_day or $d <= 0){$d = '';}
	return $d;
}
#------------------------------------------------------------------
sub get_equinox_day{
#------------------------------------------------------------------

=head2 春分の日と秋分の日を求める [get_equinox_day]

=over 2

 指定した年の春分日・秋分日をもとめる
（1980年から2099年に適用）
 ($vernal,$autumnal)=get_equinox_day($y);

=back

=cut

	my $s = shift;
	my ($yy)=@_;
	my ($vernal) = int(20.8431+0.242194*($yy-1980)-int(($yy-1980)/4));
	my ($autumnal)=int(23.2488+0.242194*($yy-1980)-int(($yy-1980)/4));

	return ($vernal,$autumnal);
}
#------------------------------------------------------------------
sub wareki{
#------------------------------------------------------------------

=head2 和暦変換 [wareki]

西暦日付を和暦(ＫＫ YY 年 MM 月 DD 日)に変換する。

 $text = $dbh->wareki(YYYYMMDD)

=cut

	my $s = shift;
	my $date = shift;
	my ($y,$m,$d) = $s->ymd_split($date);
	my $gen = [	['平成',1989,1,8],
			['昭和',1926,12,25],
			['大正',1212,7,30],
			['明治',1868,10,23]
		];
	for(0..$#{$gen}){
		if($y*10000+$m*100+$d >=
			$gen->[$_]->[1]*10000+
			$gen->[$_]->[2]*100+
			$gen->[$_]->[3]){
			return "$gen->[$_]->[0] ".
				($y - $gen->[$_]->[1] + 1) .
				" 年 $m 月 $d 日";
		}
	}
	return $date;
}
sub wareki2{
	my $s = shift;
	my $date = shift;
	my $text;
	my %nengou = (7=>'H',5=>'S',3=>'T',1=>'M');
	$date =~ /^(.)(..)(..)(.*)$/;
	$text = $nengou{$1}.$2.'/'.$3;
	if($4 ne ''){	$text .= '/'.$4;}
	return $text;
}
#------------------------------------------------------------------
sub time_format{
#------------------------------------------------------------------

=head2 時刻編集 [time_format]

=over 2

時、分、秒を99:99:99に編集する。

=item $text = time_format($hh,$mm,$ss)

 時($hh)分($mm)秒($ss)を受け取り "99:99:99"に編集する
 時分秒が与えられない時は、現在の時刻を編集する

=back

=cut

	my ($hh,$mm,$ss) = @_;
	($hh,$mm,$ss) = now() unless($ss);
	return sprintf("%02d:%02d:%02d",$hh,$mm,$ss);
}
#------------------------------------------------------------------
sub today{
#------------------------------------------------------------------

=head2 今日の日付 [today]

=over 2

今日の日付を返す

=item ($yy,$mm,$dd) = today();

=back

=cut

	my ($sec,$min,$hour,$mday,$mon,$year,$wday,$yday,$isdst) = localtime(time);
	return $year + 1900 ,$mon + 1,$mday;
}
#------------------------------------------------------------------
sub now{
#------------------------------------------------------------------

=head2 現在の時刻 [now]

=over 2

現在の時刻を返す

=item ($hh,$mm,$ss) = now();

=back

=cut

	my ($sec,$min,$hour,$mday,$mon,$year,$wday,$yday,$isdst) = localtime(time);
	return $hour,$min,$sec;
}
sub getwdayName{
  my $self = shift;
  return (qw(日 月 火 水 木 金 土))[$self->getwday(@_)];
}
sub getwday{
  my $self = shift;
  my($year, $mon, $mday) = @_;

  if ($mon == 1 or $mon == 2) {
    $year--;
    $mon += 12;
  }
  return int($year + int($year / 4) - int($year / 100) + int($year / 400)
      + int((13 * $mon + 8) / 5) + $mday) % 7;
}
sub addmon{
	my $self = shift;
	my ($y,$m,$d,$add) = @_;
	$m += $add;
	my $mod = int($m) % 12;
	$mod = 12 unless($mod);
	if($m <= 0){ $y = $y + int($m/12) - 1;
	}else{	$y = $y + int(($m - 1)/12);}
	return $y,$mod,$d;
}
sub adddate{
	my $self = shift;
	return mjd2date(date2mjd(shift,shift,shift) + shift);
}
sub date2mjd{
	my ($y,$m,$d) = @_;
	if($m <= 2){$y--;$m += 12;}
	return int($y*365.25)+int($y/400)-int($y/100)+int(($m-2)*30.59)+$d-678912;
}
sub diffdate{
	my $self = shift;
	my ($y,$m,$d) = $self->ymd_split(shift);
	my ($yy,$mm,$dd) = $self->ymd_split(shift);
	return date2mjd($y,$m,$d) - date2mjd($yy,$mm,$dd);
}
sub mjd2date{
	my $days = shift;
	$days += 678912;
	my $y = int($days/365.25);
	my $tmp;
	while(($tmp = $days-int($y*365.25)-int($y/400)+int($y/100))<30.59){
		$y--;
	}
	my $m = int($tmp / 30.59) + 2;
	my $d = $tmp - int(($m-2)*30.59);
	if($m > 12){$y++;$m-=12;}
	return $y,$m,$d;
}
#------------------------------------------------------------------
sub date_chk{
#------------------------------------------------------------------

=head2 日付チェック [date_chk]

=over 2

入力日付に年を補い月が1から12で日が1から末日かチェックを行う。

 年補正
  年２桁の時現在の年を補正し年を４桁にする。
  年０桁の時現在の年を補正する。但し現在が１２月で入力が１月の時は年＋１
                                    現在が１月で入力が１２月の時は年−１

=item $ret = date_chk($DATE)

 $DATE: 日付 YYYYMMDD or YYYY/MM/DD or MMDD or MM/DD
 $ret: OK->"YYYY-MM-DD", NG->0

=back

=cut
	my $self = shift;
	my $date = shift;
	my ($yy,$mm,$dd) = today();
	my $flag = 0;
	if($date =~ /^\d{1,2}\D+\d{1,2}$/){$date = "$yy/$date";$flag=1;}
	elsif($date =~ /^\d+$/ and $date < 10000){ $date += $yy*10000;$flag=1;}
	elsif($date =~ /^\d+$/ and $date < 1000000){
		$date += int($yy/100)*1000000;}
	$date =~ /^(\d{1,4})\D*(\d{1,2})\D*(\d{1,2})$/;
	my ($y1,$m1,$d1) = ($1+0,$2,$3);
	if ($y1 < 100){ $y1 += int($yy/100)*100;}
	if ($mm == 12 and $m1 == 1 and $flag == 1){$y1 += 1;}
	if ($mm == 1 and $m1 == 12 and $flag == 1){$y1 -= 1;}
	($yy,$mm,$dd) = $self->adddate($y1,$m1,$d1,0);
	if($yy == $y1 and $mm == $m1 and $dd == $d1){
		return sprintf("%d-%02d-%02d",$y1,$m1,$d1);
	}else{	return 0;
	}
}
#------------------------------------------------------------------
sub trim{
#------------------------------------------------------------------

=head2 後ろスペースＣＵＴ [trim]

=over 2

=item $text = trim($in_text)

 $in_text: 文字列
 $text: 後ろスペースをカットした文字列

=back

=cut
	my $self = shift;
	my $tmp = shift;
	$tmp =~ s/\s+$//;
	$tmp =~ s/(　)+$//;
	return $tmp;
}
#------------------------------------------------------------------
sub ltrim{
#------------------------------------------------------------------

=head2 前スペースＣＵＴ [ltrim]

=over 2

=item $text = trim($in_text)

 $in_text: 文字列
 $text: 前スペースをカットした文字列

=back

=cut
	my $self = shift;
	my $tmp = shift;
	$tmp =~ s/^\s+//;
	$tmp =~ s/^(　)+//;
	return $tmp;
}
#------------------------------------------------------------------------#
sub place3 {
#------------------------------------------------------------------------#

=head2 カンマ編集 [place3]

=over 2

=item $text = place3($in_data)

 $in_data: 数値
 $text: 入力数値を３桁づつカンマ編集した文字列

=back

=cut
	my $self = shift;
	my $tmp = shift;
	$tmp =~ s/\G((?:^[-+])?\d{1,3})(?=(?:\d\d\d)+(?!\d))/$1,/g;
	return $tmp;
}
#------------------------------------------------------------------------#
sub hasuu{
#------------------------------------------------------------------------#

=head2 端数処理 hasuu

=over 2

=item hasuu(-n=E<gt>数値,-a=E<gt>処理,-u=E<gt>単位)

 数値:端数処理する元の数値
 処理: 0:切り捨て 1:四捨五入 2:切上
 単位:端数処理する単位

=back

=cut
	my $s = shift;
	my %x = (-n=>0,-a=>1,-u=>1,@_);
	return '0' if($x{-n} eq '');
	$x{-u} = 1 unless($x{-u});
	my $h = 0.5;
	if($x{-a} == 0){$h = 0;
#	}elsif($x{-a} == 2){$h = 0.9999999;
	}elsif($x{-a} == 2){$h = 0;
	}else{$h = 0.5;}
	my $sin = 1;
	$sin = -1 if($x{-n} < 0);
	$x{-n2} = $x{-n} * $sin / $x{-u} + $h;
	$x{-n3} = $x{-n2};
	$x{-n2} =~ s/\.\d*//;
	if($x{-a} == 2 and $x{-n2} != $x{-n3}){$x{-n2} +=1;}
	$x{-n} = $x{-n2} * $sin * $x{-u};
	return $x{-n};
}
#------------------------------------------------------------------------#
sub www_spool{
#------------------------------------------------------------------------#

=head2 Webスプール [www_spool]

=over 2

=item www_spool(-cgi=E<gt>url,-param=E<gt>urlパラメータ)

 -cgi: url ページアドレス
 -param: cgiパラメータ

 webを実行し実行結果をspoolに記録する

=back

=cut
	my $s = shift;
	my %x = @_;
	my ($list,$head) = $s->www_load(-cgi=>"$x{-cgi}?$x{-param}");
	$s->{dbh}->do("set names ujis");
	my $sth = $s->{dbh}->prepare("insert into spool
			(帳票名,cgi,内容,head,作成者,作成日)
			values (?,?,?,?,?,now())");
	$sth->execute($x{-name},$x{-cgi},$list,$head,$s->{user});
}
#------------------------------------------------------------------------#
sub www_load{
#------------------------------------------------------------------------#

=head2 webを実行する [www_load]

=over 2

=item $text,$head = www_load(-cgi=E<gt>url,-host=E<gt>HostName)

 -cgi: 実行するurl+パラメータ
 -host: 実行するサーバー (default:myconstant->{host})
 $text: 実行結果
 $head: apacheヘッド情報

特定サーバーでwebを実行し処理結果(PAGE)を返す

http://tohoho.wakusei.ne.jp/wwwperl2.htm#socket より

=back

=cut
	my $s = shift;
	my %x = (-host => $s->{cons}->{host},
		-cgi => 'index.html',
		@_);
	my $addr = (gethostbyname($x{-host}))[4];
	my $name = pack("S n a4 x8",2,80,$addr);
	socket(S,2,1,0);		# socketの引数はＯＳにより
	#socket(S,2,2,0);		# 2,1,0 or 2,2,0 だったりする
	connect(S,$name);
#	binmode(S);
	$x{oldfh} = select(S);
	$| = 1;
	select $x{oldfh};
	print S "GET $x{-cgi} HTTP/1.0\n\n";
	my $txt ='';
	my $head = '';
	my $flag = 0;
	while(<S>){
		if($flag == 0){
			$head .= $_;
			if($_ =~ /Content-Type:/){
				$flag = 1;
			}
		}else{	$txt .= $_;
		}
	}
	close(S);
	return $txt,$head;
}
#------------------------------------------------------------------------#
sub backORnext{
#------------------------------------------------------------------------#

=head2 [前｜次]表示 [backORnext]

=over 2

=item $text = backORtext($in,$count,$offset)

 $in: CGIオブジェクト
 $count: 総データ件数
 $offset: 現在表示の先頭offsett
 $text: ナビゲーションリンク

=back

=cut
;#--pod End ------------------------------------------------------------#
	our ($in,$count,$offset) = @_;
	our $text = "";
	our $f_prev = 0;
	if($ENV{'HTTP_USER_AGENT'} =~ /UP\./){
		return ez_navi($in,$count,$offset);
	}elsif($ENV{'HTTP_USER_AGENT'} =~ /(DoCoMo|J-PHON)/){
		return i_navi($in,$count,$offset);
	}
        #前へ表示チェック
	if(0 <= ($offset - $webdb::lineCount)){
		$in->param('offset', ($offset - $webdb::lineCount));
		if($count > ($offset + $webdb::lineCount)){
			$text = webdb::euc2sj("［");
		}
		$text .= webdb::euc2sj("<a href=@{[$in->self_url()]}>前へ</a>");
		$f_prev = 1;
	}
	#次へ表示チェック
	if($count > ($offset + $webdb::lineCount))
	{
		if($f_prev == 1){
			$text .= webdb::euc2sj("｜");
		}
		$in->param('offset', ($offset += $webdb::lineCount));
		$text .= webdb::euc2sj("<a href=@{[$in->self_url()]}>次へ</a>");
		if($f_prev == 1){
			$text .= webdb::euc2sj("］");
		}
	}
	return $text;
}
sub i_navi{
	our ($in,$count,$offset) = @_;
	our $text = "";
	#前へ表示チェック
	if(0 <= ($offset - $webdb::lineCount)){
		$in->param('offset', ($offset - $webdb::lineCount));
		$text .= webdb::euc2sj("1.<a href=@{[$in->self_url()]} access_key=1>前へ</a>");
        }
	#次へ表示チェック
	if($count > ($offset + $webdb::lineCount)){
		$in->param('offset', ($offset += $webdb::lineCount));
		$text .= webdb::euc2sj("2.<a href=@{[$in->self_url()]} access_key=2>次へ</a>");
	}
	return $text;
}
sub ez_navi{
	our ($in,$count,$offset) = @_;
	our $text = "";
        #前へ表示チェック
	if(0 <= ($offset - $webdb::lineCount)){
		$in->param('offset', ($offset - $webdb::lineCount));
		$text .= webdb::euc2sj("<CE TASK=GO DEST=\"@{[$in->self_url()]}\" LABEL=\"前へ\">\n");
		$text .= webdb::euc2sj("[前へ]\n");
        }
	#次へ表示チェック
	if($count > ($offset + $webdb::lineCount)){
		$in->param('offset', ($offset += $webdb::lineCount));
		$text .= webdb::euc2sj("<CE TASK=GO DEST=\"@{[$in->self_url()]}\" LABEL=\"次へ\">\n");
		$text .= webdb::euc2sj("[次へ]\n");
		}

	return $text;
}
sub KI{
	my $s = shift;
	my ($y,$m,$d) = $s->ymd_split(shift);
	if($m < 4){ return ($y - 1970);}
	return ($y - 1969);
}
#------------------------------------------------------------------------#
#
#------------------------------------------------------------------------#

=head2 勤怠集計 [kintai]

=over 2

勤怠集計を行う

=item C<$ref = kintai(-code=E<gt>氏名コード,-start=E<gt>集計開始日,-end=E<gt>集計終了日)>

 -code: 氏名コード
 -start: 集計開始日　デフォルト(集計終了日より期首日付算出)
 -end: 集計終了日 デフォルト(今日)
 -ref: 集計データのハッシュのリファレンス
       $ref-E<gt>{'年休'}  --- 本年の年休数
       $ref-E<gt>{'使用'}  --- 期間内の年休使用数
       $ref-E<gt>{'欠勤'}  --- 期間内の欠勤数
       $ref-E<gt>{'無届'}  --- 期間内の無届数

=back

=cut 

sub kintai{
	my $self = shift;
	my %x = (@_);
	my ($y,$m,$d,$ref,$wst) ;
	if(!defined $x{-end}){
		$x{-end}= date_format();
	}
	($y,$m,$d) = $self->ymd_split($x{-end});
	$x{-end} = $y*10000+$m*100+$d;
	if(!defined $x{-start}){
		$x{-start} = $y*10000+$self->{cons}->{StartMD};
		$wst = 'non';
	}
	if($x{-start} > $x{-end}){
		$x{-start} -= 10000;
	}
	my ($st,$en,$yy,$mm,$dd);
	($st,$en) = $self->NendoFromTo(-years=>$x{-end});
	($yy,$mm,$dd) = $self->ymd_split($st);
	my $sql = qq{select 新規+ 繰越 as 年休
			,sum(if(集計区分=1,1,0)) as 使用
			,sum(if(集計区分=2,1,0)) as 欠勤
			,sum(if(集計区分=3,1,0)) as 無届
--			,sum(if(a.届コード=70,時間/100,0)) as 時間外
			,sum(if(a.届コード=70,
				mod(時間,100)+(時間-mod(時間,100))*60/100,0))
						as 時間外
--			,sum(if(a.届コード=71,時間/100,0)) as 休日時間
			,sum(if(a.届コード=71,
				mod(時間,100)+(時間-mod(時間,100))*60/100,0))
						as 休日時間
			,sum(if(a.届コード=71 or a.届コード = 74
				or a.届コード=75,1,0)) as 休日回数
--			,sum(if(a.届コード=73,時間/100,0)) as 深夜
			,sum(if(a.届コード=73,
				mod(時間,100)+(時間-mod(時間,100))*60/100,0))
						as 深夜
			,sum(if(a.届コード>=50 and a.届コード <= 58,1,0)) as
							遅早外回数
			,sum(if(a.届コード>=50 and a.届コード <= 58,時間,0)) as
							遅早外時間
			,sum(if(a.届コード=40 or a.届コード=41,1,0)) as 子護
			,sum(if(a.届コード=31,1,0)) as 己
			,sum(if(a.届コード=35,1,0)) as ボ
			,sum(if(a.届コード=21,1,0)) as 慶弔
			,sum(if(a.届コード=5,1,0)) as 特永
			,sum(if(a.届コード>=80,1,0)) as 半休
			,m.職務区分
			,m.継続雇用
			,m.年休新規,年休繰越
			,m.入社日
			,'0000-00-00' 有給付与日
		from 人事マスタ m
		left join 届データ a on
			(m.氏名コード = a.氏名コード
			and 届日 >= ?
			and 届日 <= ?
			and 届日 >= m.入社日)
		left join 届マスタ b on
			(a.届コード = b.届コード
			and	b.適用開始日 <= 届日
			and	b.NEXT適用日 > 届日)
		left join 有給付与履歴 c on
			(c.氏名コード = m.氏名コード
			and c.年度 = ?)
		where m.氏名コード = ?
		and $x{-end} between m.適用開始日
		  and subdate(m.NEXT適用日,interval 1 day)
		group by m.氏名コード};
	$self->{'sth'} = $self->{'dbh'}->prepare($sql);
	$st = $x{-start};$en=$x{-end};
	if($x{-alt} =~ /^[1-9]$/){
		($yy,$mm,$dd) = $self->adddate($self->ymd_split($st),-1);
		$en = sprintf("%04d%02d%02d",$yy,$mm,$dd);
		$st -= 10000;
	}
	$self->{'sth'}->execute($st,$en,$yy,$x{-code});
	$self->{'ref'} = $self->{'sth'}->fetchrow_hashref();
	$self->{ref}->{'AL年休'} = $self->{ref}->{'年休'};
	$self->{ref}->{'AL使用'} = $self->{ref}->{'使用'};
	$self->{ref}->{'AL欠勤'} = $self->{ref}->{'欠勤'};
	$self->{ref}->{'AL無届'} = $self->{ref}->{'無届'};
	$self->{ref}->{'AL遅早外回数'} = $self->{ref}->{'遅早外回数'};
	if($self->{ref}->{'職務区分'} eq 'AL'){
		if ($self->{ref}->{'継続雇用'} eq '0'){
			($y,$m,$d) = $self->addmon($self->ymd_split(
						$self->{ref}->{'入社日'}),6);
		}else{
			($y,$m,$d) = $self->ymd_split(
						$self->{ref}->{'入社日'});
		};
		($yy,$mm,$dd) = $self->ymd_split($x{-end});
		if($wst eq 'non'){
			$st = sprintf("%04d%02d%02d",$yy,$m,$d);
		}else{	$st = $x{-start};}
		if($self->diffdate($st,$x{-end}) > 0){$st -= 10000;}
		$en = $x{-end};
		if($x{-alt} =~ /^[1-9]$/){
			($yy,$mm,$dd) = $self->adddate(
					$self->ymd_split($st),-1);
			$en = sprintf("%04d%02d%02d",$yy,$mm,$dd);
			$st -= 10000;
		}
		$self->{'sth'}->execute($st,$en,$yy,$x{-code});
		$ref = $self->{'sth'}->fetchrow_hashref();
		$self->{ref}->{'AL年休'} =
				$ref->{'年休新規'}+$ref->{'年休繰越'};
		$self->{ref}->{'AL使用'} = $ref->{'使用'};
		$self->{ref}->{'AL欠勤'} = $ref->{'欠勤'};
		$self->{ref}->{'AL無届'} = $ref->{'無届'};
		$self->{ref}->{'AL遅早外回数'} = $ref->{'遅早外回数'};
		$self->{ref}->{'有給付与日'} = $st;

		($y,$m,$d) = $self->addmon($self->ymd_split(
					$self->{ref}->{'入社日'}),0);
#		$self->{'sth'}->execute(sprintf("%04d%02d%02d",$y,$m,$d)
#					,$en,$yy,$x{-code});
#		$ref = $self->{'sth'}->fetchrow_hashref();
#		$self->{ref}->{'AL欠勤'} = $ref->{'欠勤'};
	}
	$self->{'sth'}->finish();
	$self->{'ref'}->{'-start'} = $x{-start};
	$self->{'ref'}->{'-end'} = $x{-end};
	$self->{ref}->{'時間外'} = ($self->{ref}->{'時間外'} -
				$self->{ref}->{'時間外'} % 60) / 60 +
				($self->{ref}->{'時間外'} % 60) / 100; 
	$self->{ref}->{'休日時間'} = ($self->{ref}->{'休日時間'} -
				$self->{ref}->{'休日時間'} % 60) / 60 +
				($self->{ref}->{'休日時間'} % 60) / 100; 
	$self->{ref}->{'深夜'} = ($self->{ref}->{'深夜'} -
				$self->{ref}->{'深夜'} % 60) / 60 +
				($self->{ref}->{'深夜'} % 60) / 100; 
	return $self->{'ref'};
}

=head2 連続日付 [days]

=over 2

スタート日付からエンド日付までの全ての日付を返す

=item C<@days = days($start,$end)>

 $start: スタート日付
 $end: エンド日付
 @days: スタート日付からエンド日付までの全ての日付

=back

=cut 

sub days{
	my $dbh = shift;
	my $st = shift;
	my $en = shift;
	my @days;
	my ($y,$m,$d,$y1,$m1,$d1);
	$st = sprintf("%04d%02d%02d",$dbh->ymd_split($st));
	$en = sprintf("%04d%02d%02d",$dbh->ymd_split($en));
	$st = $en unless($dbh->chk_date($st));
	$en = $st unless($dbh->chk_date($en));
	if($st ge $en) { ($st,$en) = ($en,$st);}
	while($st le $en){
		push @days,$st;
		$st = sprintf("%04d%02d%02d",$dbh->adddate(
					$dbh->ymd_split($st),1));
	}
	return @days;
}
sub touki{
	my $s = shift;
	my %x = (@_);
	my ($y,$m,$d) = $s->ymd_split($x{-hiduke});
	my ($kisyu,$kimatu);
	if($m < 4){
		$kisyu = ($y - 1)*10000+401;
		$kimatu = $y*10000+331;
	}else{	$kisyu = $y*10000+401;
		$kimatu = ($y+1)*10000+331;
	}
	return $kisyu,$kimatu;
}
sub hanki{
	my $s = shift;
	my %x = (@_);
	my ($y,$m,$d) = $s->ymd_split($x{-hiduke});
	my ($kisyu,$kimatu);
	if($m < 4){$y--;$m=10;
	}elsif($m < 10){$m=4;
	}else{$m=10;}
	$kisyu = $y*100+$m;
	if($m == 4){$kimatu = $y*100+9;
	}else{$kimatu = ($y+1)*100+3;}
	return $kisyu,$kimatu;
}
sub splitKamok{
	my $s = shift;
	my $code = shift;
	$code =~ s/-//g;
	my ($ka,$bu,$yo);
	$ka = substr($code,0,3);
	$bu = substr($code,3,3)||' ';
	$yo = substr($code,6,2)||' ';
	return $ka,$bu,$yo;
}
sub syuttaikin_sql{
	my $self = shift;
	my $kinmu_col = "年月";
	for(1 .. 31){$kinmu_col .= ",勤務体制$_";}
        my $sql = qq{select m.氏名コード,m.氏名,m.所属コード,m.グループ,
				m.職務区分,m.資格コード,
				m.始業時間補正,m.終業時間補正,
                                e.所属名,m.年休新規+m.年休繰越 as 年休,
                                min(case when b.出退勤区分 = 1
                                                then b.出退勤時刻
                                                else NULL end) as 出勤,
                                max(case when b.出退勤区分 = 2
                                                then b.出退勤時刻
                                                else '' end) as 退勤,
                                max(case when d.出退勤区分 = 1
                                                then d.出退勤時刻
                                                else '' end) as 出勤2,
                                min(case when d.出退勤区分 = 2
                                                then d.出退勤時刻
                                                else NULL end) as 退勤2,
				max(d.出退勤日付) as 翌日,
                                b.出退勤区分,
                                b.出退勤日付,
                                $kinmu_col,
				e.集計コード１ as 集計コード１,
				ifnull(ff.出退勤時刻,
				  ifnull(fg.出退勤時刻,'99:99:99')) as in_time
                        from 人事マスタ as m
                                left join syukkin as b
                                        on (b.データ区分 = 31 and
                                                m.氏名コード = b.氏名コード)
                                left join syukkin as d
                                        on (d.データ区分 = 31 and
                                                d.出退勤日付 =
                                                adddate(b.出退勤日付,
                                                        interval 1 day) and
                                                m.氏名コード = d.氏名コード)
                                left join 勤務データ as a
                                        on (a.氏名コード = m.氏名コード and
                                        a.年月 =
                                        date_format(b.出退勤日付,"%Y%m"))
				left join syukkin as ff
					on (ff.データ区分 = 31
					and	m.氏名コード = ff.氏名コード
					and	ff.出退勤日付 =
							'$self->{kin}->{date}'
					and	ff.出退勤区分 = 1)
				left join syukkin as fg
					on (fg.データ区分 = 31
					and	m.氏名コード = fg.氏名コード
					and	fg.出退勤日付 =
						subdate('$self->{kin}->{date}',
							interval 1 day)
					and	fg.出退勤区分 = 1)
                                ,所属マスタ as e
                        where e.所属コード = m.所属コード and m.職務区分 <> 'SS'
			and curdate() between m.適用開始日
			  and subdate(m.NEXT適用日,interval 1 day)
			and curdate() between e.適用開始日
			  and subdate(e.NEXT適用日,interval 1 day)
			$self->{kin}->{where}
                        group by 集計コード１,m.所属コード,m.グループ,
                                m.氏名コード,b.出退勤日付
			$self->{kin}->{order}};
	return $sql;
}
sub today_syuttaikin_get{
	my $dbh = shift;
	$dbh->{kin}->{date} = shift;
	$dbh->{kin}->{date2} = shift;
	my ($sql,$sth,$ref);
	my ($sql2,$sth2,$ref2);
	my ($sql3,$sth3,$ref3);
	$sql = $dbh->syuttaikin_sql();
	$sth = $dbh->{dbh}->prepare($sql);
	$sth->execute();
	$sql2 = q{select m.*,a.届出名称,a.長期不在
			from 届データ as m,届マスタ as a
			where 氏名コード = ? and 届日 = ?
			and m.届コード = a.届コード
			and ? between 適用開始日
				and subdate(NEXT適用日,interval 1 day)};
	$sth2 = $dbh->{dbh}->prepare($sql2);
	$sql3 = q{select * from 勤務名称マスタ
			where 勤務コード = ?};
	$sth3 = $dbh->{dbh}->prepare($sql3);
	$dbh->{kin}->{sth} = $sth;
	$dbh->{kin}->{sth2} = $sth2;
	$dbh->{kin}->{sth3} = $sth3;
	return $dbh;
}
sub today_syuttaikin_next{
	my $dbh = shift;
	my ($ref,$ref3);
	my ($y,$m,$d,$d2);
	while($ref = $dbh->{kin}->{sth}->fetchrow_hashref()){
		($y,$m,$d) = $dbh->ymd_split($ref->{'出退勤日付'});
		$d=$d+0;
		$d2=$d-1;
		if($dbh->diffdate($ref->{'出退勤日付'},$dbh->date_format())
			== 0 and grep {$ref->{"勤務体制$d2"} eq $_} qw(3 4 E Q G K L N)){
				next;
		}
		next if($ref->{"勤務体制$d"} eq '' and $ref->{'出勤'} eq ''
				and $ref->{'退勤'} eq '');
		next if($ref->{"勤務体制$d"} eq '' and $ref->{'出勤'} eq ''
			and grep {$ref->{"勤務体制$d2"} eq $_} qw(3 4 E Q G K L N));
		$dbh->{kin}->{sth3}->execute($ref->{"勤務体制$d"});
		$ref3 = $dbh->{kin}->{sth3}->fetchrow_hashref();
#		if($ref->{'職務区分'} eq 'P7'){
#				$ref3->{'開始時間'} = 9.3;
#		}
#		if($ref->{'職務区分'} eq 'AL' and $ref->{"勤務体制$d"} eq 'H'){
#				$ref3->{'開始時間'} = 9.0;
#		}
		$ref3->{'開始時間'} = $dbh->add_time($ref3->{'開始時間'},
					$ref->{'始業時間補正'});
#
		if($ref->{'所属コード'} eq 123){
				$ref3->{'開始時間'} = 23.55;
		}
		next if($ref3->{'終了時間'} < $ref3->{'開始時間'} and
			$ref->{'出退勤日付'} eq $dbh->{kin}->{date});
		$dbh->{kin}->{kintai} = $dbh->kintai(
					-code=>$ref->{'氏名コード'}
			,-end=>$dbh->{kin}->{date});
		$ref->{'ref'} = $ref3;
		$ref->{'終了時間'} = $ref3->{'終了時間'};
		$ref->{'開始時間'} = $ref3->{'開始時間'};
		$dbh->{kin}->{sth3}->finish;
		$ref->{'dd'} = $d;
		last;
	}
	return $ref;
}
sub todoke{
	my $dbh = shift;
	my $sth = $dbh->{kin}->{sth2};
	my $ref = shift;
	my $ref3= $ref->{ref};
	my ($ref2,$tmp,$tmp2,$time,$H,$M);
	$H = int($ref3->{'開始時間'});
	$M = $ref3->{'開始時間'}*100%100;
	$time = sprintf("%02d:%02d:00",$H,$M);
	$dbh->{kekkin} = 0;
	$dbh->{tikoku} = 0;
	$dbh->{long} = 0;
	$dbh->{gogohan} = 0;
	my ($stha,$refa,$syukkinW,$syukkinW2);
	$stha = $dbh->{dbh}->prepare("select * from 出退勤データ where
			データ区分 = ? and 出退勤日付 = ? and
			氏名コード = ? and 出退勤区分 = 1
			order by 出退勤時刻");
	$stha->execute(31,$ref->{'出退勤日付'},$ref->{'氏名コード'});
	$syukkinW = '';
	$syukkinW2 = '';
	while($refa = $stha->fetchrow_hashref()){
		$syukkinW = $refa->{'出退勤時刻'};
		$stha->finish();
		last;
	}
	$tmp2 = '　　';
	$dbh->{kekkin} = 0;
	if($ref->{'出勤'} eq ''){$syukkinW2 = $ref->{'出勤'};
	}else{	$syukkinW2 = $syukkinW;}
	if($ref3->{'勤務コード'} ne '' and $time lt $syukkinW2){
		$tmp2 = "無届[".$ref3->{'勤務コード'}."]";
		$dbh->{kekkin} = 1;
		$dbh->{tikoku} = 1;
	}
	if($syukkinW eq '' and $ref3->{'勤務コード'} ne ''){
	  if($dbh->diffdate($ref->{'出退勤日付'},$dbh->{kin}->{date})==0){
		if($ref3->{'開始時間'} > 9.3){
		}else{	$tmp2 = "無届[".$ref3->{'勤務コード'}."]";
			$dbh->{kekkin} = 1;
		}
	  }else{
		if($dbh->diffdate($ref->{'出退勤日付'},$dbh->{kin}->{date2})
					< 0){
		  if($dbh->diffdate($ref->{'出退勤日付'},$dbh->{kin}->{date2})
					== -1 and $ref3->{'開始時間'} > 9.3){
			$tmp2 = "無届[".$ref3->{'勤務コード'}."]";
			$dbh->{kekkin} = 1;
		  }
		}else{
			$tmp2 = "無届[".$ref3->{'勤務コード'}."]";
			$dbh->{kekkin} = 1;
		}
	  }
	}
#		($ref3->{'開始時間'} ne '' and $ref->{'出勤'} eq '' and
#			$ref->{'退勤'} eq '')){
#		($syukkinW eq '' and $dbh->diffdate($ref->{'出退勤日付'},
#			$ref3->{'開始時間'} < 9.3 )){
#		$tmp2 = "無届[".$ref3->{'勤務コード'}."]";
#		$dbh->{kekkin} = 1;
#	  }else{  $tmp2 = "　　";
#	  }
#	}else{	$tmp2 = "　　";
#	}
	$sth->execute($ref->{'氏名コード'},$ref->{'出退勤日付'}
					,$ref->{'出退勤日付'});
	while($ref2 = $sth->fetchrow_hashref()){
		next if($ref2->{'届コード'} eq '73');
		next if($ref2->{'届コード'} eq '70');
#		$tmp .= $ref2->{'届出名称'}." ";
		$tmp .= $dbh->todoke_mei(-date=>$ref->{'出退勤日付'}
					,-simei=>$ref->{'氏名コード'}
					,-todoke=>$ref2->{'届コード'})->
			{'届出名称'}." ";
		unless(grep {$ref2->{'届コード'} eq $_} qw{70 73}){
			$tmp2 = "　　";
		}
#		unless(grep {$ref2->{'届コード'} eq $_} qw{11}){
#			$dbh->{tikoku} = 0;
#		}
		if($ref2->{'長期不在'} eq "1"){
			$dbh->{long} = 1;
		}
		if($ref2->{'届コード'} >= 80 and $ref2->{'時刻１'} == 2){
			$dbh->{gogohan} = 1;
		}
	}
#       $tmp2 = $ref3->{'開始時間'}."|".$ref->{'出勤'}."|".$ref->{'退勤'};
	return $tmp2,$tmp;
}

=head2 深夜時間計算 [sinya_time]

残業時間と出勤日より勤務データを参照し深夜残業時間を計算する

 $time = sinya_time(-date=>yyyymmdd,-simei=>氏名コード,-time=>残業時間,
			-kinmu=>'勤務コード')

=cut

sub sinya_time{
	my $s = shift;
	my %x = (@_);
	my $time = undef;
	my ($y,$m,$d) = $s->ymd_split($x{'-date'});
	$d = $d + 0;
	my ($sql,$sth,$ref);
	my $kinmu = "勤務体制$d";
	if($x{-kinmu}){				# これは交代制の休日出勤のはず
		$kinmu = "'$x{-kinmu}'";
		if($x{-kinmu} eq 'H'){
			$x{-time} = $s->add_time($x{-time},-8.00);
		}else{
			$x{-time} = $s->add_time($x{-time},-8.30);
		}
		if($x{-kinmu} == 4){$x{-time} =
				$s->add_time($x{-time},1.30);} # B2用の仮対応
		if($x{-kinmu} eq 'C'){$x{-time} =
				$s->add_time($x{-time},-16.3);} # α1用の仮対応
		if($x{-kinmu} == 3){$x{-time} =
				$s->add_time($x{-time},0.30);} # B1用の仮対応
		if($x{-kinmu} eq 'E'){$x{-time} =
				$s->add_time($x{-time},6.30);} # β1用の仮対応
		if($x{-kinmu} eq 'G'){$x{-time} =
				$s->add_time($x{-time},6.30);} # β1用の仮対応
		if($x{-kinmu} eq 'Q'){$x{-time} =
				$s->add_time($x{-time},8.00);} # β2用の仮対応
		if($x{-kinmu} eq 'L'){$x{-time} =
				$s->add_time($x{-time},7.00);} # β2用の仮対応
		if($x{-kinmu} eq 'N'){$x{-time} =
				$s->add_time($x{-time},8.00);} # β3用の仮対応
	}
	$sql = qq{select m.* from 勤務名称マスタ m,勤務データ
		where 氏名コード = ?
		and	年月 = ($y*100+$m)
		and	勤務コード = $kinmu};
	$sth = $s->{dbh}->prepare($sql);
	$sth->execute($x{-simei});
	while($ref = $sth->fetchrow_hashref()){
		last if($ref->{'深夜開始残業時間'} == 0 and
			$ref->{'深夜残業ＭＡＸ'} == 0);
		$time = $s->add_time($x{-time},$ref->{'深夜開始残業時間'}* -1);
		$time = 0 if($time < 0);
		$time = ($time > $ref->{'深夜残業ＭＡＸ'}) ?
				$ref->{'深夜残業ＭＡＸ'} : $time;
		last;
	}
	$sth->finish();
	return $time;
}

=head2 勤務体制GET [kinmu_get]

出勤日と氏名コードより勤務体制を返す

 $勤務体制 = kinmu_get(-date=>yyyymmdd,-simei=>氏名コード)

=cut

sub kinmu_get{
	my $s = shift;
	my %x = (@_);
	my $time = undef;
	my ($y,$m,$d) = $s->ymd_split($x{'-date'});
	$d = $d + 0;
	my ($sql,$sth,$ref);
	$sql = qq{select 勤務体制$d from 勤務データ
		where 氏名コード = ?
		and	年月 = ($y*100+$m)};
	$sth = $s->{dbh}->prepare($sql);
	$sth->execute($x{-simei});
	$ref = $sth->fetchrow_hashref();
	$sth->finish();
	return $ref->{"勤務体制$d"};
}

=head2 勤務名称GET [kinmuName]

勤務名称のハッシュを返す

 \%勤務名称 = kinmuName

=cut

sub kinmuName{
	my $s = shift;
	my %kinmu;
	my $sth = $s->{dbh}->prepare("select * from 勤務名称マスタ");
	$sth->execute();
	my $ref;
	while($ref = $sth->fetchrow_hashref()){
		$kinmu{$ref->{'勤務コード'}} = $ref->{'勤務名称'};
	}
	return \%kinmu;
}
sub kinmuNameAll{
	my $s = shift;
	my $kinmu;
	my $sth = $s->{dbh}->prepare("select * from 勤務名称マスタ");
	$sth->execute();
	my $ref;
	while($ref = $sth->fetchrow_hashref()){
		for (@{$sth->{'NAME'}}){
			$kinmu->{$ref->{'勤務コード'}}->{$_} = $ref->{$_};
		}
	}
	return $kinmu;
}

=head2 勤務体制GET [kinmus_get]

勤怠年月と氏名コードより勤務体制を返す

 \%勤務体制 = kinmu_get(-years=>yyyymm,-simei=>氏名コード)

 \%勤務体制: 日別の勤務体制 Key=年月日８桁

=cut

sub kinmus_get{
	my $s = shift;
	my %x = (-day => $s->{cons}->{StartDD},
			@_);
	my ($start,$end) = $s->FromTo(-years=>$x{'-years'},-day=>$x{-day});
	$start = $x{-start} if ($s->date_chk($x{-start}));
	$end = $x{-end} if ($s->date_chk($x{-end}));
	my @days = $s->days($start,$end);
	my ($y,$m,$d,%kinmus);
	my ($sql,$sth,$ref);
	for(@days){
		$kinmus{$_} = '';
	}
	$sql = qq{select * from 勤務データ
		where 氏名コード = ?
		and	年月 >= @{[int($start/100)]}
		and	年月 <= @{[int($end/100)]}};
	$sth = $s->{dbh}->prepare($sql);
	$sth->execute($x{-simei});
	while($ref = $sth->fetchrow_hashref()){
		for(@days){
			($y,$m,$d) = $s->ymd_split($_);
			$d = $d + 0;
			if($ref->{'年月'} == $y*100+$m){
				$kinmus{$_} = $ref->{"勤務体制$d"};
			}
		}
	}
	$sth->finish();
	return \%kinmus;
}

=head2 勤務体制GET [kinmus_get2]

勤怠年月と氏名コードより勤務体制を返す

 \%勤務体制 = kinmu_get2(-years=>yyyymm,-group=>グループ区分)

 \%勤務体制: 日別の勤務体制 Key=年月６桁

=cut

sub kinmus_get2{
	my $s = shift;
	my %x = (-day => $s->{cons}->{StartDD},
			@_);
	my ($start,$end) = $s->FromTo(-years=>$x{'-years'},-day=>$x{-day});
	$start = $x{-start} if ($s->date_chk($x{-start}));
	$end = $x{-end} if ($s->date_chk($x{-end}));
	my @days = $s->days($start,$end);
	my ($y,$m,$d,%kinmus);
	my ($sql,$sth,$ref);
	for(@days){
		$kinmus{$_} = '';
	}
	$sql = qq{select * from カレンダー
		where グループ区分 = ?
		and	年月 >= @{[int($start/100)]}
		and	年月 <= @{[int($end/100)]}};
	$sth = $s->{dbh}->prepare($sql);
	$sth->execute($x{-group});
	while($ref = $sth->fetchrow_hashref()){
		for(@days){
			($y,$m,$d) = $s->ymd_split($_);
			$d = $s->n2k($d + 0);
			if($ref->{'年月'} == $y*100+$m){
				$kinmus{$_} = $ref->{"$d"};
			}
		}
	}
	$sth->finish();
	return \%kinmus;
}

=head2 勤務区分GET [kinmu_get2]

出勤日とグループより勤務区分を返す

 $勤務区分 = kinmu_get2(-date=>yyyymmdd,-group=>グループ区分)

=cut

sub kinmu_get2{
	my $s = shift;
	my %x = (@_);
	my $time = undef;
	my ($y,$m,$d) = $s->ymd_split($x{'-date'});
	$d = $d + 0;
	my ($sql,$sth,$ref);
	$sql = qq{select * from カレンダー
		where グループ区分 = ?
		and	年月 = ($y*100+$m)};
	$sth = $s->{dbh}->prepare($sql);
	$sth->execute($x{-group});
	$ref = $sth->fetchrow_hashref();
	$sth->finish();
	return $ref->{$s->n2k($d)};
}

=head2 労務状況GET初期処理 [roumu_init]

労務状況を読み込み用のSQL文を作成する。
この後roumu_getにて個人別の労務状況を読み込む

 $sql = roumu_init(-end=>yyyymmdd)

 -end: 最終勤怠年月日
 $sql: 労務状況読込用のＳＱＬ文を返す

=cut

sub roumu_init{
	my $s = shift;
	my %x = (@_);
	my ($st,$en) = $s->NendoFromTo(-years=>$x{-end});
	my ($yy,$mm,$dd) = $s->ymd_split($st);
	my $sql = qq{select m.氏名コード as コード,m.氏名
		,資格コード as 資格
		,m.所属コード,a.所属名
		,新規 as 新規 ,繰越 as 繰越
		,新規+繰越 as 合計
		,性別
		,'' as 使用
		,'' as 使用率
		,'' as 育休
		,'' as 公休
		,'' as 欠勤
		,'' as 遅早外
		,'' as 所定日数
		,'' as 実稼働日数
		,'' as 実稼働時間
		,'' as 実稼働率
		,'' as 時間外
		,'' as 時間外率
		,'' as 延稼働時間
		,'' as 延稼働時間率
		,'' as 所定時間
		,'' as 残業
		,'' as 廃休
		,'' as 深夜
		,入社日
		,if(退職日 = 0,'9999-12-31',退職日) 退職日
		from 人事マスタ m
		left join 有給付与履歴 c on
			(c.氏名コード = m.氏名コード
			and c.年度 = $yy)
		,所属マスタ a
		where m.所属コード = a.所属コード
		and $x{-end} between m.適用開始日
		  and subdate(m.NEXT適用日,interval 1 day)
		and $x{-end} between a.適用開始日
		  and subdate(a.NEXT適用日,interval 1 day)
		and     入社日 <= $x{-end}
		and     (退職日 = '0000-00-00' or
			退職日 >= $x{-end})};
	my ($sth1,$ref1);
	$sth1 = $s->{dbh}->prepare("select * from 勤務名称マスタ");
	$sth1->execute();
	while($ref1 = $sth1->fetchrow_hashref()){
		$s->{w}->{time}->{$ref1->{'勤務コード'}} = $ref1->{'労働時間'};
	}
	return $sql;
}

=head2 労務状況GET [roumu_get]

労務状況を読み込み１人づつのデータのリファレンスを返す。

 $ref = roumu_get($sth,$yyyymm)

 $sth: roumu_initでのステートメントハンドルオブジェクト
 $yyyymm: 勤怠年月
 $ref: データ行のハッシュリファレンス

=cut

sub roumu_get{
	my $s = shift;
	my $sth = shift;
	my $years = shift;
	my $dd = shift;
	my $start = shift;
	my $end = shift;
	my $act1 = shift;
	if($dd < 1 or $dd >31){
		$dd = $s->{cons}->{StartDD};
	}
	my ($ref,$kinmus);
	my ($sth1,$ref1,$kekkin);
	while($ref = $sth->fetchrow_hashref()){
		$kinmus = $s->kinmus_get(
				-years=>$years,
				-simei=>$ref->{'コード'},
				-day=>$dd,
				-start=>$start,
				-end=>$end);
		$ref->{'所定時間'} = 0;
		$ref->{'実稼働日数'} = 0;
		$ref->{'実稼働率'} = 0;
		$ref->{'実稼働時間'} = 0;
		$ref->{'所定日数'} = 0;
		$ref->{'使用'} = 0;
		$ref->{'育休'} = 0;
		$ref->{'公休'} = 0;
		$ref->{'欠勤'} = 0;
		$ref->{'遅早外'} = 0;
		$ref->{'時間外'} = 0;
		$ref->{'残業'} = 0;
		$ref->{'廃休'} = 0;
		$ref->{'深夜'} = 0;
		$sth1= $s->{dbh}->prepare("
			select m.*,集計区分
				from 届データ m,届マスタ a
				where m.届コード = a.届コード
				and m.氏名コード = ?
				and 届日 = ?
				and 届日 between a.適用開始日
				  and subdate(a.NEXT適用日,interval 1 day)");
		my ($sth2,$ref2);
		$sth2 = $s->{dbh}->prepare("
			select 始業時間補正,終業時間補正 from 人事マスタ
				where 氏名コード = ?
				and ? between 適用開始日 and
					subdate(NEXT適用日,interval 1 day)");
		for(sort keys %{$kinmus}){
			$ref->{'所定日数'}++ if($kinmus->{$_} ne '' and
				$s->diffdate($_,$ref->{'入社日'}) >= 0 and
				$s->diffdate($_,$ref->{'退職日'}) <= 0);
			$sth1->execute($ref->{'コード'},$_);
			$sth2->execute($ref->{'コード'},$_);
			$kekkin = 0;
	       		while($ref1 = $sth1->fetchrow_hashref()){
      	 			 if($ref1->{'集計区分'} == 1 and
					($ref1->{'届コード'} != 30 or
					$act1 eq 'kin490')){
       					 $ref->{'使用'}++;
       					 $kekkin = 1;
				}
				if(grep {$ref1->{'届コード'} eq $_}
							qw(10 13 24)){
					$ref->{'育休'}++;
					$kekkin = 1;
				}
				if(grep {$ref1->{'届コード'} eq $_}
					qw(21 02 05 09 31 32 35 39 40)){
					$ref->{'公休'}++;
					$kekkin = 1;
				}
				if(grep {$ref1->{'届コード'} eq $_}
						qw(03 04 06 07 12 14 08 23 41)){
					$ref->{'欠勤'}++;
					$kekkin = 1;
				}
				if(grep {$ref1->{'届コード'} eq $_}
						qw(50 51 52 53 54 55 56 57 58)){
					$ref->{'遅早外'} += $ref1->{'時間'};
				}
				if(grep {$ref1->{'届コード'} eq $_}
						qw(70 71)){
#					$ref->{'時間外'} +=
#						$ref1->{'時間'} / 100;
					$ref->{'時間外'} =
						$s->add_time($ref->{'時間外'},
						$ref1->{'時間'} / 100);
				}
				if(grep {$ref1->{'届コード'} eq $_}
						qw(70)){
#					$ref->{'残業'} +=
#						$ref1->{'時間'} / 100;
					$ref->{'残業'} =
						$s->add_time($ref->{'残業'},
						$ref1->{'時間'} / 100);
				}
				if(grep {$ref1->{'届コード'} eq $_}
						qw(71)){
#					$ref->{'廃休'} +=
#						$ref1->{'時間'} / 100;
					$ref->{'廃休'} =
						$s->add_time($ref->{'廃休'},
						$ref1->{'時間'} / 100);
				}
				if(grep {$ref1->{'届コード'} eq $_}
						qw(73)){
#					$ref->{'深夜'} +=
#						$ref1->{'時間'} / 100;
					$ref->{'深夜'} =
						$s->add_time($ref->{'深夜'},
						$ref1->{'時間'} / 100);
				}
			}
	       		$ref2 = $sth2->fetchrow_hashref();
			if($s->diffdate($_,$ref->{'入社日'}) >= 0 and
				$s->diffdate($_,$ref->{'退職日'}) <= 0){
			 if ($kekkin == 0){
				$ref->{'実稼働時間'} +=
					$s->{w}->{time}->{$kinmus->{$_}};
				if($kinmus->{$_} ne ''){
				$ref->{'実稼働時間'} -= (
					$s->hm2m($ref2->{'始業時間補正'}) -
					$s->hm2m($ref2->{'終業時間補正'})) ;
				}
				$ref->{'実稼働日数'}++
					if($kinmus->{$_} ne '')
			 }
			 $ref->{'所定時間'} +=
					$s->{w}->{time}->{$kinmus->{$_}};
			 if($kinmus->{$_} ne ''){
				$ref->{'所定時間'} -= (
					$s->hm2m($ref2->{'始業時間補正'}) -
					$s->hm2m($ref2->{'終業時間補正'})) ;
			 }
			}
			$sth2->finish();
		}
		$ref->{'時間外'} = $s->hm2m($ref->{'時間外'});
		$ref->{'残業'} = $s->hm2m($ref->{'残業'});
		$ref->{'廃休'} = $s->hm2m($ref->{'廃休'});
		$ref->{'深夜'} = $s->hm2m($ref->{'深夜'});
		$ref->{'実稼働率'} = $ref->{'実稼働時間'} /
						$ref->{'所定時間'} * 100
			if($ref->{'所定時間'});
		$ref->{'延稼働時間'} = $ref->{'実稼働時間'}
				+ $ref->{'時間外'} * 1;
		$ref->{'延稼働時間率'} = $ref->{'延稼働時間'} /
						$ref->{'所定時間'} * 100
			if($ref->{'所定時間'});
		$ref->{'時間外率'} = $ref->{'時間外'} * 1 /
						$ref->{'所定時間'} * 100
			if($ref->{'所定時間'});
		$ref->{'実稼働時間'} = sprintf("%3d:%02d",
			int($ref->{'実稼働時間'} / 60),
			$ref->{'実稼働時間'} % 60);
		$ref->{'延稼働時間'} = sprintf("%3d:%02d",
			int($ref->{'延稼働時間'} / 60),
			$ref->{'延稼働時間'} % 60);
		$ref->{'使用率'} =
			sprintf("%3.1f",$ref->{'使用'} /
					$ref->{'合計'} * 100)
			if($ref->{'合計'});
		$ref->{'実稼働率'} =
			sprintf("%3.1f",$ref->{'実稼働率'});
		$ref->{'時間外'} =
			sprintf("%3.2f",$ref->{'時間外'});
		$ref->{'時間外率'} =
			sprintf("%3.1f",$ref->{'時間外率'});
		$ref->{'延稼働時間率'} =
			sprintf("%3.1f",$ref->{'延稼働時間率'});
		last;
	}
	return $ref;
}
sub todoke_check_del{
	my $dbh = shift;
	my %x = (-years => 299912,@_);
	my ($sql,$sth,$ref);
	my ($sql2,$sth2,$ref2);
	my ($count,$count2,$cnt);
	my ($StDD,$EnDD) = $dbh->FromTo('-years'=>$x{'-years'});
	$count = 0;
	$count2 = 0;
	$sql = qq{select m.* from 届データ as m
			where ((m.届コード < 50
				and m.届コード not in (11,16,17,18,19,20)) or
				m.届コード = 76)
				and 届日 >= $StDD
				and 届日 <= $EnDD
				and 氏名コード = '$x{-simei}'
			group by 氏名コード,届日};
	$sth = $dbh->{dbh}->prepare($sql);
	$sth->execute();
	$sql2 = qq{delete from 届データ where 氏名コード = ? and 届日 = ?
				and 届コード in (73) and 入力者 = 1};
	$sth2 = $dbh->{dbh}->prepare($sql2);
	while($ref = $sth->fetchrow_hashref()){
		$count++;
		$cnt = $sth2->execute($ref->{'氏名コード'},$ref->{'届日'});
		$count2 += $cnt;
#		$count2 .= "[$ref->{'氏名コード'},$ref->{'届日'},$cnt]";
	}
	return $count2;
}
sub melt{
	my $self = shift;
	my $new = shift;
	my $old = shift;
	my $data = shift;
	if($new eq $old){return '';}
	return $data;
}

sub expand{
	my $self = shift;
	my($y,$m,$d) = today();
	my $tmp;
	my %x = (seq => 0,level=>1,days=>0,volume=>1,code=>'',
			multi=>0,turn=>'正',nengetu=>$y*100+$m,
		sql=>qq{select '	      ' 機種,
				0000000 展開員数,
				00 展開手番,
				0 展開乗数,
				0 SEQ,
				1 LEVEL,
			ＰＮマスタ.*,
			a.親部品コード, a.子部品コード, a.選択, a.良品率,
			a.処理区分 as ps処理区分, a.実施年月 as 生産月,
			a.設通号数 as ps設通号数, a.員数, a.乗数,
			a.内外作 as psNG, a.ＳＣ組品, a.取扱, a.直送, a.工程,
			a.作業担当, a.伝票, a.納入場所,
			a.登録区分 as ps登録区分, a.手番
			from ＰＳマスタ a,ＰＮマスタ
			where PrmKey = ?
			and PrmNext = 部品コード
			and a.実施年月 <= ?
			order by 親部品コード,子部品コード,
				選択,実施年月 desc},
		@_);
	my ($key,$next);
	if($x{'turn'} eq '逆'){
		$key = '子部品コード';
		$next = '親部品コード';
	}else{	$key = '親部品コード';
		$next = '子部品コード';
	}
	$x{sql} =~ s/PrmKey/$key/g;
	$x{sql} =~ s/PrmNext/$next/g;
	$tmp = $x{sql};
	$tmp =~ s/\?/1/g;
	$self->{dbh}->do("create temporary table if not exists construct
				$tmp");	
	my $sth = $self->{'dbh'}->prepare($x{sql});
	$sth->execute($x{'code'},$x{'nengetu'});
	$x{'kisyu'} = $x{'code'} if($x{'level'} == 1);
	$x{NAME} = $sth->{NAME};
	my ($ref,$ret);
	my ($oya,$ko,$sentaku);
	while($ref = $sth->fetchrow_hashref()){
		next if($ref->{'親部品コード'} eq $oya and
			$ref->{'子部品コード'} eq $ko and
			$ref->{'選択'} eq $sentaku);
		$oya = $ref->{'親部品コード'};
		$ko = $ref->{'子部品コード'};
		$sentaku = $ref->{'選択'};
		next if($ref->{'ps処理区分'} eq 'D');
		$x{'seq'} += 1;
		$ref->{'機種'} = $x{'kisyu'};
		$ref->{SEQ} = $x{seq};
		$ref->{LEVEL} = $x{level};
		$ref->{'展開手番'} = $x{days}+$ref->{'手番'};
		$ref->{'展開員数'} = $x{volume}*$ref->{'員数'};
		$ref->{'展開乗数'} = 
				$self->compMulti($x{'multi'},$ref->{'乗数'});
		$self->tisel($ref,\%x);
		if($x{'type'} ne '単レベル'){
			$ret = $self->expand('code' => $ref->{$next},
				'level'=>$x{'level'}+1,seq=>$x{'seq'},
				'days' =>$x{'days'}+$ref->{'手番'},
				'volume' => $x{'volume'}*$ref->{'員数'},
				'multi' => 
				$self->compMulti($x{'multi'},$ref->{'乗数'}),
				'nengetu'=>$x{'nengetu'},
				'type'=>$x{'type'},
				'turn'=>$x{'turn'},
				'kisyu'=>$x{'kisyu'});
			$x{'seq'} = $ret->{'seq'};
		}
	}
	$sth->finish;
	return \%x;
}
sub tisel{
	my $self = shift;
	my $ref = shift;
	my @item;
	for(keys %{$ref}){
		push @item,"$_ = '$ref->{$_}'";
	}
	$self->{dbh}->do("insert construct set ". join(",",@item)); 
}
sub compMulti{
	my $self = shift;
	my @n = @_;
	my @k = qw(1 10 100 1000 10000 0.00001 0.0001 0.001 0.01 0.1);
	$n[2] = $k[$n[0]] * $k[$n[1]];
	for my $i(0..$#k){
		return $i if $n[2] == $k[$i];
	}
	return -1;
}

=head2 箱ＮＯ検索（注文番号） [serchHakoNo]

=over 2

=item $text = serchHakoNo('in'=>'検索注文番号','out'=>'箱ＮＯリターンエリア')

mytool.cgiにて保管累積ファイルの検索処理を行うパラメータを作成する

=back

=cut

sub serchHakoNo{
	my $self = shift;
	my %x = ( in =>'sub.word', out =>'form.hakoNo',
			submit =>'form.action[0]',@_);
	my $sub = $self->urlencode(q{select concat("<a href='close.cgi' onClick=\"window.opener.document.} .
		$x{'out'} . q{.value='",箱ＮＯ年*100000000+箱ＮＯ,"';} ..
		q{window.opener.document.} . $x{'out'} . q{.select();} .
		q{window.opener.document.} . $x{'submit'} . q{.click()\">"} .
		q{,部品コード,"</a>") as 部品コード,部品名称,保管種別,保管ＮＯ,保管枝番,納入場所,注文指示ＮＯ,入荷数量 from 保管累積ファイル where 注文指示ＮＯ >= '}) .
		qq{' + document.$x{'in'}.value + '} .
		$self->urlencode(q{' order by 注文指示ＮＯ limit 1000}) ;
	my $sub2 = qq{window.open('mytool.cgi?database=$self->{dbname}&exec_sql=exec_sql2&command=$sub} . 
		qq{','sublist','width=800,height=600,scrollbars=yes,statusbar=yes');document.} . $x{'out'} . qq{.select()};

	return $sub2;
}


=head2 箱ＮＯ検索（部品コード） [serchHakoNo2]

=over 2

=item $text = serchHakoNo2('in'=>'検索注文番号','out'=>'箱ＮＯリターンエリア')

mytool.cgiにて保管累積ファイルの検索処理を行うパラメータを作成する

=back

=cut

sub serchHakoNo2{
	my $self = shift;
	my %x = ( in =>'sub.word', out =>'form.hakoNo',
			submit =>'form.action[0]',@_);
	my $sub = $self->urlencode(q{select 部品コード as 部品,concat("<a href='close.cgi' onClick=\"window.opener.document.} .
		$x{'out'} . q{.value='",箱ＮＯ年*100000000+箱ＮＯ,"';} ..
		q{window.opener.document.} . $x{'out'} . q{.select();} .
		q{window.opener.document.} . $x{'submit'} . q{.click()\">"} .
		q{,箱ＮＯ年*100000000+箱ＮＯ,"</a>") as 箱ＮＯ,部品名称,case 保管種別 when 1 then 'パレット' when 2 then '棚' else 保管種別 end as 保管種別,保管ＮＯ,保管枝番 as 枝番,納入場所,入荷数量,注文指示ＮＯ from 保管累積ファイル where 部品コード like '}) .
		qq{' + document.$x{'in'}.value + '%' + '} .
		$self->urlencode(q{' and 入荷数量 <> 出荷数量 order by 部品コード,注文指示ＮＯ limit 1000}) ;
	my $sub2 = qq{window.open('mytool.cgi?database=$self->{dbname}&exec_sql=exec_sql2&command=$sub} . 
		qq{','sublist','width=800,height=600,scrollbars=yes,statusbar=yes');document.} . $x{'out'} . qq{.select()};

	return $sub2;
}

=head2 ＰＮ検索 [serchPN]

=over 2

=item $text = serchPN('in'=>'部品コード','out'=>'部品コードリターンエリア')

mytool.cgiにてＰＮマスタの検索処理を行うパラメータを作成する

=back

=cut

sub serchPN{
	my $self = shift;
	my %x = ( in =>'sub.word', out =>'form.code',
			submit =>'form.action[0]',@_);
	my $sub = $self->urlencode(q{select concat("<a href='close.cgi' onClick=\"window.opener.document.} .
		$x{'out'} . q{.value='",部品コード,"';} .
		q{window.opener.document.} . $x{'out'} . q{.select();} .
		q{window.opener.document.} . $x{'submit'} . q{.click()\">"} .
		q{,部品コード,"</a>") as 部品コード,部品名称 from ＰＮマスタ where 部品コード like '}) .
		qq{' + document.$x{'in'}.value + '%} .
		$self->urlencode(q{' order by 部品コード limit 1000}) ;
	my $sub2 = qq{window.open('mytool.cgi?database=$self->{dbname}&exec_sql=exec_sql2&command=$sub} . 
		qq{','sublist','width=400,height=600,scrollbars=yes,statusbar=yes');document.} . $x{'out'} . qq{.select()};

	return $sub2;
}

=head2 保管累積検索 [serchHokan]

=over 2

=item $text = serchPN('in'=>'部品コード','out'=>'部品コードリターンエリア')

mytool.cgiにて保管累積の検索処理を行うパラメータを作成する

=back

=cut

sub serchHokan{
	my $self = shift;
	my %x = ( in =>'sub.word', out =>'form.code',
			submit =>'form.action[0]',@_);
	my $sub = $self->urlencode(q{select concat("<a href='close.cgi' onClick=\"window.opener.document.} .
		$x{'out'} . q{.value='",部品コード,"';} .
		q{window.opener.document.} . $x{'out'} . q{.select();} .
		q{window.opener.document.} . $x{'submit'} . q{.click()\">"} .
		q{,部品コード,"</a>") as 部品コード,部品名称,sum(入荷数量-出荷数量) as 在庫数,count(*) as 件数 from 保管累積ファイル where 部品コード like '}) .
		qq{' + document.$x{'in'}.value + '%} .
		$self->urlencode(q{' and 入荷数量 <> 出荷数量 group by 部品コード limit 1000}) ;
	my $sub2 = qq{window.open('mytool.cgi?database=$self->{dbname}&exec_sql=exec_sql2&command=$sub} . 
		qq{','sublist','width=400,height=600,scrollbars=yes,statusbar=yes');document.} . $x{'out'} . qq{.select()};

	return $sub2;
}

sub hokannsyu{
	my $self = shift;
	my $tmp = shift;
	if($tmp eq '1'){$tmp = 'パレット';
	}elsif($tmp eq '2'){$tmp = '棚';
	}
	return $tmp;
}
sub serch_app001{
	my $s = shift;
	my %x = (in=>'sub.word',out=>'form.code',submit=>'form.action',@_);

	my $sub = $s->urlencode(q{select
		concat("<a href='close.cgi' onClick=} .
		q{\"window.opener.document.} . $x{out} .
		q{.value='",品番,"';} .
		q{window.opener.document.} . "form.hinnmei$x{no}" .
		q{.value='",品名,"';} .
		q{window.opener.document.} . "form.tanni$x{no}" .
		q{.value='",単位,"';} .
		q{window.opener.document.} . "form.teika$x{no}" .
		q{.value='",定価,"';} .
		q{window.opener.document.} . "form.tannka$x{no}" .
		q{.value='",購入単価,"';} .
		q{window.opener.document.} . "form.gyousya$x{no}" .
		q{.value='",業者名,"';} .
		q{window.opener.document.} . $x{out} . q{.select();} .
		q{\">",申請日,"</a>") as 申請日,品番,品名,定価,購入単価
			from 購入申請明細 m,申請 a
			where m.申請SEQ = a.SEQ_NO
			and 申請者 = } . $s->{user} . q{ order by 品名,申請日});

	my $sub2 = qq{window.open('mytool.cgi?database=$s->{dbname}&exec_sql=exec_sql2&command=$sub} .
		qq{','sublist','width=600,height=600,scrollbars=yes,statusbar=yes');document.} . $x{out} . qq{.select()};
	return $sub2;
}

=head2 ラベル発行呼び出しJavaScript作成 [label]

=over 2

=item $JavaScript = label(発行箱ＮＯ)

ラベル発行(buhin050l.cgi)呼び出し用のJavaScriptを作成。複数のラベルを出力する
時は各発行ＮＯを","で区切って呼び出す事。label("00000001,00000002,0000003")

=back

=cut

sub label{
	my $self = shift;
	my $no = shift;
	my $tmp = qq{window.open('buhin050l.cgi?no=} . $no .
		qq{','label','width=500,height=300')};
	return $tmp;
}

=head2 メニューリンク作成 [menu]

=cut

sub menu{
	my $self = shift;
	my $menu = CGI::cookie('menu') ||'menu/def.menu';
	my $tmp = "<a href=\"menu.cgi?menu=$menu\" target=\"_top\">メニュー</a>".
		" <a href=\"close.cgi\" target=\"_top\">終了</a>";
	return $tmp;
}

=head2 ＰＤＦモニター作成 [pdfmon]

=cut

sub pdfmon{
	my $self = shift;
	my $tmp = <<END;
window.open('pdfmon.cgi','pdfmon','widtf=300,height=200');
END
	return $tmp;
}

=head2 DOCTYPEをカット [cutDOCTYPE]

CGI.pmが出力する<!DOCTYPE . . . . >をカットする。JavaScript(tableheadlay.js)
が動かなくなる為の対応。もっと良い方法は無いものか？

=cut

sub cutDOCTYPE{
	my $self = shift;
	my $tmp = shift;
	$tmp =~ s|<!DOCTYPE html||;
	$tmp =~ s|.*PUBLIC.*\n||;
	$tmp =~ s|.*dtd.*>\n||;
	return $tmp;
}

=head2 伝票区分名取得 [denku]

伝票区分名を返す

=cut

sub denku{
	my $self =shift;
	my $den = shift;
	my %denku = (
		11=>'不良入庫',
		12=>'納品',
		13=>'SC納品B',
		14=>'SC差引B',
		15=>'依頼返品',
		17=>'ｶﾞｲﾉｳ-B',
		18=>'(移動)',
		22=>'差引B',
		23=>'振替伝票',
		24=>'出庫依頼',
		26=>'出庫B',
		28=>'不良出庫',
		35=>'戻入',
		41=>'有償B'
		);
	return $denku{$den};
}

=head2 通勤手段取得 [tuukin]

通勤手段名を返す

=cut

sub tuukin {
	my $self = shift;
	my $syudan = shift;
	my %tuukin = (1=>'普通',2=>'軽',3=>'単車',4=>'自転車５ｋ以下'
			,5=>'自転車５ｋ以上');
	if($syudan eq '_list'){
		return \%tuukin;
	}else{	return $tuukin{$syudan};
	}
}

=head2 購入理由取得 [kriyu]

購入理由名を返す

=cut

sub kriyu {
	my $self = shift;
	my $kryu = shift;
	my %ryu = qw(2 F 4 S);
	return $ryu{$kryu};
}

=head2 日付分解 [ymd_split]

日付らしき文字列を年月日に分解する。

 ($y,$m,$d) = ymd_split("YYYY/MM/DD")
 日付: YYYYMMDD or ZZZ9/Z9/Z9
 $y: 年
 $m: 月
 $d: 日

=cut

#------------------------------------------------------------------------#
sub ymd_split{
#------------------------------------------------------------------------#

=head2 日付分解 [ymd_split]

日付らしき文字列を年、月、日に分解する

 ($y,$m,$d) = ymd_split("YYYY-MM-DD");

=cut

	my $shift = shift;
	my $tmp = shift;
	$tmp =~ /\D*(\d{1,4})\D*(\d{1,2})\D*(\d{1,2})\D*/;
	return $1,$2,$3;
}

sub cal_disp{
	my $self = shift;
	my %x = (name=>'day',@_);
	my ($y,$m,$d,$i,$j,$k,$tmp,$tmp2);
	my (@head,@item,@lineH,@lineI);
	my $start = sprintf("%04d%02d%02d",$x{y},$x{m},$x{d});
	my $mon = sprintf("%04d%02d",$x{y},$x{m});
	for $i (0..$self->end_day($mon) - 1){
		($y,$m,$d) = $self->adddate($self->ymd_split($start),$i);
		$tmp = sprintf("%04d%02d%02d",$y,$m,$d);
		if($x{simei} ne ''){
			$tmp2 = $self->kinmu_get(-date=>$tmp,
				-simei=>$x{simei});
		}else{
			$tmp2 = '';
		}
		push @head,"$d";
		push @item,$tmp2 .
			$x{in}->textfield(-name=>"$x{name}$tmp",-size=>4,
				-maxlength=>5,
				-onFocus=>'document.form.next.value="'.
					"$x{name}$tmp".'"');
			$x{in}->param("$x{name}${tmp}kinmu",$tmp2);
	}
	print "<table border=1>\n";
	print Tr(td([qw(日 月 火 水 木 金 土)])),"\n";
	$j = $self->getwday($self->ymd_split($start));
	for(0..6){
		if($_ < $j){
			push @lineH,undef;
			push @lineI,undef;
		}else{	$i = $_ - $j;
			push @lineH,$head[$i];
			push @lineI,$item[$i];
		}
	}
	print Tr(th([@lineH])),"\n";
	print Tr(td([@lineI])),"\n";
	while($i<$#head){
		$j=$i+1;$k=$i+7;
		print Tr(th([@head[$j..$k],])),"\n";
		print Tr(td([@item[$j..$k],])),"\n";
		$i += 7;
	}
	print "</table>\n";
}

=head2 カレンダー表示 [cal_disp_2]

１月分の日別データをカレンダーの形に表示する

 cal_disp_2(y=>yyyy,m=>mm,d=>dd,data=>[\%data,.,..])
 
 y,m,d: カレンダー表示する初日
 data: 日別のデータのハッシュの配列
       ハッシュのＫｅｙは年月日８桁、配列分の行を表示する。
       ハッシュのｋｅｙ='labal'にデータ名称をセット

 曜日  日  月  火  水  木  金  土
	               16  17  18
 ＫＫ	          XX      XX
 ＫＫ	          XX
       19  20  21  22  23  24  25
 ＫＫ      XX
 ＫＫ	              XX
       26  27  28  29  30  31   1
 ＫＫ
 ＫＫ
	2   3   4   5   6   7   8
 ＫＫ
 ＫＫ
	9  10  11  12  13  14  15
 ＫＫ      XX	          XX
 ＫＫ  XX  XX XXX   X  XX  XX

=cut

sub cal_disp_2{
	my $self = shift;
	my %x = (@_);
	my ($y,$m,$d,$i,$j,$k,$tmp,$tmp2);
	my (%head,@item,@days,@lineH);
	my $start = sprintf("%04d%02d%02d",$x{y},$x{m},$x{d});
	my $mon = sprintf("%04d%02d",$x{y},$x{m});
	for $i (0..$self->end_day($mon) - 1){
		($y,$m,$d) = $self->adddate($self->ymd_split($start),$i);
		$head{$y*10000+$m*100+$d} = $d;
		push @days,$y*10000+$m*100+$d;
	}
	print "<table border=1>\n";
	print Tr(td([qw(曜日 日 月 火 水 木 金 土)])),"\n";
	$j = $self->getwday($self->ymd_split($start));
	print Tr(th(['',$self->daydataget(\@days,\%head,0-$j,6-$j)]));
	for(@{$x{data}}){
		print Tr(td([$_->{label},$self->daydataget(\@days,$_,0-$j,6-$j)]));
	}
	$i=6-$j;
	while($i<$#days){
		$j=$i+1;$k=$i+7;
		print Tr(th(['',$self->daydataget(\@days,\%head,$j,$k)])),"\n";
		for(@{$x{data}}){
			print Tr(td([$_->{label},
				$self->daydataget(\@days,$_,$j,$k)])),"\n";
		}
		$i += 7;
	}
	print "</table>\n";
}

=head2 日別データ編集 [daydataget]

日別のデータを配列に編集する

 @data = daydataget(\@days,\%data,$start,$end)

 @days: 日付の配列（日別データのＫｅｙ）
 %data: 日別のデータ
 $start: 日付配列の初日の添え字
 $end: 日付配列の終了日の添え字
 @data: 初日から終了日の日別データの配列

=cut

sub daydataget{
	my $s = shift;
	my $arry = shift,
	my $hash = shift,
	my $j = shift;
	my $k = shift;
	my @data;
	for($j .. $k){
		if($_ < 0){
			push @data,undef;
		}else{	push @data,$hash->{$arry->[$_]};
		}
	}
	return @data;
}
sub kintai_jikan_format{
	my $self = shift;
	my $time = shift;
	my $kubun = shift;
	if($kubun eq 'H'){
		return $time / 100 . $kubun;
	}else{	return $time . $kubun;
	}
}
#------------------------------------------------------------------------#
sub koujo_comp{
#------------------------------------------------------------------------#

=head2 控除時間計算 [koujo_comp]

遅刻、早退時刻より普通控除時間と深夜控除時間を計算する。

 $ref = koujo_comp(-simei=>氏名コード,-date=>対象日付,-jiyuu=>事由,
		-time=>出社又は退社時刻(hh.mm))
 $ref = 勤務名称リファレンス+控除+深夜

=cut

	my $s = shift;
	my %x = (-simei=>0,-date=>0,-jiyuu=>0,-time=>0,-etime=>3,@_);
	my ($sth,$ref,$s1,$s2,$han);
	$sth = $s->{dbh}->prepare("select a.*,'' 控除,0 深夜,
					b.始業時間補正,b.終業時間補正 from
				勤務名称マスタ a,
				人事マスタ b
			where 勤務コード = ?
			and 氏名コード = ?
			and ? between b.適用開始日
			  and subdate(b.NEXT適用日,interval 1 day)");
	$sth->execute($s->kinmu_get(-date=>$x{-date},-simei=>$x{-simei}),
					$x{-simei},$x{-date});
	$ref = $sth->fetchrow_hashref();
	$ref->{'開始時間'} = $s->add_time($ref->{'開始時間'},
					$ref->{'始業時間補正'});
	$ref->{'終了時間'} = $s->add_time($ref->{'終了時間'},
					$ref->{'終業時間補正'});
	if(grep {$x{-jiyuu} == $_} qw(50 51 52)){
		$s->tikoku_koujo($ref,$x{-time});
		if($x{-time} > 22 or $x{-time} < 5){
			$s1 = $ref->{'終了時間'};$s2 = $ref->{'控除'};
			$ref->{'終了時間'} = 5 if($ref->{'終了時間'} > 5);
			$s->soutai_koujo($ref,$x{-time});
			$ref->{'深夜'} = $ref->{'控除'};
			if($ref->{'勤務コード'} eq 4){$ref->{'深夜'} += 10;}
			$ref->{'終了時間'} = $s1;$ref->{'控除'} = $s2;
		}elsif($x{-time} >= 5 and  $x{-time} <= 7){
			$ref->{'深夜'} = 0;
		}elsif($x{-time} <= 22 and $ref->{'深夜時間'} != 0){
			$ref->{'深夜'} = $s->hm2m($ref->{'深夜時間'});
		}
	}elsif(grep {$x{-jiyuu} == $_} qw(53 54 55)){
		$s->soutai_koujo($ref,$x{-time});
		if($x{-time} > 22 or $x{-time} < 5){
			$s1 = $ref->{'開始時間'};$s2 = $ref->{'控除'};
			$ref->{'開始時間'} = 22;
			$s->tikoku_koujo($ref,$x{-time});
			$ref->{'深夜'} = $ref->{'控除'};
			$ref->{'開始時間'} = $s1;$ref->{'控除'} = $s2;
		}
	}elsif(grep {$x{-jiyuu} == $_}
			qw(80 81 82 91 92 93 94 95 96 97 98 99 100 101 102 103 104 105 106 107 108 109 110 111 112 113 114 115 116 117 118 119 120 121 122) and
		$ref->{'深夜時間'} != 0){
		$han = $ref->{'昼休憩開始時間'};
		if($ref->{'勤務コード'} eq 'E'){ $han = 3.35;}
		if($x{-etime} == 1){
			$s1 = $ref->{'終了時間'};$s2 = $ref->{'控除'};
			$ref->{'終了時間'} = 5 if($ref->{'終了時間'} > 5);
			$s->soutai_koujo($ref,$han);
			$ref->{'深夜'} = $ref->{'控除'};
			$ref->{'終了時間'} = $s1;$ref->{'控除'} = $s2;
		}elsif($x{-etime} == 2){
			$s1 = $ref->{'開始時間'};$s2 = $ref->{'控除'};
			$ref->{'開始時間'} = 22;
			$s->tikoku_koujo($ref,$han);
			$ref->{'深夜'} = $ref->{'控除'};
			$ref->{'開始時間'} = $s1;$ref->{'控除'} = $s2;
		}
	}
	return $ref;
}
#------------------------------------------------------------------------#
sub tikoku_koujo{
#------------------------------------------------------------------------#

=head2 遅刻控除時間計算 [tikoku_koujo]

出社時刻より遅刻控除時間を計算し勤務名称リファレンス->{'控除'}に
控除時間（分数）をセットする

 tikoku_koujo(勤務名称リファレンス,出社時間(HH.MM))

=cut

	my $s = shift;
	my $ref = shift;
	my $time = shift;
	$ref->{'控除'} = $s->time_diff($time,$ref->{'開始時間'});
#深夜計算用補正(B1用)
	if($s->time_diff($ref->{'休憩１開始時間'},$ref->{'開始時間'}) < 0){
		$ref->{'休憩１開始時間'} = $ref->{'開始時間'};
	}
	if($s->time_diff($ref->{'休憩１終了時間'},$ref->{'開始時間'}) < 0){
		$ref->{'休憩１終了時間'} = $ref->{'開始時間'};
	}
#
	if($s->time_diff($time,$ref->{'昼休憩終了時間'}) > 0){
		$ref->{'控除'} -= $s->time_diff($ref->{'昼休憩終了時間'},
				$ref->{'昼休憩開始時間'});
	}elsif($s->time_diff($time,$ref->{'昼休憩開始時間'}) > 0){
		$ref->{'控除'} -= $s->time_diff($time,
				$ref->{'昼休憩開始時間'});
	}
	if($s->time_diff($time,$ref->{'休憩１終了時間'}) > 0){
		$ref->{'控除'} -= $s->time_diff($ref->{'休憩１終了時間'},
				$ref->{'休憩１開始時間'});
	}elsif($s->time_diff($time,$ref->{'休憩１開始時間'}) > 0){
		$ref->{'控除'} -= $s->time_diff($time,
				$ref->{'休憩１開始時間'});
	}
	if($s->time_diff($time,$ref->{'休憩２終了時間'}) > 0){
		$ref->{'控除'} -= $s->time_diff($ref->{'休憩２終了時間'},
				$ref->{'休憩２開始時間'});
	}elsif($s->time_diff($time,$ref->{'休憩２開始時間'}) > 0){
		$ref->{'控除'} -= $s->time_diff($time,
				$ref->{'休憩２開始時間'});
	}
}
#------------------------------------------------------------------------#
sub soutai_koujo{
#------------------------------------------------------------------------#

=head2 早退控除時間計算 [soutai_koujo]

退社時刻より遅刻控除時間を計算し勤務名称リファレンス->{'控除'}に
控除時間（分数）をセットする。

 soutai_koujo(勤務名称リファレンス,退社時間(HH.MM))

=cut

	my $s = shift;
	my $ref = shift;
	my $time = shift;
	my $Flag = 7;
	if($ref->{'勤務コード'} eq 'E'){$Flag = 10;}
	if($ref->{'勤務コード'} eq 'Q'){$Flag = 10;}
	$ref->{'控除'} = $s->time_diff($ref->{'終了時間'},$time,$Flag);
	if($s->time_diff($ref->{'昼休憩開始時間'},$ref->{'終了時間'},$Flag)
				< 0){
	if($s->time_diff($time,$ref->{'昼休憩開始時間'},$Flag) < 0){
		$ref->{'控除'} -= $s->time_diff($ref->{'昼休憩終了時間'},
				$ref->{'昼休憩開始時間'},$Flag);
	}elsif($s->time_diff($time,$ref->{'昼休憩終了時間'},$Flag) < 0){
		$ref->{'控除'} -= $s->time_diff($ref->{'昼休憩終了時間'},
				$time,$Flag);
	}
	}
	if($s->time_diff($ref->{'休憩１開始時間'},$ref->{'終了時間'},$Flag)
				< 0){
	if($s->time_diff($time,$ref->{'休憩１開始時間'},$Flag) < 0){
		$ref->{'控除'} -= $s->time_diff($ref->{'休憩１終了時間'},
				$ref->{'休憩１開始時間'},$Flag);
	}elsif($s->time_diff($time,$ref->{'休憩１終了時間'},$Flag) < 0){
		$ref->{'控除'} -= $s->time_diff($ref->{'休憩１終了時間'},
				$time,$Flag);
	}
	}
	if($s->time_diff($ref->{'休憩２開始時間'},$ref->{'終了時間'},$Flag)
				< 0){
	if($s->time_diff($time,$ref->{'休憩２開始時間'},$Flag) < 0){
		$ref->{'控除'} -= $s->time_diff($ref->{'休憩２終了時間'},
				$ref->{'休憩２開始時間'},$Flag);
	}elsif($s->time_diff($time,$ref->{'休憩２終了時間'},$Flag) < 0){
		$ref->{'控除'} -= $s->time_diff($ref->{'休憩２終了時間'},
				$time,$Flag);
	}
	}
	if($s->time_diff($ref->{'休憩３開始時間'},$ref->{'終了時間'},$Flag)
				< 0){
	if($s->time_diff($time,$ref->{'休憩３開始時間'},$Flag) < 0){
		$ref->{'控除'} -= $s->time_diff($ref->{'休憩３終了時間'},
				$ref->{'休憩３開始時間'},$Flag);
	}elsif($s->time_diff($time,$ref->{'休憩３終了時間'},$Flag) < 0){
		$ref->{'控除'} -= $s->time_diff($ref->{'休憩３終了時間'},
				$time,$Flag);
	}
	}
}
#------------------------------------------------------------------------#
sub time_diff{
#------------------------------------------------------------------------#

=head2 時刻比較 [time_diff]

２つの時刻の差（分数）を計算する。時刻：(HH.MM)

 時刻１ - 時刻２ = time_diff(時刻１,時刻２)

=cut

	my $s = shift;
	my @time = @_;
	if($time[2] !~ /^\d+$/){$time[2] = 7;}
	$time[0] += 24 if($time[0] < $time[2]);
	$time[1] += 24 if($time[1] < $time[2]);
	$time[2] = $s->hm2m($time[0]) - $s->hm2m($time[1]);
#	print  "|",$s->hm2m($time[0]) ,"-", $s->hm2m($time[1]),"=",$time[2];
	return $time[2];
}
sub add_time{
	my $s = shift;
	my @times = @_;
	my $sign;
	my $time = $s->hm2m($times[0]) + $s->hm2m($times[1]);
	if($time<0){$sign = -1; $time *= $sign;
	}else{	$sign = 1;}
	return sprintf("%2.2f",int($time / 60) + ($time % 60) / 100)*$sign;
}
#------------------------------------------------------------------------#
sub edit{
#------------------------------------------------------------------------#

=head2 編集 [edit]

 $text = edit(-e=>XX,-in=>999)

=cut

	my $s = shift;
	my %x = (-e =>'f5',@_);
	my $text = $x{-in};
	if($x{-e} eq 'f5'){
		$text = sprintf("%3d:%02d",
			int($x{-in} / 60),
			$x{-in} % 60);
	}
	if($x{-e} eq 'sinseiK'){
		$text =~ s/(\d\d)(\d\d\d)(\d\d)(\w\d\d)/$1-$2-$3-$4/;
	}
	return $text;
}
#------------------------------------------------------------------------#
sub hm2m{
#------------------------------------------------------------------------#

=head2 時刻分数変換 [hm2m]

時刻(hh.mm)を分に変換する。

 $int = hm2m(時刻(hh.mm))

=cut

	my $s = shift;
	my $x = shift;
	my $sign = 1;
	if($x < 0){ $sign = -1;$x *= $sign;}
#	$x = $x * 100;
	my @t = split /[\.:]/,$x;
	$t[1] .= '0' if($t[1] =~ /^\d$/);
	$x = $t[0]*100+$t[1];
	my ($h,$m);
	$m = $x % 100;
	$h = ($x - $m) / 100 * 60;
	return int(($h+$m)*$sign);
}	 

=head2 todoke_mei 直近の届マスタ参照

指定日付の届マスタをセレクトする

 $ref = todoke_mei(-date=>対象日付,-simei=>氏名コード,-todoke=>届コード
				,-temp=>'todoke')
 $ref: 該当届マスタのhashリファレンス

指定日付の届マスタを参照する。又、届データにて届名称を編集する。

=cut

sub todoke_mei{
	my $s = shift;
	my ($y,$m,$d) = today();
	my %x = (-date => $y*10000+$m*100+$d,-temp => 'todoke',@_);
	my ($sql,$sth,$ref,$ref2);
#	$s->tmp_todoke(-date=>$x{-date});
	$sql = q{select * from 届マスタ
		where 届コード = ?
			and 適用開始日 <= ? and NEXT適用日 > ?};
	$sth = $s->{dbh}->prepare($sql);
	$sth->execute($x{-todoke},$x{-date},$x{-date});
	$ref = $sth->fetchrow_hashref();
	if($ref->{'最大回数'} < 1){
		return $ref;
	}
	($y,$m,$d) = $s->ymd_split($x{-date});
	my $kisyu = $y*10000+$s->{cons}->{StartMD};
	if($s->diffdate($kisyu,$x{-date})>0){
		$kisyu = $kisyu - 10000;
	}
	$sql = q{select count(*) cnt from 届データ where 氏名コード = ?
			and 届日 >= ? and 届日 <= ?
			and 届コード = ?};
	$sth = $s->{dbh}->prepare($sql);
	$sth->execute($x{-simei},$kisyu,$x{-date},$x{-todoke});
	$ref2 = $sth->fetchrow_hashref();
	$ref->{'届出名称'} .= $ref2->{cnt};
	return $ref;
}

=head2 tmp_todoke 直近届マスタセレクト

指定日付の届マスタをセレクトしtemporary tableを作成する。

 tmp_todoke(-date=>対象日付,-temp=>'todoke')

届マスタを履歴管理する為に指定日付のマスターＧＥＴ用の
テンポラリーテーブルを作成（Viewがあればそちらで出来る処理）

=cut

sub tmp_todoke{
	my $s = shift;
	my ($y,$m,$d) = today();
	my %x = (-date => $y*10000+$m*100+$d,-temp => 'todoke',@_);
	eval {$s->{dbh}->do("drop temporary table $x{-temp}");};
	$s->{dbh}->do("create temporary table $x{-temp}
			select 届コード tcd,max(適用開始日) mxday
			from 届マスタ where 適用開始日 <= '$x{-date}'
			group by 届コード");
}

=head2 next_day_set NEXT適用日セット

=cut

sub next_day_set{
	my $s = shift;
	my %x = (-table=>'人事マスタ',-code=>['00000'],@_);
	my ($sql,$sql2,$sth,$sth2);
	$sql = "select 適用開始日,NEXT適用日,氏名コード from 人事マスタ
			where 氏名コード = ?
			order by 氏名コード,適用開始日 desc";
	$sql2 = "update 人事マスタ set NEXT適用日 = ?
			where 氏名コード = ?
			and 適用開始日 = ?";
	if($x{-table} eq '所属マスタ'){
		$sql =~ s/人事マスタ/所属マスタ/g;
		$sql2 =~ s/人事マスタ/所属マスタ/g;
		$sql =~ s/氏名コード/所属コード/g;
		$sql2 =~ s/氏名コード/所属コード/g;
	}elsif($x{-table} eq '届マスタ'){
		$sql =~ s/人事マスタ/届マスタ/g;
		$sql2 =~ s/人事マスタ/届マスタ/g;
		$sql =~ s/氏名コード/届コード/g;
		$sql2 =~ s/氏名コード/届コード/g;
	}elsif($x{-table} eq '計算基礎時間マスタ'){
		$sql =~ s/人事マスタ/計算基礎時間マスタ/g;
		$sql2 =~ s/人事マスタ/計算基礎時間マスタ/g;
		$sql =~ s/氏名コード/計算基礎時間区分/g;
		$sql2 =~ s/氏名コード/計算基礎時間区分/g;
	}elsif($x{-table} eq '超過時間設定マスタ'){
		$sql =~ s/人事マスタ/超過時間設定マスタ/g;
		$sql2 =~ s/人事マスタ/超過時間設定マスタ/g;
		$sql =~ s/氏名コード/超過時間コード/g;
		$sql2 =~ s/氏名コード/超過時間コード/g;
	}elsif($x{-table} eq '割増率マスタ'){
		$sql =~ s/人事マスタ/割増率マスタ/g;
		$sql2 =~ s/人事マスタ/割増率マスタ/g;
		$sql =~ s/氏名コード/割増率コード/g;
		$sql2 =~ s/氏名コード/割増率コード/g;
	}
	$sth = $s->{dbh}->prepare($sql);
	$sth->execute(@{$x{-code}});
	$sth2 = $s->{dbh}->prepare($sql2);
	my ($date,$code,$cnt) = (99991231,'',0);
	while(my $ref = $sth->fetchrow_arrayref()){
		$date = '99991231' if($code ne $ref->[2]);
		$sth2->execute($date,$ref->[2],$ref->[0]);
		$date = $ref->[0];
		$code = $ref->[2];
	}
} 

=head1 仕訳システム

=cut
sub gzanMeisai_sql{
	my $s = shift;
	my %x = @_;
	my $sql = $s->zanMeisai_sql(%x);
	$sql =~ s/仕訳データ/外貨建仕訳データ m/g;
	$sql =~ s/ 貸借/ 貸借,m.通貨区分/g;
	$sql =~ s/group by /group by m.通貨区分,/g;
	return $sql;
}
sub zanMeisai_sql{
	my $s = shift;
	my %x = @_;
	my ($where1,$where2);
	if($x{-where}){
		$where1 = $where2 = $x{-where};
		$where1 =~ s/ 科目 / 借方科目コード /g;
		$where1 =~ s/ 部門 / 借方部門コード /g;
		$where1 =~ s/ 要素 / 借方要素コード /g;
		$where1 =~ s/ 取引先 / 借方取引先コード /g;
		$where2 =~ s/ 科目 / 貸方科目コード /g;
		$where2 =~ s/ 部門 / 貸方部門コード /g;
		$where2 =~ s/ 要素 / 貸方要素コード /g;
		$where2 =~ s/ 取引先 / 貸方取引先コード /g;
		$where1 .= " and ";
		$where2 .= " and ";
	}
#	借方科目コード = ? and 借方部門コード = ? and 借方要素コード = ? and
#	貸方科目コード = ? and 貸方部門コード = ? and 貸方要素コード = ? and
#	借方科目コード = ? and 借方部門コード = ? and 借方要素コード = ? and
#	貸方科目コード = ? and 貸方部門コード = ? and 貸方要素コード = ? and
	my $sql;
        $sql = qq{select 借方科目コード 科目,
			借方部門コード 部門,
			借方要素コード 要素,
			lpad(借方取引先コード,5,0) 取引先,
			rtrim(借方決済コード) 決済,
			借方ＢＫコード BK,
			手形番号,
			借方摘要区分 摘要区分,
			借方税区分 税区分,
			バッチＮＯ,伝票区分,仕訳区分,伝票番号,発行日
                        ,貸方科目コード 相手科目,貸方部門コード 相手部門
                        ,貸方要素コード 相手要素
                        ,貸方取引先コード,貸方決済コード
			,借方取引先名称 取引先名称
                        ,sum(金額) 金額,摘要
                        ,b.科目名,b.部門名,b.要素名
                        ,取引先名,min(SEQ_NO) SEQ_NO
			,残高作成,科目区分,1 貸借
                from 仕訳データ
                left join 科目マスタ b on (借方科目コード = b.科目コード and
                                        借方部門コード = b.部門コード and
                                        借方要素コード = b.要素コード)
                left join 取引先マスタ on (貸方取引先コード = 取引先コード)
                where
			b.科目コード != 608 and
			$where1
			残高作成 = 1 and 借方消込日 = '0000-00-00'
		group by 借方科目コード,借方部門コード
			,借方取引先コード,借方決済コード
			,発行日,伝票番号
                union all
                select 貸方科目コード 科目,
			貸方部門コード 部門,
			貸方要素コード 要素,
			lpad(貸方取引先コード,5,0) 取引先,
			rtrim(貸方決済コード) 決済,
			貸方ＢＫコード BK,
			手形番号,
			貸方摘要区分 摘要区分,
			貸方税区分 税区分,
			バッチＮＯ,伝票区分,仕訳区分,伝票番号,発行日
                        ,借方科目コード,借方部門コード,借方要素コード
                        ,借方取引先コード,借方決済コード
			,貸方取引先名称 取引先名称
                        ,sum(金額),摘要
                        ,b.科目名,b.部門名,b.要素名
                        ,取引先名,min(SEQ_NO)
			,残高作成,科目区分,2 貸借
                from 仕訳データ
                left join 科目マスタ b on (貸方科目コード = b.科目コード and
                                        貸方部門コード = b.部門コード and
                                        貸方要素コード = b.要素コード)
                left join 取引先マスタ on (借方取引先コード = 取引先コード)
                where
			b.科目コード != 608 and
			$where2
			残高作成 = 1 and 貸方消込日 = '0000-00-00'
		group by 貸方科目コード,貸方部門コード
			,貸方取引先コード,貸方決済コード
			,発行日,伝票番号
		
                union all
        	select 借方科目コード 科目,
			借方部門コード 部門,
			'' 要素,
			'' 取引先,
			rtrim(借方決済コード) 決済,
			'' BK,
			'' 手形番号,
			substring(借方摘要区分,1,2) 摘要区分,
			借方税区分 税区分,
			'' バッチＮＯ,'' 伝票区分,'' 仕訳区分
			,'' 伝票番号,date_format(発行日,"%Y-%m-31")
                        ,'' 相手科目,'' 相手部門
                        ,'' 相手要素
                        ,'',''
			,'' 取引先名称
                        ,sum(金額),摘要
                        ,b.科目名,b.部門名,b.要素名
                        ,'' 取引先名,'' SEQ_NO
			,残高作成,科目区分,1 貸借
                from 仕訳データ
                left join 科目マスタ b on (借方科目コード = b.科目コード and
                                        借方部門コード = b.部門コード and
                                        借方要素コード = b.要素コード)
                left join 取引先マスタ on (貸方取引先コード = 取引先コード)
                where
			b.科目コード = 608 and
			$where1
			残高作成 = 1 and 借方消込日 = '0000-00-00'
		group by 借方科目コード,借方部門コード
			,借方決済コード
			,date_format(発行日,"%Y%m")
			,substring(借方摘要区分,1,2)
		
                union all
                select 貸方科目コード 科目,
			貸方部門コード 部門,
			'' 要素,
			'' 取引先,
			rtrim(貸方決済コード) 決済,
			'' BK,
			'' 手形番号,
			substring(貸方摘要区分,1,2) 摘要区分,
			貸方税区分 税区分,
			'' バッチＮＯ,'' 伝票区分,'' 仕訳区分
			,'' 伝票番号,date_format(発行日,"%Y-%c-31")
                        ,'' 借方科目コード,'' 借方部門コード
			,'' 借方要素コード
                        ,'' ,''
			,'' 取引先名称
                        ,sum(金額),摘要
                        ,b.科目名,b.部門名,b.要素名
                        ,'' 取引先名,'' SEQ_NO
			,残高作成,科目区分,2 貸借
                from 仕訳データ
                left join 科目マスタ b on (貸方科目コード = b.科目コード and
                                        貸方部門コード = b.部門コード and
                                        貸方要素コード = b.要素コード)
                left join 取引先マスタ on (借方取引先コード = 取引先コード)
                where
			b.科目コード = 608 and
			$where2
			残高作成 = 1 and 貸方消込日 = '0000-00-00'
		group by 貸方科目コード,貸方部門コード
			,貸方決済コード
			,date_format(発行日,"%Y%m")
			,substring(貸方摘要区分,1,2)
		
		};
	return $sql;
}
sub tegataSplit{
	my $s = shift;
	my %x = @_;
	my (@max,@kin);
	my $sth = $s->{dbh}->prepare(qq{
		select * from 手形分割マスタ where 手形金額ＭＡＸ >= ?
			order by 手形金額ＭＡＸ limit 1});
	$sth->execute($x{-kingaku});
	my $ref = $sth->fetchrow_hashref();
	for(1..3){
		push @max,$ref->{"分割$_"};
	}
	for(@max){
		if($_ == 0){push @kin,$x{-kingaku};$x{-kingaku} = 0;last;}
		if($_ < $x{-kingaku}){
			push @kin,$_;$x{-kingaku} -= $_}
	}
	if($x{-kingaku} > 0){ push @kin,$x{-kingaku};}
	return @kin;
}
sub tegataSight{
	my $s = shift;
	my %x = @_;
#	my ($y,$m,$d) = $s->adddate($s->ymd_split($x{-st}),$x{-sit});
	my ($y,$m,$d) = $s->ymd_split($x{-st});
	my ($mm,$dd);
	my ($date);
	if($x{-sit} == 120 and
		$date = $s->date_chk($x{-S120})){
		return $date;
	}
	$dd = $x{-sit}%30;
	$mm = int(($x{-sit} - $dd) / 30);
	$m = $m + $mm;
	while($m > 12){$y++; $m -= 12;}
#	if($d >= 28){ $d = $s->end_day($y*100+$m);}
	$d = $s->end_day($y*100+$m);
	($y,$m,$d) = $s->adddate($y,$m,$d,$dd); 
	if($m == 1 and $d == 5) {$d = 10;}
	if($m == 5 and $d == 5) {$d = 10;}
	return "$y/$m/$d";
}

sub sikinhyou{
	my $s = shift;
	my %x = ('seq'=>0,'lev'=>0,'No'=>0,'Item'=>0,@_);
	my ($sth,$ref);
	$sth = $s->{dbh}->prepare("
		select * from 資金表項目 where 集計ＳＥＱ = ?
		order by 順番");
	$sth->execute($x{seq});
	my ($No,$Item) = (0,0);
	while($ref = $sth->fetchrow_hashref()){
		$No = ++$x{No};
		if($ref->{'レベル'} == 0 ){
			$Item = 1;
			$x{Item}++;
		}else{	($x{No},$Item) = $s->sikinhyou(
			'seq'=>$ref->{'SEQ_NO'},'lev'=>$x{lev}+1,
				'No'=>$x{No},'Item'=>0,
				'SUM'=>$ref->{'集計ＳＥＱ'});
			$x{Item} += $Item;
		}
		if($ref->{'SEQ_NO'} == 56){
			$s->{sikin}->{PLINE}[$No] =
			"<td rowspan=$Item colspan=4 width=48pt>".
			"$ref->{'項目'}</td>";
		}elsif($ref->{'集計ＳＥＱ'} == 56){
			$s->{sikin}->{PLINE}[$No] =
			"<td align=center>$ref->{'項目'}</td>".
			"</tr><tr>";
		}elsif($ref->{'レベル'} == 0 ){
			$s->{sikin}->{PLINE}[$No] =
			"<td colspan=@{[5 - $x{'lev'}]} align=center>".
			"$ref->{'項目'}</td></tr><tr>";
		}else{	$s->{sikin}->{PLINE}[$No] =
			"<td rowspan=$Item width=12pt>$ref->{'項目'}</td>";
		}
		$s->{sikin}->{PID}[$No] = $ref->{'ＩＤ'};
		$s->{sikin}->{LEV}[$No] = $ref->{'レベル'};
		$s->{sikin}->{SUM}[$No] = $ref->{'集計ＳＥＱ'};
		$s->{sikin}->{SEQ}[$No] = $ref->{'SEQ_NO'};
		$s->{sikin}->{PAR}[$No] = $x{SUM};
	}
	return $x{No},$x{Item};
}

=head2 振込手数料計算 furikomiTesuuryou

=cut

sub furikomiTesuuryou{
	my $s = shift;
	my %x = @_;
	my $sth = $s->{dbh}->prepare(q{
		select 手数料 from 振込手数料テーブル where
			処理区分 = ? and
			自他行区分 = ? and 送付区分 = ? and
			以上 <= ? and 未満 > ?});
	$sth->execute($x{-syori},$x{-jita},$x{-soufu}
			,$x{-kingaku},$x{-kingaku});
#	print "<tr><td>$x{-syori},$x{-jita},$x{-soufu}
#			,$x{-kingaku},$x{-kingaku}</td></tr>\n";
	my $ref = $sth->fetchrow_hashref();
	return $ref->{'手数料'};
}

=head2 送付手数料計算 soufuTesuuryou{

=cut

sub soufuTesuuryou{
	my $s = shift;
	my %x = @_;
	my $sth = $s->{dbh}->prepare(q{
		select 送付手数料 from 送付手数料テーブル where
			手形送付区分 = ?});
	$sth->execute($x{-soufu});
	my $ref = $sth->fetchrow_hashref();
	return $ref->{'送付手数料'};
}

=head2 相手科目算出 aitekamoku

=cut

sub aitekamoku{
	my $s = shift;
	my %x = @_;
	my ($ka,$bu) = ('','');
	if($x{ka} == 529 and $x{bu} == 300){$ka=606;$bu=200;
	}elsif($x{ka} == 529 and $x{bu} == 400){$ka=602;$bu ='';
	}elsif($x{ka} == 531 and $x{bu} == 100){$ka=606;$bu ='100';
	}elsif($x{ka} == 531 and $x{bu} == 200){$ka=606;$bu ='100';
	}elsif($x{ka} == 532 )			{$ka=606;$bu ='100';
	}elsif($x{ka} == 533 )			{$ka=606;$bu ='100';
	}elsif($x{ka} == 535 and $x{bu} == 100){$ka=606;$bu ='100';
	}elsif($x{ka} == 535 and $x{bu} == 200){$ka=606;$bu ='100';
	}elsif($x{ka} == 535 and $x{bu} == 300){$ka=606;$bu ='100';
	}elsif($x{ka} == 535 and $x{bu} == 500){$ka=606;$bu ='100';
	}elsif($x{ka} == 536 )			{$ka=606;$bu ='100';
	}elsif($x{ka} == 537 )			{$ka=606;$bu ='100';
	}elsif($x{ka} == 543 and $x{bu} == 100){$ka=606;$bu ='100';
	}elsif($x{ka} == 543 and $x{bu} == 500){$ka=606;$bu ='100';
	}elsif($x{ka} == 543 and $x{bu} == 900){$ka=606;$bu ='100';
	}elsif($x{ka} == 801 and $x{bu} == 101){$ka=602;$bu ='';
	}elsif($x{ka} == 801 and $x{bu} == 200){$ka=602;$bu ='';
	}elsif($x{ka} == 801 and $x{bu} == 201){$ka=602;$bu ='';
	}elsif($x{ka} == 801 and $x{bu} == 202){$ka=602;$bu ='';
	}elsif($x{ka} == 803 and $x{bu} == 101){$ka=602;$bu ='';
	}elsif($x{ka} == 803 and $x{bu} == 102){$ka=602;$bu ='';
	}elsif($x{ka} == 803 and $x{bu} == 103){$ka=602;$bu ='';
	}elsif($x{ka} == 803 and $x{bu} == 105){$ka=602;$bu ='';
	}elsif($x{ka} == 803 and $x{bu} == 107){$ka=602;$bu ='';
	}elsif($x{ka} == 803 and $x{bu} == 200){$ka=602;$bu ='';
	}elsif($x{ka} == 803 and $x{bu} == 201){$ka=602;$bu ='';
	}elsif($x{ka} == 803 and $x{bu} == 202){$ka=602;$bu ='';
	}elsif($x{ka} == 803 and $x{bu} == 208){$ka=602;$bu ='';
	}elsif($x{ka} == 803 and $x{bu} == 300){$ka=602;$bu ='';
	}elsif($x{ka} == 803 and $x{bu} == 301){$ka=602;$bu ='';
	}elsif($x{ka} == 803 and $x{bu} == 400){$ka=602;$bu ='';
	}elsif($x{ka} == 803 and $x{bu} == 401){$ka=602;$bu ='';
	}elsif($x{ka} == 803 and $x{bu} == 402){$ka=602;$bu ='';
	}elsif($x{ka} == 803 and $x{bu} == 500){$ka=602;$bu ='';
	}elsif($x{ka} == 811 and $x{bu} == 800){$ka=602;$bu ='';
	}elsif($x{ka} == 811 and $x{bu} == 801){$ka=602;$bu ='';
	}
	return $ka,$bu;
}
sub membersGet{
	my $s = shift;
	my %x = @_;
	my %hash = (99998 =>'');
	my @arry = (99998);
	my ($sth,$ref);
	$sth = $s->{dbh}->prepare(qq{
		select 氏名コード,氏名 from 人事マスタ
		where curdate() between 適用開始日 and
			subdate(NEXT適用日,interval 1 day)
		and	退職日 = 0
--		and	承認者 = 氏名コード
--		and	種類 = ?
		$x{-where}
		order by 所属コード,資格コード desc,氏名コード});
	$sth->execute();
	while($ref = $sth->fetchrow_hashref()){
		$hash{$ref->{'氏名コード'}} = $ref->{'氏名'};
		push @arry,$ref->{'氏名コード'};
	}
	$hash{99999} ='承認完了';
	push (@arry,99999);
	return \%hash,\@arry;
}
sub memberGet{
	my $s = shift;
	my %x = (-syurui=>0,@_);
	my %hash = ($x{-simei}=>1);
	$s->route(\%hash,$x{-syurui},$x{-simei});
	return \%hash;
}
sub memberGet1{
	my $s = shift;
	my %x = (-syurui=>1,@_);
	my %hash = ($x{-simei}=>1);
	$s->route(\%hash,$x{-syurui},$x{-simei});
	return \%hash;
}
sub route{
	my ($s,$hash,$syu,$simei) = @_;
	my $sth = $s->{dbh}->prepare(q{
		select 申請者 from 承認ルート
		where 種類 = ? and 承認者 = ?
		});
	$sth->execute($syu,$simei);
	while(my $ref = $sth->fetchrow_hashref()){
		next if($hash->{$ref->{'申請者'}} == 1);
		$hash->{$ref->{'申請者'}} = 1;
		$s->route($hash,$syu,$ref->{'申請者'});
	}
	return $hash;
}
	

sub kuraireTanka{
	my $s = shift;
	my $txt = qq{
		update 個別採算マスタ set 倉入単価 =
		主材料費+補助材料費+外注手加工費+外注マウント費
		+外注ＩＣ費+外注ＣＲ費+外注ＪＰ費+金型費+ソフト費
		+round(社内手加工ＳＴ*社内手加工賃率,2)
		+round(社内マウントＳＴ*社内マウント賃率,2)
		+round(社内ＩＣＳＴ*社内ＩＣ賃率,2)
		+round(社内ＣＲＳＴ*社内ＣＲ賃率,2)
		+round(社内ＪＰＳＴ*社内ＪＰ賃率,2)
		+round((社内手加工ＳＴ+社内マウントＳＴ+社内ＩＣＳＴ
			+社内ＣＲＳＴ+社内ＪＰＳＴ)
			*(間接賃率+技術賃率),2)
		+round(if(配賦区分 = 1,主材料費+補助材料費,
			外注手加工ＳＴ+外注マウントＳＴ+外注ＩＣＳＴ
			+外注ＣＲＳＴ+外注ＪＰＳＴ)*外注賦課経費賃率,2)
		};
	return $txt;
}

sub hanko{
	my $s = shift;
	my %x = ('font-color'=>'red',@_);
	return '' if($x{name} eq '');
	my $txt = '';
	$txt .= <<END;
<br><font color="$x{'font-color'}">$x{'name'}
<div style="position:relative; top:-17px; left:0px; font-size:60px">○
</div></font>
END
	return $txt;
}
=head1 給与計算

=head2 getu_zei_tok 月例徴収税額

月額表の甲欄を適用する給与等に対する
源泉徴収税額の電算機の特例による

=cut

sub getu_zei_tok{
	my $s = shift;
	my %x = @_;
	$x{koujo} = $s->getu_zei_tok_bet1($x{kingaku});
	$x{kazei} = $x{kingaku} - $x{koujo} - (31667 * ($x{fuyou}+1));
	if($x{kazei} <		275001){
		$x{zeigaku} = $s->hasuu(-n=>$x{kazei} * 0.08 ,
		-a=>1,-u=>10);	  
	}elsif($x{kazei} <	658335){
		$x{zeigaku} = $s->hasuu(-n=>$x{kazei} * 0.16 - 22000,
		-a=>1,-u=>10);
	}elsif($x{kazei} <	750001){
		$x{zeigaku} = $s->hasuu(-n=>$x{kazei} * 0.2  - 48334,
		-a=>1,-u=>10);
	}elsif($x{kazei} <	1500001){
		$x{zeigaku} = $s->hasuu(-n=>$x{kazei} * 0.3  - 123334,
		-a=>1,-u=>10);
	}else{	$x{zeigaku} = $s->hasuu(-n=>$x{kazei} * 0.37 - 228334,
		-a=>1,-u=>10);
	}
	$x{zeigaku} = 0 if($x{zeigaku} < 0);
	return $x{zeigaku};
}
sub getu_zei_tok_bet1{
	my $s = shift;
	my $kin = shift;
	my $koujo;
	if($kin <	135417 ){ $koujo = 54167;
	}elsif($kin <	150000 ){ $koujo = $s->hasuu(-n=>$kin * 0.4,
					-a=>2,-u=>1);
	}elsif($kin <	300000 ){ $koujo = $s->hasuu(-n=>$kin * 0.3  +  15000,
					-a=>2,-u=>1);
	}elsif($kin <	550000 ){ $koujo = $s->hasuu(-n=>$kin * 0.2  +  45000,
					-a=>2,-u=>1);
	}elsif($kin <	833334 ){ $koujo = $s->hasuu(-n=>$kin * 0.1  + 100000,
					-a=>2,-u=>1);
	}else{			  $koujo = $s->hasuu(-n=>$kin * 0.05 + 141667,
					-a=>2,-u=>1);
	}
	return $koujo;
}

=head2 賞与税率計算

=cut

sub syou_zei_rit{
	my $s = shift;
	my %x = (fuyou=>0,zengetu=>0,kou=>0,@_);
	my $rit = 0;
	my $zei = [ 
[65,71,77,85,371,410,498,682,715,749,786,827,875,951,1331,1471,1745,0],
[89, 98,115,365,401,438,498,704,739,774,813, 856, 906, 983,1356,1498,1778,0],
[123,140,248,393,427,466,514,725,763,800,839, 886, 937,1016,1382,1526,1811,0],
[159,180,248,417,452,494,545,747,787,825,867, 915, 968,1048,1407,1554,1844,0],
[195,219,248,441,478,522,579,769,811,851,895, 944, 999,1081,1432,1582,1877,0],
[228,254,286,465,504,551,610,790,836,877,923, 973,1030,1114,1457,1610,1910,0],
[259,288,324,488,530,582,640,812,861,903,950,1002,1061,1146,1482,1638,1943,0],
[289,322,363,512,556,610,669,834,886,930,978,1032,1092,1179,1508,1665,1976,0],
			];
	$x{foyou} = 7 if($x{fuyou} > 7);
	$x{fuyou} = 0 unless(grep {$x{fuyou} eq $_} qw(0 1 2 3 4 5 6 7));
	if($x{kou} == 1){
		if($x{zengetu} < 278000){	$rit = 10;
		}elsif($x{zengetu} < 510000){	$rit = 20;
		}elsif($x{zengetu} < 563000){	$rit = 30;
		}else{				$rit = 35;
		}
	}else{
		for (0..$#{$zei->[$x{fuyou}]}){
			$rit = $_;
			if($x{zengetu}/1000 < $zei->[$x{fuyou}]->[$rit]){
				last;
			}
		}
		$rit *= 2;
		$rit = 35 if($rit>=34);
	}
	return $rit;
}

=head2 年税額の計算

=cut

sub nen_zei{
	my $s = shift;
	my %x = (syaho=>0,kyousai=>0,seiho=>0,songai=>0,
		ippan=>0,tokutei=>0,roujin=>0,dourou=>0,doutokusyou=>0,
		syougai=>0,tokusyou=>0,juutaku=>0,haitoku=>0,@_);
 #年調給与額
	if(    $x{sougaku} < 1619000){	$x{kyuyo} = $x{sougaku};
	}elsif($x{sougaku} < 1620000){	$x{kyuyo} = $s->hasuu(-n=>$x{sougaku},-a=>0,-u=>1000);
	}elsif($x{sougaku} < 1624000){	$x{kyuyo} = $s->hasuu(-n=>$x{sougaku},-a=>0,-u=>2000);
	}elsif($x{sougaku} < 6600000){	$x{kyuyo} = $s->hasuu(-n=>$x{sougaku},-a=>0,-u=>4000);
	}else{				$x{kyuyo} = $x{sougaku};
	}
 #所得控除後
	if(    $x{kyuyo} <   651000){ $x{koujogo} = 0;
	}elsif($x{kyuyo} <  1619000){ $x{koujogo} = int($x{kyuyo}       -  650000);
	}elsif($x{kyuyo} <  1620000){ $x{koujogo} = int($x{kyuyo} * 0.6 -    2400);
	}elsif($x{kyuyo} <  1622000){ $x{koujogo} = int($x{kyuyo} * 0.6 -    2000);
	}elsif($x{kyuyo} <  1624000){ $x{koujogo} = int($x{kyuyo} * 0.6 -    1200);
	}elsif($x{kyuyo} <  1628000){ $x{koujogo} = int($x{kyuyo} * 0.6 -     400);
	}elsif($x{kyuyo} <  1800000){ $x{koujogo} = int($x{kyuyo} * 0.6);
	}elsif($x{kyuyo} <  3600000){ $x{koujogo} = int($x{kyuyo} * 0.7 -  180000);
	}elsif($x{kyuyo} <  6600000){ $x{koujogo} = int($x{kyuyo} * 0.8 -  540000);
	}elsif($x{kyuyo} < 10000000){ $x{koujogo} = int($x{kyuyo} * 0.9 - 1200000);
	}elsif($x{kyuyo} < 20000001){ $x{koujogo} = int($x{kyuyo} * 0.95 - 1700000);
	}else{	return 0;
	}
 #控除額合計
	$x{koujo} = 				380000;	# 基礎控除額
	if($x{hon} == 1){$x{koujo} += 		500000;	# 老年者
	}elsif($x{hon} == 2){$x{koujo} +=	350000;	# 特別寡婦
	}elsif($x{hon} == 3){$x{koujo} +=	270000;	# 寡婦
	}elsif($x{hon} == 4){$x{koujo} +=	270000;	# 寡夫
	}elsif($x{hon} == 5){$x{koujo} +=	270000;	# 勤労学生
	}
	if($x{hai} == 1){$x{koujo} +=		380000;	# 一般配偶者
	}elsif($x{hai} == 2){$x{koujo} +=	480000; # 老人配偶者
	}
	$x{koujo} += $x{ippan} *		380000;	# 一般扶養
	$x{koujo} += $x{tokutei} *		630000; # 特定扶養
	$x{koujo} += $x{roujin} *		480000; # 老人扶養
	$x{koujo} += $x{dourou} *		580000;	# 同居老親
	$x{koujo} += $x{doutokusyou} *		750000; # 同居特別障害
	$x{koujo} += $x{syougai} *		270000; # 一般障害者
	$x{koujo} += $x{tokusyou} *		400000; # 特別障害者
 # 課税所得
	$x{kazei} = $x{koujogo} - $x{syaho} - $x{kyousai} - $x{seiho}
		- $x{songai} - $x{koujo} - $x{haitoku};
	$x{kazei} = $s->hasuu(-n=>$x{kazei},-a=>0,-u=>1000);
 # 年税額
	if($x{kazei} <= 3300000){$x{nenzei} = $x{kazei} * 0.1;
	}elsif($x{kazei} <= 9000000){$x{nenzei} = $x{kazei} * 0.2 - 330000;
	}elsif($x{kazei} <= 16920000){$x{nenzei} = $x{kazei} * 0.3 - 1230000;
	}else{	return 0;
	}
 # 住宅取得控除
	if($x{juutaku} <= $x{nenzei}){$x{nenzei} -= $x{juutaku};
	}else{	$x{nenzei} = 0;
	}
 # 平成１６年分税額
	$x{teiritu} = $x{nenzei} * 0.2;
	$x{teiritu} = 250000 if($x{teiritu} > 250000);
	$x{nenzei} -= $x{teiritu};
	$x{nenzei} = $s->hasuu(-n=>$x{nenzei},-a=>0,-u=>100);
	return \%x;
}

=head1 メール送信

=cut

sub SendMail_S{
	my $s = shift;
	my $x = shift;
	$x->{subject} = jcode($x->{subject})->mime_encode;
	$x->{toName} = jcode($x->{toName})->mime_encode;
	$x->{fromName} = jcode($x->{fromName})->mime_encode;
	$x->{data} = jcode($x->{data})->jis;

	my $smtp = Net::SMTP->new('mail.sharp.co.jp');
	$smtp->mail($x->{from});
	$smtp->to($x->{to});
	$smtp->data();
	$smtp->datasend("From: $x->{fromName}<$x->{from}>\n");
	$smtp->datasend("To: $x->{toName}<$x->{to}>\n");
	$smtp->datasend("Subject: $x->{subject}\n");
	$smtp->datasend("\n");
	$smtp->datasend($x->{data});
	$smtp->dataend();
	$smtp->quit;
}
#------------------------------------------------------------------------#
sub send_mail{
#------------------------------------------------------------------------#
	my $s = shift;
	my %x = (-server=>'mail.sharp.co.jp',
		-from=>'sne_system@sharp.co.jp',
		@_);
	return undef unless(defined $x{-to});
	return undef unless(defined $x{-subject});
	my $boundary = "----=Next_Part_000_000D_01C54416.DD64B0A0";
	$x{-subject} = jcode($x{-subject})->mime_encode;
	$x{Name} = jcode($x{-name})->mime_encode;
	$x{-mail_data} = jcode($x{-mail_data})->jis;

	my $smtp = Net::SMTP->new($x{-server});
	$smtp->mail($x{-from});
	$smtp->to($x{-to});
	$smtp->cc($x{-cc}) if($x{-cc});

	$smtp->data();
	$smtp->datasend("To: $x{Name}<$x{-to}>\n");
	$smtp->datasend("Cc: $x{-cc}\n") if($x{-cc});
	$smtp->datasend("Subject: $x{-subject}\n");
	$smtp->datasend("MIME-Version: 1.0\n");
	$smtp->datasend("Content-Type: multipart/mixed;\n");
	$smtp->datasend(qq{	boundary="$boundary"\n});
	$smtp->datasend("\n");
	$smtp->datasend("This is a multi-part message in MIME format.\n");
	$smtp->datasend("\n--$boundary\n");
	$smtp->datasend("Content-type: text/plain;\n");
	$smtp->datasend(qq{	charset="iso-2022-jp"\n});
	$smtp->datasend("Content-transfer-Encoding: 7bit\n\n");
	$smtp->datasend("$x{-mail_data}\n");

	for(@{$x{-file}}){
		my      ($dev, $ino, $mode, $nlink, $uid, $gid,
		$rdev, $size, $atime, $mtime, $ctime, $blksize, $blocks)
			= stat($_);
		my ($buf,$dum,$dum2,$fileName);
		open(in, $_);
		binmode(in);
		sysread(in, $buf, $size);
		close(in);

		$smtp->datasend("\n--$boundary\n");
		$smtp->datasend(qq{Content-Type: application/octet-stream; name="$_"\n});
		$smtp->datasend("Content-transfer-Encoding: base64\n");
		$fileName = $x{-Fname}->{$_} || $_;
		$fileName = jcode($fileName,'euc')->sjis;
		$fileName = jcode($fileName,'sjis')->mime_encode;
		$smtp->datasend(qq{Content-Disposition: attachment; filename="$fileName"\n\n});

		my $i = 0;
		my $k = 60*57;
		while($i < length($buf)) {
			if (length($buf) - $i < $k) {
				$k = length($buf) - $i;
			}
			$dum = substr($buf,$i,$k);
			$dum2 = encode_base64($dum);
			$smtp->datasend($dum2);
			$i += $k;
		}
	}
	$smtp->datasend("\n--$boundary--\n");
	$smtp->dataend();
	$smtp->quit;
}
1;
__END__

=head1 AUTHOR INFORMATION

 ;######################################################################
 ;#
 ;# webdb.pm: DB Access & Web Sesstion managemrnt Subroutine etc.
 ;#
 ;# Copyright (c) 2003 Masashi Hori <hori@japannet.co.jp>
 ;# JapanNet. All Rights Reserved.
 ;#
 ;#
 ;######################################################################

=cut