CGI-AppBuilder-MapSpec
view release on metacpan or search on metacpan
sub run_ldspecs {
my ($s, $ar) = @_;
my $prg = 'run_ldsepcs';
# 0. prepare parameters and check parameters
my ($spv, $rt1) = ();
my $lst_tab = 'sp_lists'; # list tab name
my $spc_tab = 'sp_specs'; # spec tab name
my $job_tab = 'sp_jobs'; # table: sp_jobs
my $wsn = 'ALL_VARS'; # spreadsheet name
# get parent id, server id, study id and list id
my $vs = 'pid,sid,study_id,list_id';
my ($pid,$sn,$sid,$lid) = $s->get_params($vs,$ar);
$sid = 0 if !$sid;
$lid = 0 if !$lid;
# $sid = $ar->{study_id} if exists $ar->{study_id} && $ar->{study_id};
# $lid = $ar->{list_id} if exists $ar->{list_id} && $ar->{list_id};
$rt1 = $ar->{xls_list} if exists $ar->{xls_list} && $ar->{xls_list};
# $rt1 = $ar->{sel_sn2} if !$rt1 && exists $ar->{sel_sn2} && $ar->{sel_sn2};
print $s->disp_header(undef,$ar);
if (!$lid) {
$s->echo_msg("ERR: ($prg) LIST ID is required.", 0);
return;
}
if (!$rt1) {
$s->echo_msg("ERR: ($prg) no XLS file is selected.", 0);
return;
}
my $ds = '/';
$ds = '\\' if $^O =~ /MSWin/i;
my $ad = eval $s->set_param('all_dir', $ar); # all dir array
my $dir = $ad->{$sn}{map}; # map dir
# $dir = join $ds, $dir, (sprintf "${sn}_%03d%03d", $sid,$lid);
$dir = join $ds, $dir, (sprintf "${sn}_%03d", $sid);
my $sqlout = $ad->{$sn}{sqlout}; # sql output dir
my $odr = "$sqlout$ds$sn";
my $rt = $rt1; $rt =~ s/\.xls$//i; # BUP115_DCS
my $fn = "$dir$ds$rt.xls"; # input file name
my $dtm = strftime "%Y%m%d_%H%M%S", localtime;
my $ymd = strftime "%Y$ds%m$ds%d", localtime;
my $sdr = join $ds, $odr, $ymd;
my $otf = "${rt}_vars_$dtm.sql"; # output file name
my $ofn = "$sdr$ds$otf"; # output file full ame
$s->echo_msg("INFO: ($prg) rt1=$rt1; rt=$rt; dir=$dir<br>\n",2);
if ($fn =~ /\s+/) {
$s->echo_msg("ERR: ($prg) there is space in file name - $fn.", 0);
$s->echo_msg("INFO: please remove the spaces in the file name!", 0);
return;
}
if (!-f $fn) {
$s->echo_msg("ERR: ($prg) could not find XLS file - $fn.", 0);
return;
}
if (!-d $sqlout) {
eval { mkpath($sqlout,0,0777) };
croak "ERR: could not mkdir - $sqlout: $!: $@<br>\n" if ($@);
system("chmod -R ugo+w $sqlout") if ($^O !~ /^MSWin/i); # non window
}
if (!-d $odr) {
eval { mkpath($odr,0,0777) };
# mkdir $odr;
croak "ERR: could not mkdir - $odr: $!: $@<br>\n" if ($@);
system("chmod -R ugo+w $odr") if ($^O !~ /^MSWin/i); # non window
}
if (!-d $sdr) {
my $y4 = strftime "%Y", localtime;
my $mn = strftime "%m", localtime;
my $dy = strftime "%d", localtime;
my @a = ();
push @a, (join $ds, $odr, $y4);
push @a, (join $ds, $odr, $y4, $mn);
push @a, (join $ds, $odr, $y4, $mn, $dy);
for my $i (0..$#a) {
my $dd = $a[$i];
if (!-d $dd) {
eval { mkpath($dd,0,0777) };
croak "ERR: could not mkdir - $dd: $!: $@<br>\n" if ($@);
system("chmod -R ugo+w $dd") if ($^O !~ /^MSWin/i); # non window
}
}
}
# 1. get list information
$s->echo_msg(" 1. get list info for list id $lid...", 1);
my $whr = " WHERE list_id = $lid ";
my $cns = 'study_id,sponsor,project_code,project_name,study_name,sp_analyst';
$cns .= ',sp_version,sp_source,standard';
my $r1 = $s->run_sqlcmd($ar, $cns, 'sp_lists', $whr);
$s->echo_msg($r1, 5);
$sid = $r1->[0]{study_id} if !$sid;
$spv = $r1->[0]{sp_version} if !$spv;
# 2. read the XLS file
$s->echo_msg(" 2. read XLS file - $fn...", 1);
my $pr = $s->read_xls($fn, $wsn);
if (!$pr || ref($pr) !~ /^ARRAY/i) {
$s->echo_msg("ERR: ($prg) Did not get any record from the file: $fn", 0);
my $m = "Please check the followings: <br>";
$m .= " * Make sure that the file is not password-protected<br>\n";
$m .= " * Make sure that there is a tab 'ALL_VARS' in the file<br>\n";
$m .= " * Make sure that you have used a correct spec template<br>\n";
$s->echo_msg("INFO: ($prg) $m", 0);
return;
}
$s->echo_msg("INFO: ($prg) no of records: $#$pr", 1);
my $r2 = {list_id => $lid
, study_id => $sid
, project_code => $pr->[0][3]
, project_name => $pr->[1][3]
, sponsor => $pr->[2][3]
, sp_date => $pr->[3][3]
, sp_analyst => $pr->[4][3]
, study_name => $pr->[5][3]
, standard => $pr->[6][3]
, sp_version => $spv
, sp_source => $fn
};
$s->echo_msg($r2, 5);
# 3. build SQL statement for sp_jobs
$s->echo_msg(" 3. build sql statement for sp_jobs...", 1);
my $sql = []; # sql array
# get job id
$cns = 'sp_jobs_seq.nextval as jid';
my $r3 = $s->run_sqlcmd($ar, $cns, 'dual', '');
my $jid = $r3->[0]{jid};
if ($jid) {
my $ctx = 'sp_context_pkg';
my $job_ins = "PROMPT Inserting into $job_tab ...\n";
$job_ins .= "INSERT INTO $job_tab ( job_id, list_id, job_name \n";
$job_ins .= " , job_args, job_type, job_crttime \n";
$job_ins .= " , job_starttime, job_inpath, job_outpath \n";
$job_ins .= " , db_user, os_user, app_user \n";
$job_ins .= " ) VALUES ($jid, $lid, null \n";
$job_ins .= " , 'sid=$sid,lid=$lid,dnm=ALL_VARS','LDSPECS', sysdate \n";
$job_ins .= " , sysdate, '$fn', '$ofn' \n";
# if ($sid !~ /^\d+$/) {
# $id = 'sid';
# $f_sid = (exists $ar->{$id} && $ar->{$id} =~ /^\d+$/)?1:0;
# $sid = ($f_sid) ? $ar->{$id} : '';
# }
$id = 'list_id';
my $f_lid = (exists $ar->{$id} && $ar->{$id} =~ /^\d+$/)?1:0;
my $lid = ($f_lid) ? $ar->{$id} : '';
$id = 'xls_list';
my $f_xls = (exists $ar->{$id} && $ar->{$id})?1:0;
my $rt1 = ($f_xls) ? $ar->{xls_list} : '';
# $rt1 = $ar->{sel_sn2} if !$rt1 && exists $ar->{sel_sn2} && $ar->{sel_sn2};
print $s->disp_header(undef,$ar);
if ("$lid" ne "0" && !$lid) {
$s->echo_msg("ERR: ($prg) LIST ID is required.", 0);
return;
}
# if ("$sid" ne "0" && !$sid) {
# $s->echo_msg("ERR: ($prg) Study ID is required.", 0);
# return;
# }
if (!$rt1) {
$s->echo_msg("ERR: ($prg) no XLS file is selected.", 0);
return;
}
my $ds = '/';
$ds = '\\' if $^O =~ /MSWin/i;
my $pid = $ar->{pid}; # parent id
my $sn = $ar->{sid}; # server id
my $ad = eval $s->set_param('all_dir', $ar); # all dir array
my $dir = $ad->{$sn}{map}; # map dir
$dir = join $ds, $dir, (sprintf "${sn}_%03d", $sid);
my $sqlout = $ad->{$sn}{sqlout}; # sql output dir
my $odr = "$sqlout$ds$sn";
my $rt = $rt1; $rt =~ s/\.xls$//i; # BUP115_DCS
my $fn = "$dir$ds$rt.xls"; # input file name
my $dtm = strftime "%Y%m%d_%H%M%S", localtime;
my $ymd = strftime "%Y$ds%m$ds%d", localtime;
my $sdr = join $ds, $odr, $ymd;
my $otf = "${rt}_vw_$dtm.sql"; # output file name
$otf =~ s/\$//g; $otf =~ s/[_]+/_/g;
my $ofn = "$sdr$ds$otf"; # output file full ame
$s->echo_msg("INFO: ($prg) rt1=$rt1; rt=$rt; dir=$dir<br>\n",2);
if ($fn =~ /\s+/) {
$s->echo_msg("ERR: ($prg) there is space in file name - $fn.", 0);
$s->echo_msg("INFO: ($prg) please remove the spaces in the file name!", 0);
return;
}
if (!-f $fn) {
$s->echo_msg("ERR: ($prg) could not find XLS file - $fn.", 0);
return;
}
if (!-d $sqlout) {
eval { mkpath($sqlout,0,0777) };
croak "ERR: ($prg) could not mkdir - $sqlout: $!: $@<br>\n" if ($@);
system("chmod -R ugo+w $sqlout") if ($^O !~ /^MSWin/i); # non window
}
if (!-d $odr) {
# eval { mkpath($odr,0,0777) };
mkdir $odr;
croak "ERR: ($prg) could not mkdir - $odr: $!: $@<br>\n" if ($@);
system("chmod -R ugo+w $odr") if ($^O !~ /^MSWin/i); # non window
}
if (!-d $sdr) {
eval { mkpath($sdr,0,0777) };
croak "ERR: ($prg) could not mkdir - $sdr: $!: $@<br>\n" if ($@);
system("chmod -R ugo+w $sdr") if ($^O !~ /^MSWin/i); # non window
}
# 1. get list information
$s->echo_msg(" 1. get list info for list id $lid...", 1);
my $whr = " WHERE list_id = $lid ";
my $cns = 'study_id,sponsor,project_code,project_name,study_name,sp_analyst';
$cns .= ',sp_version,sp_source,standard';
my $r1 = $s->run_sqlcmd($ar, $cns, $lst_tab, $whr);
$s->echo_msg($r1, 5);
$sid = $r1->[0]{study_id} if ($sid !~ /^\d+$/);
if ($sid !~ /^\d+$/) {
$s->echo_msg("WARN: ($prg) no study id ($sid) is found for list_id=$lid.", 1);
} else {
$s->echo_msg("INFO: study id ($sid) is found for list_id=$lid.", 1);
}
$whr = " WHERE study_id = $sid ";
$cns = "src_schema,stg_schema";
my $r2 = $s->run_sqlcmd($ar, $cns, $sty_tab, $whr);
my $src_sch = uc $r2->[0]{src_schema};
my $stg_sch = uc $r2->[0]{stg_schema};
# get job id
$cns = 'sp_jobs_seq.nextval as jid';
my $r3 = $s->run_sqlcmd($ar, $cns, 'dual', '');
my $jid = $r3->[0]{jid};
# 2. read the XLS file
$s->echo_msg(" 2. read XLS file - $fn...", 1);
my $pr = $s->read_xls($fn, $wsn, 1);
my $cr = {};
my $vvn = '';
for my $k (keys %{$pr}) {
my $sch = uc $pr->{$k}[1][2]; # C2: schema name
$sch =~ s/^\s*//; $sch =~ s/\s*$//;
my $vwn = uc $pr->{$k}[2][2]; # C3: view name
$vwn =~ s/^\s*//; $vwn =~ s/\s*$//;
$vvn .= ($vvn) ? ",$vwn" : "$vwn";
my $vtp = uc $pr->{$k}[3][2]; # C4: view type
my $vmg = "INFO: ($prg) number of records in $k($sch.$vwn\[$vtp\])";
$s->echo_msg( "$vmg: $#{$pr->{$k}}", 1);
if ("$sch" ne "$src_sch") {
$s->echo_msg("WARN: ($prg) Schema names do not match: $sch <> $src_sch",0);
}
# $sch = $src_sch if !$sch;
$sch = $src_sch if $src_sch;
$vwn = $k if !$vwn;
$vtp = 'VIEW' if !$vtp;
my $i = -1;
if ($vtp =~ /^DROP/i) {
++$i;
$cr->{$k}[$i] = {code_id => 'sp_codes_seq.nextval'
, list_id => $lid
, schema_name => $sch
, obj_name => $vwn
, obj_type => $vtp
, seq_number => $i + 1
, code_text => "DROP $sch.$vwn"
};
next;
}
( run in 0.500 second using v1.01-cache-2.11-cpan-cdf2f3d4e48 )