<html><head><meta name="color-scheme" content="light dark"></head><body><pre style="word-wrap: break-word; white-space: pre-wrap;">package par_system;

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

=head1 NAME

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

=head1 概要

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

=head1 サブルーチン

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

;; our $VERSION = '0.00';
@ISA = qw(DBI);
use strict;
use DBI;
use Jcode;

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

=head2 ＤＢオープン [new]

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

=cut
	my $class = shift;
        my $self ;
	my $user = 'par_system';
	my $password = 'sne_par';
						# shell変数セット
	local $ENV{ORACLE_HOME} = '/usr/lib/oracle/10.1.0.4/client';
	local $ENV{NLS_LANG} = 'Japanese_Japan.JA16EUC'; # SJISだとerrorになる

        eval{
                $self-&gt;{'dbh'} = DBI-&gt;connect('dbi:Oracle:productc'
				,$user,$password)
                                        or die $DBI::errstr;
        };
        bless $self,$class;
	$self-&gt;{user} = $user;
        return  $self ;
}

sub tisel{
	my $s = shift;
	my $ref = shift;
	my @item;
	for(keys %{$ref}){
		push @item,"$_ = '$ref-&gt;{$_}'";
	}
}
sub euc2sj{
	my $s = shift;
	my $text = shift;
	return jcode($text,"euc")-&gt;sjis;
}
sub sj2euc{
	my $s = shift;
	my $text = shift;
	return jcode($text,"sjis")-&gt;euc;
}
sub urlencode{
	my $s = shift;
	my $text = shift;
	$text =~ s/([^(\w|=|&amp;)])/'%' . unpack('H2',$1)/eg;
	return $text;
}
sub lt_u{
	my $s = shift;
	my $r = shift;
	my $ret = $r-&gt;{LT};
	if($r-&gt;{LT_UNIT} eq '1 '){ $ret .= "日";}
	elsif($r-&gt;{LT_UNIT} eq '2 '){ $ret .= "時";}
	elsif($r-&gt;{LT_UNIT} eq '3 '){ $ret .= "分";}
	elsif($r-&gt;{LT_UNIT} eq '4 '){ $ret .= "秒";}
	else{$ret .= "[$r-&gt;{LT_UNIT}]";}
	return $ret;
}
sub trim{
	my $s = shift;
	my $text = shift;
	$text =~ s/\s+$//;
	return $text;
}
sub zsup{
	my $s = shift;
	my $text = shift;
	if($text == 0){
		$text = "";
	}
	return $text;
}
#---------------------------------------------------------------#
sub look_up{
#---------------------------------------------------------------#

=head2 look_up

参照テーブルを参照する。

=cut

	my $s =shift;
	my ($sql,$para) = @_;
	my @para;
	for (@$para){
		if(ref($_) eq 'CODE'){
			push @para,&amp;$_;
		}else{ push @para,$_;
		}
	}
	my $sth = $s-&gt;{dbh}-&gt;prepare(qq{$sql});
	$sth-&gt;execute(@para);
	my $ref = $sth-&gt;fetchrow_arrayref();
	return $ref;
}

=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 get_slip_no{
	my $s = shift;
	my $slip_cod = shift;
	my $ymd = shift;

	my ($y,$m,$d) = $s-&gt;ymd_split($ymd);
	my $years = sprintf("%04d%02d",$y,$m);

	my $seq_no = 0;
	my $find = 0;
	my $sql = "";
	$sql  = " select SEQ_NO from TD_SLIP_SEQ";
	$sql .= " where SLIP_COD = '".$slip_cod."' and SLIP_YEARS = ".$years;
	my $sth = $s-&gt;{dbh}-&gt;prepare($sql);
	$sth-&gt;execute();
	if(my $ref = $sth-&gt;fetchrow_arrayref()){
		$seq_no = $ref-&gt;[0];
		$find = 1;
	}
	$sth-&gt;finish();

	$seq_no++;

	if($find == 0){
		$sql  = " insert into TD_SLIP_SEQ (SLIP_COD, SLIP_YEARS, SEQ_NO)";
		$sql .= " values('".$slip_cod."',".$years.",".$seq_no.")";
	}else{
		$sql  = " update TD_SLIP_SEQ set SEQ_NO = ".$seq_no;
		$sql .= " where SLIP_COD = '".$slip_cod."' and SLIP_YEARS = ".$years;
	}
	$sth = $s-&gt;{dbh}-&gt;prepare($sql);
	$sth-&gt;execute();
	$sth-&gt;finish();

	my $ym = substr($y,2,2);
	if($m == 10){
		$ym .= "X";
	}elsif($m == 11){
		$ym .= "Y";
	}elsif($m == 12){
		$ym .= "Z";
	}else{
		$ym .= ($m+0);
	}
	return $slip_cod.$ym.sprintf("%05d",$seq_no);
}
sub get_receipt_no{
	my $s = shift;
	my $ymd = shift;

	return $s-&gt;get_slip_no("RE", $ymd);
}

sub get_report_no{
	my $s = shift;
	my $slip_cod = "MH";
	my $ymd = shift;

	my ($y,$m,$d) = $s-&gt;ymd_split($ymd);
	my $years = $y;

	my $seq_no = 0;
	my $find = 0;
	my $sql = "";
	$sql  = " select SEQ_NO from TD_SLIP_SEQ";
	$sql .= " where SLIP_COD = '".$slip_cod."' and SLIP_YEARS = ".$years;
	my $sth = $s-&gt;{dbh}-&gt;prepare($sql);
	$sth-&gt;execute();
	if(my $ref = $sth-&gt;fetchrow_arrayref()){
		$seq_no = $ref-&gt;[0];
		$find = 1;
	}
	$sth-&gt;finish();

	$seq_no++;

	if($find == 0){
		$sql  = " insert into TD_SLIP_SEQ (SLIP_COD, SLIP_YEARS, SEQ_NO)";
		$sql .= " values('".$slip_cod."',".$years.",".$seq_no.")";
	}else{
		$sql  = " update TD_SLIP_SEQ set SEQ_NO = ".$seq_no;
		$sql .= " where SLIP_COD = '".$slip_cod."' and SLIP_YEARS = ".$years;
	}
	$sth = $s-&gt;{dbh}-&gt;prepare($sql);
	$sth-&gt;execute();
	$sth-&gt;finish();

	my $ym = substr($y,2,2);
	return $ym.$slip_cod.sprintf("%03d",$seq_no);
}
1;
__END__

=head1 AUTHOR INFORMATION

 ;######################################################################
 ;#
 ;# par_system.pm: PAR_SYSTEM ACCESS Sub Routine.
 ;#
 ;# Copyright (c) 2007 Ryuhji Saitoh &lt;saitoh.ryuhji@sharp.co.jp&gt;
 ;# JapanNet. All Rights Reserved.
 ;#
 ;#
 ;######################################################################

=cut

</pre></body></html>