survey-manager/survey-nginx/cgi-bin/treplica.pl

#!/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";
}