随分、久しぶりのperl。で、以下のような感じかと思います。
ポイントは、接続する為の環境変数設定です
#!/usr/local/bin/perl use utf8; use strict; use warnings; use DBI; #use DBD::Sybase; use Encode; use Time::Piece; use Time::Seconds; my $CONF = { db=>{user => 'ないしょ', passwd => 'ないしょ', name => 'ないしょ', server => 'ないしょ', charset=> 'utf8', option =>{ RaiseError=>1, AutoCommit=>0} }, env=>{ SYBASE =>"/opt/sap", SYBROOT=>"/opt/sap", SCROOT =>"/opt/sap/shared/sybcentral43", LANG =>"C", SYBASE_SYSAM2=>"SYSAM-2_0", SYBASE_OCS =>"OCS-15_0", SYBASE_ASE =>"ASE-15_0", SYBASE_JRE =>"/opt/sap/shared/jre142_013", LD_LIBRARY_PATH=> "/opt/sap/OCS-15_0/lib:/opt/sap/OCS-15_0/lib3p:/opt/sap/ASE-15_0/lib:", LIB=>"/opt/sap/OCS-15_0/lib:", INCLUDE=>"/opt/sap/OCS-15_0/include:" }, common=> { select_age=>365 * 20, cad_base_dir=>"/backup/nsdata/nsimage", tsv_base_dir=>"/tmp", } }; my $ZUMEN_TYPES = { kumitate_tejun =>["100"], sekou_manual =>["90"], #buhin =>["9","10","11","12","13","14","15"], #shousai =>["30"], #waritsuke =>["20","21","22","25","71","72","73","74","75"], }; my $ZUMEN_TYPE_JP = { kumitate_tejun =>"組立手順書", sekou_manual =>"施工マニュアル", buhin =>"部品図", shousai =>"詳細図", waritsuke =>"割付図", }; main(); sub main { my $dbh = connect_db(); for my $zumen_type ( sort keys %$ZUMEN_TYPES ){ my $zumen_infos = select_zumens($dbh,$zumen_type); write_to_tsv($zumen_type,$zumen_infos); } $dbh->disconnect(); } sub write_to_tsv { my ($zumen_type,$zumen_infos) = @_; my $tsv_path = "$CONF->{common}->{tsv_base_dir}/zumens_$zumen_type.tsv"; open(my $fh, ">", $tsv_path) or die "fail open $tsv_path $!"; my @out_keys = qw/plan_num addition_num revision name_kanji create_day style_num cad_or_image cad_data cad_path/; print $fh join("\t",@out_keys),"\n"; for my $zumen_info ( @$zumen_infos ){ my @out_cols; for my $out_key (@out_keys){ push(@out_cols,Encode::encode("utf8",$zumen_info->{$out_key})); } print $fh join("\t",@out_cols),"\n"; } close($fh); return $tsv_path; } sub select_zumens { my ($dbh,$zumen_type) = @_; my @sql_vals = @{$ZUMEN_TYPES->{$zumen_type}}; my @sql_args = ("?") x scalar( @sql_vals ); my $sql_args_str = join(",",@sql_args); my $zumen_type_ids = join(",",); my $sql =<<EOF; SELECT plan_num, addition_num, revision, name_kanji, create_day, style_num, cad_or_image, cad_data FROM plan_attr WHERE style_num IN ($sql_args_str) AND (create_day BETWEEN ? AND ?) ORDER BY plan_num, addition_num, revision DESC EOF my $sth = $dbh->prepare($sql); my $today = localtime; my $from_date = $today - ONE_DAY * $CONF->{common}->{select_age}; push(@sql_vals,($from_date->ymd(""), $today->ymd(""))); unless( $sth->execute( @sql_vals ) ){ print STDERR $sth->errstr, "\n"; return []; } my $zumen_type_jp = $ZUMEN_TYPE_JP->{$zumen_type}; my $ret_data = []; my $pre_plan_addition_num = ""; while( my $row = $sth->fetchrow_hashref){ my $plan_addition_num = join(" ",$row->{plan_num},$row->{addition_num}); if ($plan_addition_num eq $pre_plan_addition_num){ next; #最新版数のみを対象とする為 } $pre_plan_addition_num = $plan_addition_num; if ( index($row->{plan_num},"#") >= 0 ){ # 試作図面はskip next; } if ( scalar(split(/;/,$row->{cad_data})) < 4 ){ # 図面未作成 next; } ; if ($row->{cad_or_image} eq "C" or $row->{cad_or_image} eq "A"){ $row->{cad_path} = conv_cad_path($row); } elsif ($row->{cad_or_image} eq "I" or $row->{cad_or_image} eq "i"){ $row->{cad_path} = conv_tiff_path($row); } else { next; } $row->{name_kanji} = join(" ",$zumen_type_jp,conv_name_kanji($row)); push(@$ret_data,$row); } return $ret_data; } sub conv_tiff_path { my ($zumen_info) = @_; my @dir_cols = split(/;/,$zumen_info->{cad_data}); my $tiff_dir = join("/", $dir_cols[3], $dir_cols[1], "image", $dir_cols[2]); my $tiff_file = join("-", trim($zumen_info->{plan_num}), trim($zumen_info->{addition_num}), sprintf("%03d",$zumen_info->{revision})); $tiff_file .= ".120"; my $tiff_path = "$CONF->{common}->{cad_base_dir}$tiff_dir/$tiff_file"; return $tiff_path; } sub conv_name_kanji { my ($zumen_info) = @_; my $name_kanji = Encode::decode("utf-8",$zumen_info->{name_kanji}); $name_kanji = trim($name_kanji); $name_kanji =~ s/[ \s]+/ /go; return $name_kanji; } sub conv_cad_path { my ($zumen_info) = @_; my @dir_cols = split(/;/,$zumen_info->{cad_data}); my $cad_dir = join("/", $dir_cols[3], $dir_cols[1], "cad", $dir_cols[2]); my $cad_file = join("-", trim($zumen_info->{plan_num}), trim($zumen_info->{addition_num}), sprintf("%03d",$zumen_info->{revision}), "cad"); my $cad_path = "$CONF->{common}->{cad_base_dir}$cad_dir/$cad_file"; return $cad_path; } sub connect_db { init_env(); my $dsn = join(';', ("dbi:Sybase:server=$CONF->{db}->{server}", "database=$CONF->{db}->{name}", "charset=$CONF->{db}->{charset}")); my $dbh = DBI->connect($dsn, $CONF->{db}->{user}, $CONF->{db}->{passwd}, $CONF->{db}->{option} ); if($@) { die $@ } return $dbh; } sub init_env { for my $atri_key ( keys %{$CONF->{env} }){ $ENV{$atri_key} = $CONF->{env}->{$atri_key}; } } sub trim { my ($val) = @_; $val =~ s/^[\s ]*(.*?)[\s ]*$/$1/go; return $val; }
