CGI-AppBuilder-MapDisps
view release on metacpan or search on metacpan
MapDisps.pm view on Meta::CPAN
my $sn = $pr->{sid}; # server id
my $url = $pr->{web_url}; # web URL
$url =~ s/(\?.*)//; # remove parameters
$url .= "?pid=ckpt&no_dispform=1&sel_sn1=$pr->{sid}";
if ($ar->{new_task} =~ /^run_allin1/i) {
$s->form_allin1($q,$ar);
} else {
$s->new_form($q,$ar);
}
}
=head2 disp_cpsj($q,$ar)
Input variables:
$q - CGI class
$ar - array ref containing the following variables:
pid : project id such as ckpt, owb, dba, etc.
task : task name required such as task1,task2,etc.
target(sel_sn1) : select one (DB/server name) defining sid
args(sel_sn2) : select two (Arguments)
task_fn : task file name containing all the tasks defined
svr_conn : host/server connection info
db_conn : db connection info for each target/server
task_conn : special connection for tasks.
It overwrites db_conn for the task
Variables used or routines called:
None
How to use:
Return: $pr will contain the parameters adn output from running the PL/SQL.
=cut
sub disp_cpsj {
my ($s, $q, $ar) = @_;
my $prg = 'AppBuilder::Tasks->disp_cpsj';
my $ids = 'cln_id,prj_id,study_id,list_id,job_id,hjob_id';
$ids .= ',id_type,study_name,list_name,cln_name,prj_name,job_name';
$ids .= ',client_name,list_name';
my $p = {};
foreach my $k (split /,/, $ids) {
if ($k =~ /id$/i) {
$p->{$k} = (exists $ar->{$k} && $ar->{$k} =~ /^\d+$/) ?
$ar->{$k} : '';
} else {
$p->{$k} = (exists $ar->{$k} && $ar->{$k}) ? $ar->{$k} : '';
}
}
my $pr = $s->def_inputvars($ar);
my $pid = (exists $pr->{pid} && $pr->{pid}) ? $pr->{pid} : '';
if (!$pid) {
$s->echo_msg("ERR: ($prg) pid is not defined.", 0); return;
}
my $usr_gid = (exists $ar->{guid}) ? $ar->{guid} : "";
my $ug = ($usr_gid) ? "&guid=$usr_gid" : "";
foreach my $k (split /,/, $ids) {
$p->{$k} = $pr->{$k} if exists $pr->{$k};
}
my $k = 'cln_id';
my $t1 = ($p->{$k} =~ /^\d+$/) ? "&$k=$p->{$k}" : '';
$k = 'cln_name';
$t1 .= ($p->{$k}) ? "&$k=$p->{$k}" : '';
my $t2 = $t1;
$k = 'prj_id';
$t2 .= ($p->{$k} =~ /^\d+$/) ? "&$k=$p->{$k}" : '';
$k = 'prj_name';
$t2 .= ($p->{$k}) ? "&$k=$p->{$k}" : '';
my $t3 = $t2;
$k = 'study_id';
$t3 .= ($p->{$k} =~ /^\d+$/) ? "&$k=$p->{$k}" : '';
$k = 'study_name';
$t3 .= ($p->{$k}) ? "&$k=$p->{$k}" : '';
# my $t4 = $t3;
# $k = 'job_id';
# $t4 .= ($p->{$k} =~ /^\d+$/) ? "&$k=$p->{$k}" : '';
# $k = 'job_name';
# $t4 .= ($p->{$k}) ? "&$k=$p->{$k}" : '';
my $t4 = $t3;
$k = 'list_id';
$t4 .= ($p->{$k} =~ /^\d+$/) ? "&$k=$p->{$k}" : '';
$k = 'list_name';
$t4 .= ($p->{$k}) ? "&$k=$p->{$k}" : '';
# my $t = '';
# foreach my $k (split /,/, $ids) {
# if ($k =~ /id$/i && $k ne 'pid') {
# $t .= "&$k=$p->{$k}" if $p->{$k} =~ /^\d+$/;
# } else {
# $t .= "&$k=$p->{$k}" if $p->{$k};
# }
# }
my $sn = $pr->{sid}; # server id
my $url = $pr->{web_url}; # web URL
$url .= "?pid=$pid&no_dispform=1&sel_sn1=$sn$ug";
my $u1 = "$url&task=disp_client$t1";
my $u2 = "$url&task=disp_project$t2";
my $u3 = "$url&task=disp_study$t3";
my $u4 = "$url&task=disp_list$t4";
my $f_ht = "<html>\n<head>\n<link rel=\"canonical\" href=\"%s\" />\n";
$f_ht .= "<meta http-equiv=\"refresh\" content=\"2; ";
$f_ht .= "URL=%s\" target=%s>\n";
$f_ht .= "</head>\n</html>\n";
my $f_fm = "<html>\n";
$f_fm .= "<FRAMESET cols='1/4,1/4,1/4,1/4' name='D' frameborder=no ";
$f_fm .= "border=0 framespacing=0>\n";
$f_fm .= "<FRAME src='$u1' name='D1'>\n";
$f_fm .= "<FRAME src='$u2' name='D2'>\n";
$f_fm .= "<FRAME src='$u3' name='D3'>\n";
$f_fm .= "<FRAME src='$u4' name='D4'>\n";
$f_fm .= "</FRAMESET>\n</html>\n";
print "$f_fm";
MapDisps.pm view on Meta::CPAN
Input variables:
$q - CGI class
$ar - array ref containing the following variables:
Variables used or routines called:
None
How to use:
Return: None
History:
08/28/2013 (htu): -
1. added code to only show USS and ASJ if the user role is dev
2. display run_setanypwd if user role is adm
=cut
sub disp_map_task {
my ($s, $q, $ar) = @_;
my $prg = 'disp_map_task';
my $ovs = eval $s->set_param('opf_values', $ar);
my $ols = eval $s->set_param('opf_labels', $ar);
my $alb = eval $s->set_param('act_labels',$ar);
my $usr_rls = (exists $ar->{usr_roles}) ? (eval $ar->{usr_roles}) : {};
my $rls = {};
foreach my $k (keys %$usr_rls) {
for my $i (0..$#{$usr_rls->{$k}}) {
my $u = $usr_rls->{$k}[$i];
$rls->{$k}{$u} = 1;
}
}
# my $ids = $s->get_ids($ar);
my ($t, $gf) = ();
print $s->disp_header($q, $ar);
my $f_op = " <option value=\"%s\">%s</option>\n";
my $f_li = " <li><a href=\"%s\">%s</a></li>\n";
my $f_in = " <input name=\"%s\" value=\"%s\" type=\"%s\" />\n";
my $f_ih = " <input type=\"hidden\" name=\"%s\" value=\"%s\" />\n";
my $f_bb = "<b>%s</b>\n";
my $f_aa = "<a href=\"%s\" target=R>%s</a>\n";
my $f_a2 = "<a href=\"%s\" target=\"%s\" title=\"%s\">%s</a>\n";
my $f_fm = "<form method=\"$ar->{method}\" action=\"$ar->{action}?\" ";
$f_fm .= "enctype=\"$ar->{encoding}\" name=\"oraForm\" target=\"%s\">\n";
$f_fm .= "%s\n</form>\n";
my $pr = $s->def_inputvars($ar);
my $pid = $pr->{pid}; # project id: ckpt, dba, owb
my $sn = $pr->{sid}; # server id
$s->set_ids($ar);
my $vs = 'user_sid,user_uid,user_tmo,guid';
my ($usr_sid,$usr_uid,$usr_tmo,$usr_gid) = $s->get_params($vs, $ar);
my $url = $pr->{web_url}; # web URL
$url .= "?pid=$pid&no_dispform=1&sel_sn1=$sn";
$url .= (exists $ar->{logout} && $ar->{logout}) ? "" : "&guid=$usr_gid";
if (!$pid) {
$s->echo_msg("ERR: ($prg) PID has not been defined.",0); return;
}
if (!$sn) {
$s->echo_msg("ERR: ($prg) SID has not been defined.",0); return;
}
my $url4frd = {};
$url4frd = eval $ar->{url4frd} if exists $ar->{url4frd} && $ar->{url4frd};
my $sp4 = " ";
my $id = 'cln_id';
my $f_cid = (!exists $ar->{$id} || !defined($ar->{$id}) || $ar->{$id} !~ /^\d+$/) ? 0 : 1;
$id = 'prj_id';
my $f_pid = (!exists $ar->{$id} || !defined($ar->{$id}) || $ar->{$id} !~ /^\d+$/) ? 0 : 1;
$id = 'study_id';
my $f_sid = (!exists $ar->{$id} || !defined($ar->{$id}) || $ar->{$id} !~ /^\d+$/) ? 0 : 1;
$id = 'job_id';
my $f_jid = (!exists $ar->{$id} || !defined($ar->{$id}) || $ar->{$id} !~ /^\d+$/) ? 0 : 1;
$id = 'hjob_id';
my $f_hid = (!exists $ar->{$id} || !defined($ar->{$id}) || $ar->{$id} !~ /^\d+$/) ? 0 : 1;
$id = 'list_id';
my $f_lid = (!exists $ar->{$id} || !defined($ar->{$id}) || $ar->{$id} !~ /^\d+$/) ? 0 : 1;
my $u9a = "$url&task=disp_cpsj";
$u9a .= "&cln_id=$ar->{cln_id}" if $f_cid;
$u9a .= "&prj_id=$ar->{prj_id}" if $f_pid;
$u9a .= "&study_id=$ar->{study_id}" if $f_sid;
$u9a .= "&job_id=$ar->{job_id}" if $f_jid;
$u9a .= "&hjob_id=$ar->{hjob_id}" if $f_hid;
$u9a .= "&list_id=$ar->{list_id}" if $f_lid;
$u9a .= "&client_name=$ar->{client_name}" if exists $ar->{client_name};
$u9a .= "&cln_name=$ar->{cln_name}" if exists $ar->{cln_name};
$u9a .= "&prj_name=$ar->{prj_name}" if exists $ar->{prj_name};
$u9a .= "&study_name=$ar->{study_name}" if exists $ar->{study_name};
$u9a .= "&job_name=$ar->{job_name}" if exists $ar->{job_name};
$u9a .= "&list_name=$ar->{list_name}" if exists $ar->{list_name};
my $s9a = sprintf $f_a2, $u9a , "D" ,"Expand panel tree to left" ,"Expand->";
$t .= "<p align=right>$sp4 $s9a</p><hr>\n" if $f_cid && $f_pid && $f_sid && $f_lid;
# 1 - DB: <b>VP on VPAPP2</b><br>
my $u1a = "$url&task=disp_new&new_task=run_adduser";
my $u1b = "$url&task=disp_new&new_task=run_login";
my $u1c = "$url&task=disp_new&new_task=run_logout";
my $u1d = "$url&task=disp_new&new_task=run_chgpwd";
my $u1e = "$url&task=disp_new&new_task=run_setpwd";
my $u1f = "$url&task=disp_new&new_task=run_setanypwd";
my $s1a = sprintf $f_a2, $u1a, "R", "Add a User" , "AddUsr";
my $s1b = sprintf $f_a2, $u1b, "R", "Login User" , "Login";
my $s1c = sprintf $f_a2, $u1c, "R", "Logout User" , "Logout";
my $s1d = sprintf $f_a2, $u1d, "R", "Change User's PWD", "ChgPWD";
my $s1e = sprintf $f_a2, $u1e, "R", "Set to Default PWD", "SetPWD";
$s1e = sprintf $f_a2, $u1f, "R", "Set Anyone to Default PWD", "SetPWD"
if exists $rls->{adm}{$usr_uid};
if (!$sn) {
$gf = '<select name="sel_sn1" class="formField" >\n';
for my $i (0..$#$ovs) { $gf .= sprintf $f_op, $ovs->[$i], $ols->{$ovs->[$i]}; }
MapDisps.pm view on Meta::CPAN
for my $i (0..$#$rr) {
my $dir = $rr->[$i]{job_outpath}; $dir =~ s/^\s*//g; $dir =~ s/\s*$//g;
my $jid = $rr->[$i]{job_id};
my $stm = $rr->[$i]{job_starttime};
my $sta = $rr->[$i]{job_status};
my $typ = $rr->[$i]{job_type};
next if $dir =~ /^\s*$/;
my @aa = ();
if (-f $dir || $dir =~ /\.(sql|txt|sas)$/) {
push @aa, $dir;
my ($txf) = ($dir =~ /(.+)\.sql$/);
$txf = "$txf.txt";
push @aa, $txf if (-f $txf);
} elsif (-d $dir || $dir =~ /^\\\\/) {
opendir DD, "$dir" or $s->echo_msg("ERR: ($prg) Could not open dir - $dir for job_id=$jid: $!",0);
@aa = sort grep /^$jid/, readdir DD;
closedir DD;
for my $i (0..$#aa) { $aa[$i] = join $ds, $dir, $aa[$i]; }
} else {
$s->echo_msg("WARN: ($prg) could not find dir or file - $dir.",1);
# next;
}
$t .= " <li> $jid - <a href='#' title='$dir'>$stm: $typ $sta</a>\n";
$t .= $s->disp_linkedfiles(undef, $ar, \@aa, 1) if @aa;
}
$t .= "</ul>\n";
print $t;
# print $s->build_links($rr, $ar);
return;
}
=head2 build_links($q,$pr,$ar)
Input variables:
$pr - array ref containing id and name
$ar - array ref containing the following variables:
Variables used or routines called:
None
How to use:
Return: None
=cut
sub build_links {
my ($s, $pr, $ar) = @_;
# 0 - return if $pr is empty
if (!$pr || $#$pr < 0) {
$s->echo_msg("WARN: No records.",0); return;
}
# 1. define variables
my $vs = 'pid,sid,guid,web_url,task';
my ($pid,$sid,$usr_gid,$url,$tsk) = $s->get_params($vs,$ar);
$sid = $ar->{sel_sn1} if !$sid && exists $ar->{sel_sn1};
my $tgt = (exists $ar->{fr_tgt}) ? $ar->{fr_tgt} : "R"; # frame target
my $tk = $tsk; $tk =~ s/(disp_)//;
my $tr = {'client'=>'project','project'=>'study','study'=>'list','list'=>'job' };
my $br = {'client'=>'','project'=>'cln','study'=>'prj','list'=>'study'
,'job'=>'list' };
my $tg = {'client'=>'D2','project'=>'D3','study'=>'D4','list'=>'R' };
my $id = {'client'=>'cln_id','project'=>'prj_id','study'=>'study_id'
,'list'=>'list_id','spec'=>'spec_id', 'job'=>'job_id' };
my $nm = {'client'=>'cln_name','project'=>'prj_name','study'=>'study_name'
,'list'=>'sponsor','spec'=>'source_dataset', 'job'=>'job_name' };
$url =~ s/(\?.*)// if $url; # remove parameters
$url .= "?pid=$pid&sel_sn1=$sid&guid=$usr_gid";
# 2. check required variables
if (!$pid) {
$s->echo_msg("ERR: could not find pid in build_links.",0); return;
}
if (!$sid) {
$s->echo_msg("ERR: could not find sid in build_links.",0); return;
}
# 3. build links
my $f_aa = " <a href=\"%s\" target=\"%s\" title=\"%s\">%s</a>\n";
my $f_bb = "<b>%s</b>\n";
my $f_li = " <li>%s</li>\n";
my $ttk = (exists $tr->{$tk} && $tr->{$tk}) ? $tr->{$tk} : "";
my $vr = $ar->{var_arf};
my $u_lf = "$url&task=disp_map_task";
my $u_rt = "$url&task=disp_$ttk";
my $u_ct = "$url&task=disp_new&new_task=add_$ttk";
# my $ids = 'cln_id,prj_id,study_id,job_id,hjob_id';
my $cnt_ar = {};
foreach my $kk (keys %$id) {
my $k = $id->{$kk};
my $n = $nm->{$kk};
if (exists $ar->{$k} && $ar->{$k}) {
$u_lf .= "&$k=$ar->{$k}";
$u_rt .= "&$k=$ar->{$k}";
$u_ct .= "&$k=$ar->{$k}";
}
if (exists $ar->{$n} && $ar->{$n}) {
$u_lf .= "&$n=$ar->{$n}";
$u_rt .= "&$n=$ar->{$n}";
$u_ct .= "&$n=$ar->{$n}";
}
# $cnt_ar->{$n} += 1;
}
my $q = CGI->new;
my $t = $s->disp_header($q,$ar);
$t .= "<center>" . (sprintf $f_bb, uc($tk)) . ': ';
# $t = sprintf $f_aa, "$url&task=disp_new&new_task=add_$tk", 'R', "Add $tk", $t;
# $t .= "<ul>\n";
my $v_id = $vr->[0];
my $v_nm = $vr->[1];
my $k1 = $br->{$tk} . '_id';
my $n1 = $br->{$tk} . '_name';
my $kn = (exists $ar->{$n1}) ? "$ar->{$k1} - $ar->{$n1}" : "Add $tk";
my $u1 = "$url&task=disp_new&new_task=add_$tk&$k1=$ar->{$k1}";
$t .= (sprintf $f_aa, $u1 ,"R","Add $tk",$kn) . "</center>";
$t .= "<br>\n";
# $s->disp_param($pr);
# print "VID=$v_id, VNM=$v_nm<br>\n";
for my $i (0..$#$pr) {
next if ref($pr->[$i]) !~ /^HASH/;
my $k = $pr->[$i]{$v_id};
my $v = $pr->[$i]{$v_nm};
my $uk = "$id->{$tk}=$k";
my $un = "$nm->{$tk}=$v";
( run in 2.284 seconds using v1.01-cache-2.11-cpan-97f6503c9c8 )