You can not select more than 25 topics Topics must start with a letter or number, can include dashes ('-') and can be up to 35 characters long.
 
 
 
 
 
 

232 lines
6.4 KiB

#!/usr/bin/perl
#
# $Id: treplica.pl
#
# Source File: treplica.pl
# Get config
require 'sitecfg.pl';
require 'testlib.pl';
&app_initialize;
print "Content-Type: text/html\n\n";
if (&get_session($FORM{'tid'})) {
my $show_template = "selectpg";
&LanguageSupportInit();
$FORM{'respmsg'} = "";
if ($FORM{'dbop'} eq 'hc') {
# client selection header frame
$show_template="trepclient";
} elsif ($FORM{'dbop'} eq 'ht') {
# test selection header frame
&get_client_profile($FORM{'clid'});
$show_template=($FORM{'clid'} eq '') ? "selectpg" : "treptest";
} elsif ($FORM{'dbop'} eq 'hu') {
# test selection header frame
&get_client_profile($FORM{'clid'});
$FORM{'testcandidates'}=&get_test_candidates($FORM{'clid'},$FORM{'tstid'},$testpending);
$FORM{'tccount'}=($FORM{'testcandidates'} eq '') ? 0 : 1;
$show_template=($FORM{'tstid'} eq '') ? "selectpg" : "trepcnd";
} elsif ($FORM{'dbop'} eq 'dtl') {
# test replication detail save
if ($FORM{'cndid'} eq '') {
$show_template="selectpg";
} else {
&get_client_profile($FORM{'clid'});
&get_test_profile($FORM{'clid'},$FORM{'tstid'});
&get_candidate_profile($FORM{'clid'},$FORM{'cndid'});
&get_test_sequence($CLIENT{'clid'},$CANDIDATE{'uid'},$TEST{'id'},$testpending);
$show_template="treplica";
}
} elsif ($FORM{'dbop'} eq 's') {
&replicate_test($FORM{'clid'},$FORM{'cndid'},$FORM{'tstid'});
$show_template="";
}
&show_template($show_template);
} else {
&show_illegal_access_warning;
}
sub get_test_candidates {
my ($clid,$tstid,$dir) = @_;
my $html="";
my @cnds=();
my @recs=();
my $rec;
my $reclid;
my $recndid;
my $rectst;
opendir (TMPDIR, "$dir") or return $html;
@cnds = readdir(TMPDIR);
closedir TMPDIR;
my @recs=grep( /^$clid\.(.*)\.$tstid/ , @cnds);
@cnds=();
foreach $rec (@recs) {
($reclid,$recndid,$rectst)=&split_test_filename($rec,$clid,$tstid);
if (($reclid eq $clid) && ($rectst eq $tstid)) {
if (&get_candidate_profile($clid,$recndid)) {
$html=join('',$html,"<option value=\"$CANDIDATE{'uid'}\">$CANDIDATE{'nml'}, $CANDIDATE{'nmf'} $CANDIDATE{'nmm'}\n");
}
}
}
return $html;
}
sub replicate_test {
my ($clid,$cndid,$tstid) = @_;
&print_report_header();
#
# Make sure the submitted form contains a list
#
my @usrs=split(/\/\^\//, $FORM{'utlist'});
my $ncnt=$#usrs+1;
if ($ncnt == -1) {
print "Nothing submitted for replication.<br>\n";
&print_report_footer();
return;
} else {
print "$ncnt submitted for replication.<br>\n";
}
#
# Make a list of User Profiles and Access Control List Entries
#
my @flds=();
my $rec;
my @sortedusrs = sort @usrs;
my @tacls=grep( /^ACL/,@sortedusrs);
@usrs=grep( /^USR/, @sortedusrs);
@sortedusrs=();
#
# Get the test master to replicate
#
&get_client_profile($clid);
&get_test_profile($clid,$tstid);
&get_candidate_profile($clid,$cndid);
&get_test_sequence($clid,$cndid,$tstid,$testpending);
print "Retrieved Master $CLIENT{'clid'} $CANDIDATE{'uid'} $TEST{'id'} for replication.<br>\n";
my $replaceprofile=($FORM{'profexst'} eq 'r') ? 1 : 0;;
my $updateprofile=($FORM{'profexst'} eq 'u') ? 1 : 0;;
my $erroroutprofile=($FORM{'profexst'} eq 'e') ? 1 : 0;;
my $bOK;
my $emsg="";
$ncnt=$#usrs+1;
if ($ncnt == -1) {
print "No user profiles submitted for replication.<br>\n";
} else {
print "Processing $ncnt user profiles submitted for replication.<br>\n";
foreach $rec (@usrs) {
$bOK=1;
$emsg="";
@flds=split(/\,/, $rec);
$FORM{'uid'}=$flds[1];
$FORM{'pwd'}=$flds[2];
$FORM{'sal'}="";
$FORM{'nmf'}=$flds[3];
$FORM{'nmm'}=$flds[4];
$FORM{'nml'}=$flds[5];
$FORM{'adr'}=$flds[6];
$FORM{'cty'}=$flds[7];
$FORM{'ste'}=$flds[8];
$FORM{'pst'}=$flds[9];
$FORM{'ctry'}=$flds[10];
$FORM{'eml'}=$flds[11];
$FORM{'cnd1'}="";
$FORM{'cnd2'}="";
$FORM{'cnd3'}="";
$FORM{'cnd4'}="";
$FORM{'authtests'}="$tstid;";
$FORM{'createdby'}="";
$FORM{'grpowner'}="";
if (&get_candidate_profile($clid,$flds[1])) {
if ($erroroutprofile) {
$emsg=":profile already exists";
$bOK=0;
} elsif ($updateprofile) {
$FORM{'authtests'}=join('\;',$CANDIDATE{'authtests'},$FORM{'authtests'});
$FORM{'sal'}=$CANDIDATE{'sal'};
$FORM{'createdby'}=$CANDIDATE{'createdby'};
$FORM{'grpowner'}=$CANDIDATE{'grpowner'};
$FORM{'cnd1'}=$CANDIDATE{'cnd1'};
$FORM{'cnd2'}=$CANDIDATE{'cnd2'};
$FORM{'cnd3'}=$CANDIDATE{'cnd3'};
$FORM{'cnd4'}=$CANDIDATE{'cnd4'};
&put_candidate_profile($clid,$flds[1]);
$emsg=":updated";
}
} else {
&add_candidate_profile($clid);
$emsg=":added";
&log_entry($SESSION{'clid'}, $SESSION{'uid'}, "3", "Add candidate $FORM{'cndid'}");
$bOK=&get_candidate_profile($clid,$flds[1]);
unless ($bOK) {$emsg=":add profile failed";}
}
if ($bOK) {
$TEST_SESSION{'uid'} = $flds[1];
$TEST_SESSION{'state'} = "0.0.0";
&put_test_sequence($testpending,$clid,$flds[1],$tstid);
print "<B>OK</b>&gt";
} else {
print "<B><font color=red>ERROR$emsg</font></b>&gt";
}
print "\&lt$flds[0]\&gt";
for (1..$#flds) {
print "$flds[$_] - ";
}
print "<br>\n";
}
}
$ncnt=$#tacls+1;
if ($ncnt == -1) {
print "No Access Control Lists submitted for replication.<br>\n";
} else {
print "Processing $ncnt Access Control List Entries submitted for replication.<br>\n";
# my @taclrecs=&get_test_acl_file($CLIENT{'clid'},$TEST{'id'});
# my @commonids=();
foreach $rec (@taclrecs) {
@flds=split(/&/, $rec);
push @commonids, $flds[0];
}
my $commonid="";
my $name="";
foreach $rec (@tacls) {
@flds=split(/\,/, $rec);
# $commonid="";
# for (0 .. $#commonids) {
# if (lc($commonids[$_]) eq lc($flds[1])) {
# $commonid=$commonids[$_];
# $flds[1]=$commonid;
# last;
# }
# }
# unless($commonid ne '') {
# push @commonids,$flds[1];
# }
# $name=join(' ',$flds[3],$flds[4],$flds[5]);
# $name=~ tr/ //;
# if ($name eq "") { $name="Anonymous";};
# $rec=join('&',$flds[1],$TEST{'id'},$flds[2],$name,"1");
# push @taclrecs, $rec;
#
print "\&lt$flds[0]\&gt";
for (1..$#flds) {
print "$flds[$_] - ";
}
print "<br>\n";
}
}
&print_report_footer();
}
sub print_report_header {
my $s="<HTML>
<BODY BACKGROUND=\"<%=SYSTEM.BACKGROUND%>\" BGCOLOR=\"<%=SYSTEM.BGCOLOR%>\"
TEXT=\"<%=SYSTEM.TEXT%>\" LINK=\"<%=SYSTEM.LINK%>\"
VLINK=\"<%=SYSTEM.VLINK%>\" ALINK=\"<%=SYSTEM.ALINK%>\">\n";
print &xlatline($s);
}
sub print_report_footer {
print "</BODY>\n</HTML>\n";
}