#!/usr/bin/perl
#
# $Id: cybertestlib.pl,v 1.52 2006/11/28 22:30:42 ddoughty Exp $
#
# Source File: cybertestlib.pl

use logger;

sub get_test_list {
	my $clientID = shift;
	chomp $clientID;
	my @rs;
	if ( defined($clientID) && length($clientID) ) {
		$testfile = "tests.$clientID";
		@rs = &get_data($testfile);
	} else {
		&logger::logwarn("Undefined client ID passed to get_test_list()");
	}
	return @rs;
}

sub get_test_list_all {
	my @rs;
	my @client_data = get_client_list();
	shift @client_data;
	foreach (@client_data) {
		($clientID, $trash) = split('&', $_);
		$testfile = "tests.$clientID";
		push(@rs, &get_data($testfile));
	}
	@client_data = ();
	return @rs;
}

sub save_test_list {
	$trash = join( $pathsep, $dataroot, "tests.$_[0]");
	open (TSTFILE, ">$trash");
	foreach $trec (@trecs) {
		print TSTFILE "$trec\n";
	}
	close TSTFILE;
}

sub save_orders {
	$tmpfile = join( $pathsep, $dataroot, "orders.$SESSION{'clid'}");
	open (TMPFILE, ">$tmpfile");
	foreach $order (@orders) {
		print TMPFILE "$order";
	}
	close TMPFILE;
	my $lockfile = join( $pathsep, $dataroot, "orders.$SESSION{'clid'}.lock");
	if (-e $lockfile) { unlink($lockfile) }
}

sub save_purchased {
	$tmpfile = join( $pathsep, $dataroot, "purchased.$SESSION{'clid'}");
	open (TMPFILE, ">$tmpfile");
	foreach $purchase (@purchased) {
		print TMPFILE "$purchase";
	}
	close TMPFILE;
	my $lockfile = join( $pathsep, $dataroot, "purchased.$SESSION{'clid'}.lock");
	if (-e $lockfile) { unlink($lockfile) }
}

sub get_question_list {
	$trash = join( $pathsep, $questionroot, "$_[0].$_[1]");
	my @rs;
	if ( ! open (TMPFILE, "<$trash") ) {
		&logger::logerr("Unable to read file $trash: $!");
		return @rs;
	}
	@rs = <TMPFILE>;
	close TMPFILE;
	return @rs;
}

sub get_client_list {
	@rs = &get_data("clients.dat");
	return @rs;
}

sub get_client_cnd_list {
	@rs = &get_data("cnd.$_[0]");
	return @rs;
}

sub get_client_admin_list {
    my ($clientID) = @_;
    my @rs = &get_data("admin.dat");
    foreach (@rs) {
	chomp;
	($uid,$pw,$uac,$client) = split(/&/,$_);
	if ($client eq $clientID) {
	    push @ret, $_;
	}
    }
    return @ret;
}

sub get_candidate_profile {
	my ($clid, $target_cndid, $opts) = @_;
	@clrecs = &get_data("cnd.$clid");
	$bFirst = 1;
	foreach $clrec (@clrecs) {
		### Debugging for cand profile chop problem - DED
		$ded = chop ($clrec);
		#if ( "$ded" ne "\n" ) {
			#print "<p> Get_Candidate_Profile Chop= $ded <p>\n";
		#}
		if ($bFirst == 1) {
			@lbls = split(/&/, $clrec);
			$bFirst = 0;
		} else {
			($cndid, $trash) = split(/&/, $clrec);
			if ($cndid eq $target_cndid) {
				@flds = split(/&/, $clrec);
				$i=0;
				foreach $lbl (@lbls) {
					$CANDIDATE{$lbl} = @flds[$i++];
				}
				if ($CANDIDATE{'selfreg'} eq "") {
					$CANDIDATE{'selfreg'} = "N";
				}
				$tmpstr = &get_pending_tests($clid, $target_cndid, $opts);
				if ($tmpstr ne '') {
					$tmpstr =~ s/\;// ;
					$tmpstr =~ s/$clid.$target_cndid.//eg ;
				}
				$CANDIDATE{'authlist'} = $tmpstr;
				$tmpstr = &get_inprog_tests($clid, $target_cndid);
				if ($tmpstr ne '') {
					$tmpstr =~ s/\;// ;
					$tmpstr =~ s/$clid.$target_cndid.//eg ;
				}
				$CANDIDATE{'inproglist'} = $tmpstr;
				$tmpstr = &get_completed_tests($clid, $target_cndid);
				if ($tmpstr ne '') {
					$tmpstr =~ s/\;// ;
					$tmpstr =~ s/$clid.$target_cndid.//eg ;
				}
				$CANDIDATE{'completedlist'} = $tmpstr;
				return 1;
			}
		}
	}
  # if the candidate was not found in the candidate file,
  #   but the candidate name has an anonymous prefix,
	#     then we will return the anonymous user.
	unless ($target_cndid =~ /^anon/i ) {
		return 0;
	} else {
		%CANDIDATE = () ; # Clean out all of the candidate data.
		$CANDIDATE{'uid'} = $target_cndid ; # Login id.
		$CANDIDATE{'pwd'} = "_____" ; # Password
		$CANDIDATE{'nmf'} = "Anon" ; # First Name
		$CANDIDATE{'nmm'} = "" ; # Middle Name
		$CANDIDATE{'nml'} = "Anon" ; # Last Name
		$CANDIDATE{'eml'} = "" ; # E-Mail Addr.
		$CANDIDATE{'selfreg'} = "Y" ;
		return 1;
	}
}

sub put_candidate_profile {
	my ($clid,$pcndid,$puac) = @_;
	my $temp_pwd;
	if ($FORM{'pwd'} eq '') {
		$temp_pwd = &get_a_key("cnd.$clid", $pcndid, "pwd");
	}
if ($globalDebugFlag) {
	&opendebug();
	print DBGFILE "special put_candidate_profile:$clid,$pcndid,$puac\n";
}
	@crecs = &get_data("cnd.$clid");
	$trash = join( $pathsep, $dataroot, "cnd.$clid");
	open (TSTFILE, ">$trash");
	$bFirst = 1;
if ($globalDebugFlag) {
	print DBGFILE "special put_candidate_profile:$_[0],$_[1],$_[2]\n";
}
	my $shift_hack = shift(@crecs);
	$shift_hack =~ (s/authtests/createdate/g);
	$shift_hack =~ (s/grpid/createdby/g);
	if ( !($shift_hack =~ /registrar/)) {
		chomp $shift_hack;
		$shift_hack .= '&registrar'."\n";
	}
	unshift(@crecs, $shift_hack);
	foreach $crec (@crecs) {
		$ded = chop ($crec);
		if ( "$ded" ne "\n" ) {
			print "<p> Put_Candidate_Profile Chop= $ded <p>\n";
		}
		if ($bFirst == 1) {
			@lbls = split(/&/, $crec);
			$bFirst = 0;
		} else {
			($cndid, $trash) = split(/&/, $crec);
if ($globalDebugFlag) {
	print DBGFILE "special put_candidate_profile:$cndid,$pcndid,$_[1]\n";
}
			if ($cndid eq $_[1]) {
				$i = 0;
				@flds = split(/&/, $crec);
				foreach $lbl (@lbls) {
					$FORM{$lbl} =~ tr/+/ /;
					if ($i eq 0) {
						if ($_[2] eq 'cnd') {		#prints the name
							$crec = $flds[$i];
						} else {
							$crec = $FORM{$lbl};
						}
					} else {
						if ($lbl eq 'pwd') {
							if ($FORM{$lbl} eq '') {
								$FORM{$lbl} = $temp_pwd;
							}
						}
					
                                                $crec = join('&', $crec, $FORM{$lbl});
                                        }

					$i++;
				}
			}
		}
		print TSTFILE "$crec\n";
	}
	close TSTFILE;
if ($globalDebugFlag) {
	&closedebug();
	print DBGFILE "special put_candidate_profile:END\n";
}
}

sub add_candidate_profile {
  # Parameters -
  # $_[0] - client id string, required parm.
  # $_[1] - reference to hash with data for client to add, Optional parm.
  my $hashref ;
  if ($_[1]) {
    # Parm $_[1] is the data for the client.
    $hashref = $_[1] ;
  } else {
    # Parm $_[1] is not given, so use %FORM.
    $hashref = \%FORM ;
  }
	@crecs = &get_data("cnd.$_[0]");
	$trash = join( $pathsep, $dataroot, "cnd.$_[0]");
	open (TSTFILE, ">$trash");
	$chgrec = $crecs[0];
	$chgrec =~ (s/authtests/createdate/); 	#The guy who wrote this uses 
						#chgrec for updating teh 
						#information, but uses $crecs[0]
						#to write the file. They both 
						#must be changed.
	$crecs[0] =~ (s/authtests/createdate/);
	if ( !($crecs[0] =~ /registrar/)) {
		chomp $crecs[0];
		$crecs[0] .= '&registrar'."\n";
	}
	$crecs[0] =~ (s/grpid/createdby/);
	$ded = chop ($chgrec);
	if ( "$ded" ne "\n" ) {
		print "<p> Add_Candidate_Profile Chop= $ded <p>\n";
	}
	@lbls = split(/&/, $chgrec);
	$nlbls = $#lbls;
	$chgrec = $FORM{$lbls[0]};
	for $i (1 .. $nlbls) {
		$chgrec = join('&', $chgrec, $$hashref{$lbls[$i]});
	}
	$chgrec = join('', $chgrec, "\n");
	push @crecs, $chgrec;
	foreach $crec (@crecs) {
		print TSTFILE "$crec";
	}
	close TSTFILE;
}

sub get_client_profile {
# Populate the Assoc. array %CLIENT with the data for the client id passed in.
# Just return a 1.
	@clrecs = &get_data("clients.dat");
	$bFirst = 1;
	foreach $clrec (@clrecs) {
		chop ($clrec);
		if ($bFirst == 1) {
			@lbls = split(/&/, $clrec);
			$bFirst = 0;
		} else {
			($clid, $trash) = split(/&/, $clrec);
			if ($clid eq $_[0]) {
				@flds = split(/&/, $clrec);
				$i=0;
				foreach $lbl (@lbls) {
					$CLIENT{$lbl} = @flds[$i++];
				}
				&format_logo;
				$CLIENT{'algnchk'} = ($CLIENT{'clalign'} eq 'vt') ? "CHECKED" : "";
				$CLIENT{'reqadrchk'} = ($CLIENT{'clreqadr'} eq 'Y') ? "CHECKED" : "";
				$CLIENT{'emlvalchk'} = ($CLIENT{'emlval'} eq 'Y') ? "CHECKED" : "";
				$CLIENT{'rsndtstemlchk'} = ($CLIENT{'rsndtsteml'} eq 'Y') ? "CHECKED" : "";
				$CLIENT{'rstgrpownchk'} = ($CLIENT{'rstgrpown'} eq 'Y') ? "CHECKED" : "";
				$CLIENT{'savechangechk'} = ($CLIENT{'savechange'} eq 'Y') ? "CHECKED" : "";
				$CLIENT{'emlaclchk'} = ($CLIENT{'emlacl'} eq 'Y') ? "CHECKED" : "";
				$CLIENT{'emlacllstchk'} = ($CLIENT{'emlacllst'} eq 'Y') ? "CHECKED" : "";
				$CLIENT{'emlstrictchk'} = ($CLIENT{'emlstrict'} eq 'Y') ? "CHECKED" : "";
				$CLIENT{'pwdchangechk'} = ($CLIENT{'pwdchange'} eq 'Y') ? "CHECKED" : "";
				$CLIENT{'rsttogrpchk'} = ($CLIENT{'rsttogrp'} eq 'Y') ? "CHECKED" : "";
				$CLIENT{'rstnongrpschk'} = ($CLIENT{'rstnongrps'} eq 'Y') ? "CHECKED" : "";
				$CLIENT{'hidespinnerchk'} = ($CLIENT{'hidespinner'} eq 'Y') ? "CHECKED" : "";
				$CLIENT{'testseldropchk'} = ($CLIENT{'testseldrop'} eq 'Y') ? "CHECKED" : "";
				$CLIENT{'hidereviewchk'} = ($CLIENT{'hidereview'} eq 'Y') ? "CHECKED" : "";
				$CLIENT{'alwtstchk'} = ($CLIENT{'clalwtst'} eq 'Y') ? "CHECKED" : "";
				$active = $CLIENT{'active'};
				($CLIENT{'active'},$CLIENT{'cllangflags'}, $CLIENT{'swsys'}, $CLIENT{'clalwrotip'}) = split(/\./, $active);
				$CLIENT{'active'} = ($CLIENT{'active'} eq 'Y') ? "Y" : "N";
				$CLIENT{'cllangflags'} = ($CLIENT{'cllangflags'} eq 'Y') ? "Y" : "N";
				($CLIENT{'clcnd1'}, $CLIENT{'clcnd1vals'}, $CLIENT{'clcnd1format'}) = split(/;/, $CLIENT{'clcnd1'});
				($CLIENT{'clcnd2'}, $CLIENT{'clcnd2vals'}, $CLIENT{'clcnd2format'}) = split(/;/, $CLIENT{'clcnd2'});
				### DED 3/20/07 custom fields 3&4 not supported
				#($CLIENT{'clcnd3'}, $CLIENT{'clcnd3vals'}, $CLIENT{'clcnd3format'}) = split(/;/, $CLIENT{'clcnd3'});
				#($CLIENT{'clcnd4'}, $CLIENT{'clcnd4vals'}, $CLIENT{'clcnd4format'}) = split(/;/, $CLIENT{'clcnd4'});
				&get_client_configuration($_[0]);
				$CLIENT{'clalwlang'} = ($SYSTEM{'languagesupport'} eq "TRUE") ? "Y" : "N";
				$CLIENT{'slfregenab'} = (is_client_selfreg($clid)) ? "Y" : "N";
				$CLIENT{'emlpwdenab'} = (is_client_emlpwd($clid)) ? "Y" : "N";
				$CLIENT{'includepurchased'} = (-e "$dataroot$pathsep"."forsale.$clid")? "Y" : "N";
				$CLIENT{'email_from'} = "autonotify.".$CLIENT{'clid'}."\@actscorp.com";
				return 1;
			}
		}
	} # end of scanning clients.dat
}

sub format_logo {
	@logo_htmls = ();
	$logo_html = "";
	$testlogo_html = "";
	$pathroot = join('', $pubroot, $graphroot);
	if ($CLIENT{'clorga'} ne '') {
		$srcorg = join($pathsep, $pathroot, "$CLIENT{'clorga'}");
		$srcorg = &file_exists_with_extension($srcorg, "gif;jpg");
		$srcorg =~ s/$pathroot/$graphurl/g;
	} else { $srcorg = "";}
	if ($srcorg eq '') {
		$srcorg = join($pathsep, $pathroot, "$CLIENT{'clid'}");
		$srcorg = &file_exists_with_extension($srcorg, "gif;jpg");
		$srcorg =~ s/$pathroot/$graphurl/g;
	}
	if ($CLIENT{'cldepta'} ne '') {
		$srcdept = join($pathsep, $pathroot, "$CLIENT{'clorga'}.$CLIENT{'cldepta'}");
		$srcdept = &file_exists_with_extension($srcdept, "gif;jpg");
		$srcdept =~ s/$pathroot/$graphurl/g;
	} else { $srcdept = "";}
	if ($CLIENT{'clunita'} ne '') {
		$srcunit = join($pathsep, $pathroot, "$CLIENT{'clorga'}.$CLIENT{'cldepta'}.$CLIENT{'clunita'}");
		$srcunit = &file_exists_with_extension($srcunit, "gif;jpg");
		$srcunit =~ s/$pathroot/$graphurl/g;
	} else { $srcunit = "";}
	if ($srcorg ne '') { push @logo_htmls, $srcorg;}
	if (($srcdept ne '') && ($srcdept ne $srcorg)) {
		if (($srcorg ne '') && ($CLIENT{'clalgn'} eq 'hz')) {
			unshift @logo_htmls, $srcdept;
		} else {push @logo_htmls, $srcdept;}
	}
	if (($srcunit ne '') && ($srcunit ne $srcorg)) { push @logo_htmls, $srcunit;}
	if ($#logo_htmls == -1) {
		$CLIENT{'logo'} = "";
		$CLIENT{'testlogo'} = "";
	} else {
		$srcsep = "";
		foreach $src (@logo_htmls) {
			$indexlogo_html = join('', $logo_html, $srcsep, "<IMG SRC=\"$src\" BORDER=0>");
			$logo_html = join('', $logo_html, $srcsep, "<IMG SRC=\"$src\" width=150 BORDER=0>");
			$testlogo_html = join('', $testlogo_html, "<IMG SRC=\"$src\" HEIGHT=25 BORDER=0>");
			unless ($srcsep) { $srcsep = ($CLIENT{'clalgn'} eq 'vt') ? "<BR>\n" : "\n";}
		}
		$CLIENT{'indexlogo'} = $indexlogo_html;
		$CLIENT{'logo'} = $logo_html;
		$CLIENT{'testlogo'} = $testlogo_html;
	}
	$logo_html = "";
	$testlogo_html = "";
}

sub get_test_profile {
# Populate the Assoc. array TEST.
	my ($clid, $testid) = @_;
#   logger::logmsg("Retrieving test [$testid] for client [$clid]...");
	@trecs = &get_test_list($clid);
	$bFirst = 1;
	foreach $testdef (@trecs) {
		chop ($testdef);
		if ($bFirst eq 1) {
			@flds = split(/&/, $testdef);
			$bFirst = 0;
		} else {
			($id, $trash) = split(/&/, $testdef);
			if ($id eq $testid) {
				@rowdata = split(/&/, $testdef);
				$counter = 0;
				foreach $fld (@flds) {
					$TEST{$fld} = $rowdata[$counter++];
                    #&logger::logmsg("$fld = $TEST{$fld}");
				}
				($emlcnd, $emlesa, $emlstart, $emlpause, $emlesahtml, $emlcndrvw, $emlinactive, $emlesar, $emlstartr, $emlpauser) = split(/\./, $TEST{'emlcnd'});
				if ( ! setup_avail_settings(\%TEST ) ) {
					&logger::logerr("Unable to setup availability window");
				}
				$TEST{'emlstartopt'} = ($emlstart eq 'Y') ? "Y" : "N";
				$TEST{'emlstartropt'} = ($emlstartr eq 'Y') ? "Y" : "N";
				#&dbgprint("Id= $TEST{'id'} Emlcnd= $TEST{'emlcnd'} Emlstart= $emlstart Emlstartopt= $TEST{'emlstartopt'}\n");
				$TEST{'emlpauseopt'} = ($emlpause eq 'Y') ? "Y" : "N";
				$TEST{'emlpauseropt'} = ($emlpauser eq 'Y') ? "Y" : "N";
				$TEST{'emlcndopt'} = ($emlcnd eq 'Y') ? "Y" : "N";
				$TEST{'emlesaopt'} = ($emlesa eq 'Y') ? "Y" : "N";
				$TEST{'emlesahtmlopt'} = ($emlesahtml eq 'Y') ? "Y" : "N";
				$TEST{'emlesaropt'} = ($emlesar eq '') ? "N" : $emlesar;
				$TEST{'emlcndrvwopt'} = ($emlcndrvw  eq 'Y') ? "Y" : "N";
				$TEST{'emlinactiveopt'} = ($emlinactive  eq 'Y') ? "Y" : "N";
				$TEST{'emlesachk'} = ($emlesa eq 'Y') ? "CHECKED" : "";
				$TEST{'emlesahtmlchk'} = ($emlesahtml eq 'Y') ? "CHECKED" : "";
				$TEST{'emlcndchk'} = ($emlcnd eq 'Y') ? "CHECKED" : "";
				$TEST{'emlpausechk'} = ($emlpause eq 'Y') ? "CHECKED" : "";
				$TEST{'emlstartchk'} = ($emlstart eq 'Y') ? "CHECKED" : "";
				$TEST{'emlesarschk'} = ($emlesar eq 'S') ? "CHECKED" : "";
				$TEST{'emlesarhchk'} = ($emlesar eq 'H') ? "CHECKED" : "";
				$TEST{'emlesarnchk'} = ($emlesar eq 'N') ? "CHECKED" : "";
				$TEST{'emlpauserchk'} = ($emlpauser eq 'Y') ? "CHECKED" : "";
				$TEST{'emlstartrchk'} = ($emlstartr eq 'Y') ? "CHECKED" : "";
				$TEST{'emlcndrvwchk'} = ($emlcndrvw eq 'Y') ? "CHECKED" : "";
				$TEST{'emlinactivechk'} = ($emlinactive eq 'Y') ? "CHECKED" : "";
				($TEST{'showsubj'}, $TEST{'showques1'}, $TEST{'lblques1'}, $TEST{'showques2'}, $TEST{'lblques2'}) = split(/\./, $TEST{'showsubj'});

				($tmdtest,$hideclock) = split(/\./,$TEST{'tmd'});
				$TEST{'tmd'} = $tmdtest;
				$TEST{'hideclock'} = ($hideclock eq '1') ? "CHECKED" : "";
				$SYSTEM{'hideclock'} = $hideclock;
				$SYSTEM{'hideqno'} = ($TEST{'seq'} eq 'dmg') ? 1 : 0;
		$TEST{'sapmtxchk'} = ($TEST{'sapmtx'} eq 'Y') ? "CHECKED" : "";
				$TEST{'tmdchk'} = ($tmdtest eq 'Y') ? "CHECKED" : "";
				$TEST{'rndqchk'} = ($TEST{'rndq'} eq 'Y') ? "CHECKED" : "";
				$TEST{'rndachk'} = ($TEST{'rnda'} eq 'Y') ? "CHECKED" : "";
				$TEST{'seqstd'} = ($TEST{'seq'} eq 'std') ? "CHECKED" : "";
				$TEST{'seqadp'} = ($TEST{'seq'} eq 'adp') ? "CHECKED" : "";
				$TEST{'tppchk'} = ($TEST{'tpp'} eq 'Y') ? "CHECKED" : "";
				$TEST{'qskchk'} = ($TEST{'qsk'} eq 'Y') ? "CHECKED" : "";
				$TEST{'qpvchk'} = ($TEST{'qpv'} eq 'Y') ? "CHECKED" : "";
				$TEST{'srvychk'} = ($TEST{'srvy'} eq 'Y') ? "CHECKED" : "";
				$TEST{'cnlrst'} = ($TEST{'cnl'} eq '1') ? "SELECTED" : "";
				$TEST{'cnlrsm'} = ($TEST{'cnl'} eq '0') ? "SELECTED" : "";
				$TEST{'scr0'} = ($TEST{'scr'} eq '0') ? "SELECTED" : "";
				$TEST{'scr1'} = ($TEST{'scr'} eq '1') ? "SELECTED" : "";
				$TEST{'scr2'} = ($TEST{'scr'} eq '2') ? "SELECTED" : "";
				$TEST{'scr3'} = ($TEST{'scr'} eq '3') ? "SELECTED" : "";
				$TEST{'remt0'} = ($TEST{'remt'} eq '0') ? "SELECTED" : "";
				$TEST{'remt1'} = ($TEST{'remt'} eq '1') ? "SELECTED" : "";
				$TEST{'remt2'} = ($TEST{'remt'} eq '2') ? "SELECTED" : "";
				$TEST{'remt3'} = ($TEST{'remt'} eq '3') ? "SELECTED" : "";
				$TEST{'rema0'} = ($TEST{'rema'} eq '0') ? "SELECTED" : "";
				$TEST{'rema1'} = ($TEST{'rema'} eq '1') ? "SELECTED" : "";
				$TEST{'rema2'} = ($TEST{'rema'} eq '2') ? "SELECTED" : "";
				$TEST{'rema3'} = ($TEST{'rema'} eq '3') ? "SELECTED" : "";
				$TEST{'layout2chk'} = ($TEST{'layout'} eq '2') ? "CHECKED" : "";
				$TEST{'layout3chk'} = ($TEST{'layout'} eq '3') ? "CHECKED" : "";
				$TEST{'layout4chk'} = ($TEST{'layout'} eq '4') ? "CHECKED" : "";
				$TEST{'layout5chk'} = ($TEST{'layout'} eq '5') ? "CHECKED" : "";
				$TEST{'layout1chk'} = ($TEST{'layout'} eq '1') ? "CHECKED" : "";
				$TEST{'preleasechkd'} = ($TEST{'prelease'} eq 'Y') ? "CHECKED" : "";
				if ($TEST{'layout'} eq '') {$TEST{'layout1chk'} = "CHECKED";}
				@flags = split(/\./, $TEST{'flags'});
				$TEST{'deliverlanguage'} = $flags[0];
				unless (&LanguageIsSupported($flags[0])) {$TEST{'deliverlanguage'} = "enu";}
				$TEST{'group'} = ($flags[4] eq 'Y') ? "Y" : "N";
				$TEST{'tstalwrotip'} = ($flags[5] eq 'Y') ? "Y" : "N";

				$questioncount = &get_question_count($testid, $clid);
				($TEST{'totq'}, $TEST{'obsq'}) = split(/&/, $questioncount);

				$thrs = sprintf( "%02d", eval($TEST{'maxtm'} / 60));
				$tmin = $TEST{'maxtm'} - $thrs * 60;
				$TEST{'maxtmfmt'} = sprintf("%02d:%02d:00", $thrs,$tmin);
				$tstlogo = join($pathsep, $pubroot, "graphic", "$clid.$testid");
				$tstlogo = &file_exists_with_extension($tstlogo, "gif;jpg");
				if ($tstlogo eq '') {
					$TEST{'logo'} = "";
				} else {
					$tstlogopath = join($pathsep, $pubroot, "graphic");
					$tstlogo =~ s/$tstlogopath/$PATHS{'graphurl'}/eg;
					$TEST{'logo'} = "<IMG SRC=\"$tstlogo\" HEIGHT=25 BORDER=0>";
				}
				$TEST{'Ins'} = &get_test_worksheet_pagelist($clid,$testid);
# sac - start addition for subject area support
                                $TEST{'saskmatrix'} = "N";
                                $TEST{'mtxfile'} = "N"; 
				if ($TEST{'seq'} eq 'std') {
                                        if ($TEST{'sapmtx'} eq "N") {
                                      		$TEST{'saskmatrix'} = "N";
 						$TEST{'mtxfile'} = &get_test_saskmatrix($clid, $testid);
					} else {
						$TEST{'saskmatrix'} = &get_test_saskmatrix($clid, $testid);
  						$TEST{'mtxfile'} = $TEST{'saskmatrix'};
                                                #if ($TEST{'saskmatrix'} eq "N") {
                            				#print "No MTX file";	
						#}
				        } 
				}
				my @availflags = split(/\./, $TEST{'availto'});
				$TEST{'slfregenab'}=($availflags[0] eq 'Y') ? 1 : 0;
				$TEST{'pwdprotenab'}=($availflags[1] eq 'Y') ? 1 : 0;
				$TEST{'pwd'}=($availflags[1] eq 'Y') ? $availflags[2] : "";
				$TEST{'retkcnt'}=($availflags[3] eq '') ? "1" : $availflags[3];
				$TEST{'retkcndtn'}=($TEST{'retkcnt'} eq '1') ? "o" : $availflags[4];
				$TEST{'retkwt'}=($TEST{'retkcnt'} eq '1') ? "o" : $availflags[5];
				$TEST{'retkwtdly'}=($TEST{'retkcnt'} eq '1') ? "o" : $availflags[6];
				$TEST{'retkkeep'}=($availflags[4] eq '') ? "1" : $availflags[7];
				$TEST{'retkautorgstrenab'}=$availflags[8];
				$TEST{'pwdtag'} = ($availflags[1] eq 'Y') ? "pwp" : "npw";
				$TEST{'popuptag'} = ($TEST{'nopopup'} eq 'Y') ? "nop" : "pop";
				$TEST{'anonsubmitenab'}=($availflags[9] eq 'Y') ? 1 : 0;
				$TEST{'emlpwdenab'}=($availflags[10] eq 'Y') ? 1 : 0;
# sac - end addition for subject area support
				return 1;
			}
		}
	}
}

# sac - start addition for subject area support
sub get_test_saskmatrix {
# The subject area support reads the subject area matrix file.
# The data is three lines of data, and each line is placed in a different
#  cell of the %TEST Assoc. array.
# $TEST{'sapcts'} = the subject areas, and the per cent of questions in each subject area.
# $TEST{'skpcts'} = the skill levels, and the per cent of questions in each skill level.
# $TEST{'samtx'} = the subject areas, and the skill levels, and the number of questions in each combination.
	my ($clid, $testid) = @_;
	my $fn=join ($pathsep, $questionroot, "$testid.$clid.sba.mtx");
	my $s="N";
	$TEST{'sapcts'} = "";
	$TEST{'skpcts'} = "";
	$TEST{'samtx'} = "";
	if (open(TMPFILE,"<$fn")) {
		my @rs = <TMPFILE>;
		close TMPFILE;
		if ($#rs != -1) {
			chop($rs[0]);
			$TEST{'sapcts'} = $rs[0];
			chop($rs[1]);
			$TEST{'skpcts'} = $rs[1];
			chop($rs[2]);
			$TEST{'samtx'} = $rs[2];
			if (($rs[0] ne '') && ($rs[1] ne '') && ($rs[2] ne '')) {
				$s="Y";
			}
		}
	}
	return $s;
}

sub put_test_saskmatrix {
	my ($clid, $testid,$params) = @_;
	my	$chmodok;
	my $fn=join ($pathsep, $questionroot, "$testid.$clid.sba.mtx");
	if (open(TMPFILE,">$fn")) {
		print TMPFILE "$params->{'sapcts'}\n";
		print TMPFILE "$params->{'skpcts'}\n";
		print TMPFILE "$params->{'samtx'}\n";
		close TMPFILE;
	}
	$chmodok = chmod 0666,$fn;
	return $s;
}
# sac - end addition for subject area support

sub setup_avail_settings( $ ) {
	my ($TEST) = @_;

	my ($mon,$day,$year,$hour,$minute, $month_idx, $am, $pm);

	$am = GetLanguageElement($SESSION{lang}, 574);
	$pm = GetLanguageElement($SESSION{lang}, 575);

	#
	#  First, handle the available *on* part...
	#
	if ( $TEST->{availon} =~ /(\d+)\/(\d+)\/(\d{4})-(\d\d):(\d\d)/ ) {
		# new format
		($mon,$day,$year,$hour,$minute) = ($1,$2,$3,$4,$5);
	} elsif ( $TEST->{availon} =~ /(\d+)\/(\d+)\/(\d{4})/ ) {
		# old format
		($mon,$day,$year,$hour,$minute) = ($1,$2,$3,
		                               $UI{DEFAULT_AVAILON_HR},
									   sprintf("%2d",$UI{DEFAULT_AVAILON_MIN}));
	} else {
        ($sec,$minute,$hour,$day,$mon,$year) = localtime(time);
        $year += 1900;
		($hour,$minute) = ($UI{DEFAULT_AVAILON_HR},
						sprintf("%2d",$UI{DEFAULT_AVAILON_MIN}));
	}

	$month_idx = 525 + $mon;
	$TEST->{availonmonth} = $mon;
	$TEST->{availonmonthname} = GetLanguageElement($SESSION{lang}, $month_idx);
	$TEST->{availonday} = $day;
	$TEST->{availonyear} = $year;
	$TEST->{availonminute} = sprintf("%02d", $minute);
	if ( $hour >= 12 ) {
		$hour -= 12 if ( $hour > 12 );
		$TEST->{availonpmoffset} = 12;
		$TEST->{availonampm} = $pm;
	} else {
		$hour = 12 if ( $hour == 0 );
		$TEST->{availonpmoffset} = 0;
		$TEST->{availonampm} = $am;
	}

	$TEST->{availonhour} = $hour;
	$TEST->{availonhourui} = sprintf("%d", $hour); # drop leading zero

	#
	#  Now handle the available *through* part...
	#
	if ( $TEST->{availthru} =~ /(\d+)\/(\d+)\/(\d{4})-(\d\d):(\d\d)/ ) {
		# new format
		($mon,$day,$year,$hour,$minute) = ($1,$2,$3,$4,$5);
	} elsif ( $TEST->{availthru} =~ /(\d+)\/(\d+)\/(\d{4})/ ) {
		# old format
		($mon,$day,$year,$hour,$minute) = ($1,$2,$3,
		                               $UI{DEFAULT_AVAILTHRU_HR},
									   sprintf("%2d",$UI{DEFAULT_AVAILTHRU_MIN}));
	} else {
        ($sec,$minute,$hour,$day,$mon,$year) = localtime(time);
        $year += 1900;
		($hour,$minute) = ($UI{DEFAULT_AVAILTHRU_HR},
						sprintf("%2d",$UI{DEFAULT_AVAILTHRU_MIN}));
	}

	$month_idx = 525 + $mon;
	$TEST->{availthrumonth} = $mon;
	$TEST->{availthrumonthname} = GetLanguageElement($SESSION{lang}, $month_idx);
	$TEST->{availthruday} = $day;
	$TEST->{availthruyear} = $year;
	$TEST->{availthruminute} = sprintf("%02d", $minute);
	if ( $hour >= 12 ) {
		$hour -= 12 if ( $hour > 12 );
		$TEST->{availthrupmoffset} = 12;
		$TEST->{availthruampm} = $pm;
	} else {
		$hour = 12 if ( $hour == 0 );
		$TEST->{availthrupmoffset} = 0;
		$TEST->{availthruampm} = $am;
	}

	$TEST->{availthruhour} = $hour;
	$TEST->{availthruhourui} = sprintf("%d", $hour); # drop leading zero

	return 1;
}


sub get_question_count {
	@qcountrecs = &get_question_list($_[0], $_[1]);
	$qcountobs = 0;
	@qcountflds = split(/&/, $qcountrecs[0]);
	for (1 .. $#qcountflds) {
		$qcountfldidx =  $_;
		last if($qcountflds[$_] eq 'qil');
	}
	for (1 .. $#qcountrecs) {
		@qcountflds = split(/&/, $qcountrecs[$_]);
		if ($qcountflds[$qcountfldidx] eq 'Y') { $qcountobs++;}
	}
	$qtmptotcount = sprintf("%d", $#qcountrecs);
	$qtmptotobs = sprintf("%d", $qcountobs);
	$qtmpcounts = join('&', $qtmptotcount, $qtmptotobs);
	@qcountrecs = ();
	@qcountflds = ();
	return $qtmpcounts;
}

sub get_subtest_profile {
	@trecs = &get_test_list($_[0]);
	$bFirst = 1;
	foreach $testdef (@trecs) {
		chop ($testdef);
		if ($bFirst eq 1) {
			@flds = split(/&/, $testdef);
			$bFirst = 0;
		} else {
			($id, $trash) = split(/&/, $testdef);
			if ($id eq $_[1]) {
				@rowdata = split(/&/, $testdef);
				$counter = 0;
				foreach $fld (@flds) {
					$SUBTEST{$fld} = $rowdata[$counter++];
				}				
				($emlcnd, $emlesa, $emlstart, $emlpause, $emlesahtml, $emlcndrvw, $emlinactive, $emlesar, $emlstartr, $emlpausr) = split(/\./, $TEST{'emlcnd'});
				$SUBTEST{'emlcndopt'} = $emlcnd;
				$SUBTEST{'emlesaopt'} = $emlesa;
				$SUBTEST{'emlesahtmlopt'} = $emlesahtml;
				$SUBTEST{'emlesaropt'} = $emlesar;
				$SUBTEST{'emlcndrvwopt'} = $emlcndrvw;
				$SUBTEST{'emlinactiveopt'} = $emlinactive;
				$SUBTEST{'emlesachk'} = ($emlesa eq 'Y') ? "CHECKED" : "";
				$SUBTEST{'emlesahtmlchk'} = ($emlesahtml eq 'Y') ? "CHECKED" : "";
				$SUBTEST{'emlcndrvwchk'} = ($emlcndrvw eq 'Y') ? "CHECKED" : "";
				$SUBTEST{'emlinactivechk'} = ($emlinactive eq 'Y') ? "CHECKED" : "";
				$SUBTEST{'emlcndchk'} = ($emlcnd eq 'Y') ? "CHECKED" : "";
				($tmdtest,$hideclock) = split(/\./,$SUBTEST{'tmd'});
				$SUBTEST{'hideclock'} = ($hideclock eq '1') ? "CHECKED" : "";
				$SUBTEST{'tmdchk'} = ($tmdtest eq 'Y') ? "CHECKED" : "";
				$SYSTEM{'hideclock'} = $hideclock;
				$SUBTEST{'hideqno'} = ($TEST{'seq'} eq 'dmg') ? 1 : 0;
	$SUBTEST{'sapmtxchk'} = ($SUBTEST{'sapmtx'} eq 'Y') ? "CHECKED" : "";
				$SUBTEST{'rndqchk'} = ($SUBTEST{'rndq'} eq 'Y') ? "CHECKED" : "";
				$SUBTEST{'rndachk'} = ($SUBTEST{'rnda'} eq 'Y') ? "CHECKED" : "";
				$SUBTEST{'seqstd'} = ($SUBTEST{'seq'} eq 'std') ? "CHECKED" : "";
				$SUBTEST{'seqadp'} = ($SUBTEST{'seq'} eq 'adp') ? "CHECKED" : "";
				$SUBTEST{'seqdmg'} = ($SUBTEST{'seq'} eq 'dmg') ? "CHECKED" : "";
				$SUBTEST{'qskchk'} = ($SUBTEST{'qsk'} eq 'Y') ? "CHEBKED" : "";
				$SUBTEST{'qpvchk'} = ($SUBTEST{'qpv'} eq 'Y') ? "CHECKED" : "";
				$SUBTEST{'srvychk'} = ($SUBTEST{'srvy'} eq 'Y') ? "CHECKED" : "";
				$SUBTEST{'cnlrst'} = ($SUBTEST{'cnl'} eq '0') ? "SELECTED" : "";
				$SUBTEST{'cnlrsm'} = ($SUBTEST{'cnl'} eq '1') ? "SELECTED" : "";
				$SUBTEST{'scr0'} = ($SUBTEST{'scr'} eq '0') ? "SELECTED" : "";
				$SUBTEST{'scr1'} = ($SUBTEST{'scr'} eq '1') ? "SELECTED" : "";
				$SUBTEST{'scr2'} = ($SUBTEST{'scr'} eq '2') ? "SELECTED" : "";
				$SUBTEST{'scr3'} = ($SUBTEST{'scr'} eq '3') ? "SELECTED" : "";
				$SUBTEST{'remt0'} = ($SUBTEST{'remt'} eq '0') ? "SELECTED" : "";
				$SUBTEST{'remt1'} = ($SUBTEST{'remt'} eq '1') ? "SELECTED" : "";
				$SUBTEST{'remt2'} = ($SUBTEST{'remt'} eq '2') ? "SELECTED" : "";
				$SUBTEST{'remt3'} = ($SUBTEST{'remt'} eq '3') ? "SELECTED" : "";
				$SUBTEST{'rema0'} = ($SUBTEST{'rema'} eq '0') ? "SELECTED" : "";
				$SUBTEST{'rema1'} = ($SUBTEST{'rema'} eq '1') ? "SELECTED" : "";
				$SUBTEST{'rema2'} = ($SUBTEST{'rema'} eq '2') ? "SELECTED" : "";
				$SUBTEST{'rema3'} = ($SUBTEST{'rema'} eq '3') ? "SELECTED" : "";
				$SUBTEST{'layout2chk'} = ($SUBTEST{'layout'} eq '2') ? "CHECKED" : "";
				$SUBTEST{'layout3chk'} = ($SUBTEST{'layout'} eq '3') ? "CHECKED" : "";
				$SUBTEST{'layout4chk'} = ($SUBTEST{'layout'} eq '4') ? "CHECKED" : "";
				$SUBTEST{'layout5chk'} = ($SUBTEST{'layout'} eq '5') ? "CHECKED" : "";
				$SUBTEST{'layout1chk'} = ($SUBTEST{'layout'} eq '1') ? "CHECKED" : "";
				if ($SUBTEST{'layout'} eq '') {$SUBTEST{'layout1chk'} = "CHECKED";}
				#if ($SUBTEST{'minpass'} eq '') {$SUBTEST{'minpass'} = "69";}

				$questioncount = &get_question_count($_[1], $_[0]);
				($SUBTEST{'totq'}, $SUBTEST{'obsq'}) = split(/&/, $questioncount);

				$thrs = sprintf( "%02d", eval($SUBTEST{'maxtm'} / 60));
				$tmin = $SUBTEST{'maxtm'} - $thrs * 60;
				$SUBTEST{'maxtmfmt'} = sprintf("%02d:%02d:00", $thrs,$tmin);
# sac - start addition for subject area support
				$SUBTEST{'saskmatrix'} = "";
				my @availflags = split(/\./, $SUBTEST{'availto'});
				$SUBTEST{'slfregenab'}=($availflags[0] eq 'Y') ? 1 : 0;
				$SUBTEST{'pwdprotenab'}=($availflags[1] eq 'Y') ? 1 : 0;
				$SUBTEST{'pwd'}=($availflags[1] eq 'Y') ? $availflags[2] : "";
				$SUBTEST{'retkcnt'}=($availflags[3] eq '') ? "1" : $availflags[3];
				$SUBTEST{'retkcndtn'}=($SUBTEST{'retkcnt'} eq '1') ? "o" : $availflags[4];
				$SUBTEST{'retkwt'}=($SUBTEST{'retkcnt'} eq '1') ? "o" : $availflags[5];
				$SUBTEST{'retkwtdly'}=($SUBTEST{'retkcnt'} eq '1') ? "o" : $availflags[6];
				$SUBTEST{'retkkeep'}=($availflags[4] eq '') ? "1" : $availflags[7];
				$SUBTEST{'retkautorgstrenab'}=$availflags[8];
				$SUBTEST{'pwdtag'} = ($availflags[1] eq 'Y') ? "pwp" : "npw";
				$SUBTEST{'popuptag'} = ($SUBTEST{'nopopup'} eq 'Y') ? "nop" : "pop";
				$SUBTEST{'anonsubmitenab'}=($availflags[9] eq 'Y') ? 1 : 0;
				$SUBTEST{'emlpwdenab'}=($availflags[10] eq 'Y') ? 1 : 0;
# sac - end addition for subject area support
				return 1;
			}
		}
	}
}

sub put_test_profile {
	my ($clid, $testid, $params, $newtest, $instanceof) = @_;
	if ($params->{'instance'} ne "Y") {
		$params->{'instance'} = "N"; 
	}
	@trecs = &get_test_list($clid);
	$testfile = join( $pathsep, $dataroot, "tests.$clid");
	if ( ! open (TSTFILE, ">$testfile") ) {
		&logger::logerr("Unable to write to $testfile: $!");
		return 0;
	}
	$bFirst = 1;
	foreach $trec (@trecs) {
		chop ($trec);
		if ($bFirst eq 1) {
			if ($trec !~ /\&prelease/) {
				$trec=join('&',$trec,'prelease');
			}
			if ($trec !~ /\&instance/) {
				$trec=join('&',$trec,'instance');
			}
			if ($trec !~ /\&instanceof/) {
				$trec=join('&',$trec,'instanceof');
			}
			if ($trec !~ /\&secbrowser/) {
				$trec=join('&',$trec,'secbrowser');
			}
			if ($trec !~ /\&nopopup/) {
				$trec=join('&',$trec,'nopopup');
			}
			@flds = split(/&/, $trec);
			$bFirst = 0;
			print TSTFILE "$trec\n";
		} else {
			($id, $tname) = split(/\&/, $trec);
			if ($id eq $testid) {
				$trec = $params->{$flds[0]};
				for $i (1 .. $#flds) {
					$trec = join('&', $trec, $params->{$flds[$i]});
				}
				print TSTFILE "$trec\n";
			} else {
				print TSTFILE "$trec\n";
			}
		}
	}
	if ($newtest eq 'Y') {
		$trec = $testid;
		for $i (1 .. $#flds) {
			$trec = join('&', $trec, $params->{$flds[$i]});
		}
		print TSTFILE "$trec\n";
	}
	close TSTFILE;

	return 1;
}

sub get_question_definition {
# Populate the Assoc. Array $QUESTION{} with the values of a single question.
# The code is good, but if the higher level code wants to see all of the 
#   questions in a test, then using this subroutine implies reading the
#   test file for every question.
	my ($testid, $clid, $qid) = @_;
	$bFirst = 1;
	$qcount = 0;
	@qrecs = &get_question_list($testid, $clid);
	foreach $qrec (@qrecs) {
		chop ($qrec);

		if ($bFirst) {
			$qcount++;
			@flds = split(/&/, $qrec);
			$bFirst = 0;
		} else {
			($id, $qtyp) = split(/&/, $qrec);
			if ($id eq $qid) {
				@rowdata = split(/&/, $qrec);
				$i=0;
				foreach $fld (@flds) {
					$QUESTION{$fld} = $rowdata[$i++];
				}
				$QUESTION{'tf'} = ($QUESTION{'qtp'} eq 'tf') ? "SELECTED" : "";
				$QUESTION{'mcs'} = ($QUESTION{'qtp'} eq 'mcs') ? "SELECTED" : "";
				$QUESTION{'lik'} = ($QUESTION{'qtp'} eq 'lik') ? "SELECTED" : "";
				$QUESTION{'mcm'} = ($QUESTION{'qtp'} eq 'mcm') ? "SELECTED" : "";
				$QUESTION{'esa'} = ($QUESTION{'qtp'} eq 'esa') ? "SELECTED" : "";
				$QUESTION{'nrt'} = ($QUESTION{'qtp'} eq 'nrt') ? "SELECTED" : "";
				if ($QUESTION{'qia'} =~ /^(\d+)::(\d+)::(.+)$/) {
					$QUESTION{'lblall'} = "Y";
				}
				$QUESTION{'qtx'} =~ s/\;/\n/g;
				$QUESTION{'qca'} =~ s/\;/\n/g;
				$QUESTION{'qia'} =~ s/\;/\n/g;

				$QUESTION{'lbla'} = ($QUESTION{'qalb'} eq 'a') ? "SELECTED" : "";
				$QUESTION{'lblA'} = ($QUESTION{'qalb'} eq 'A') ? "SELECTED" : "";
				$QUESTION{'lbln'} = ($QUESTION{'qalb'} eq 'n') ? "SELECTED" : "";
				$QUESTION{'lblr'} = ($QUESTION{'qalb'} eq 'r') ? "SELECTED" : "";
				$QUESTION{'lblR'} = ($QUESTION{'qalb'} eq 'R') ? "SELECTED" : "";
				$QUESTION{'lblx'} = ($QUESTION{'qalb'} eq 'x') ? "SELECTED" : "";

				$QUESTION{'tft'} = ($QUESTION{'qtp'} eq 'tf' && $QUESTION{'qca'} eq 'TRUE') ? "CHECKED" : "";
				$QUESTION{'tff'} = ($QUESTION{'qtp'} eq 'tf' && $QUESTION{'qca'} eq'FALSE') ? "CHECKED" : "";
				$QUESTION{'tfy'} = ($QUESTION{'qtp'} eq 'tf' && $QUESTION{'qca'} eq 'YES') ? "CHECKED" : "";
				$QUESTION{'tfn'} = ($QUESTION{'qtp'} eq 'tf' && $QUESTION{'qca'} eq'NO') ? "CHECKED" : "";
				$QUESTION{'rankmin'}=5;
				$QUESTION{'rankmax'}=100;
				$QUESTION{'rankstep'}=5;
				if (!$QUESTION{'rankstep'}) {
					$QUESTION{'rankstep'}=1;
				}
				$QUESTION{'ranknum'} = ($QUESTION{'rankmax'} - $QUESTION{'rankmin'}) / $QUESTION{'rankstep'} + 1;

				$QUESTION{'qim0'} = ($QUESTION{'qim'} eq '0') ? "SELECTED" : "";
				$QUESTION{'qim1'} = "";
				$QUESTION{'qim2'} = "";
				$illus = join($pathsep, $testgraphic, "$_[1].$QUESTION{'id'}");
				$supportedmedia = join(';', $SYSTEM{'supportedimagemedia'}, $SYSTEM{'supportedaudiomedia'}, $SYSTEM{'supportedvideomedia'});
				$illusfile = &file_exists_with_extension($illus, $supportedmedia);
				$QUESTION{'illustration'} = "";
				$QUESTION{'defthumbnail'} = "<IMG NAME=\"qimage\" SRC=\"$graphroot/noimageassigned.gif\" width=100 BORDER=0>";
				if ($QUESTION{'qim'} eq '1') {
					$QUESTION{'qim1'} = "SELECTED";
				} elsif ($QUESTION{'qim'} eq '2') {
					$QUESTION{'qim2'} = "SELECTED";
				} elsif ($QUESTION{'qim'} eq '3' ) {
					$QUESTION{'qim3'} = "SELECTED";
					$QUESTION{'illustration'} = "<A NAME=\"qimage\" HREF=\"$QUESTION{'flr'}\" TARGET=\"illustrated\">Reference Page</A>";
				}
				if ($illusfile ne '') {
					@filesegs = split(/\./, $illusfile);
					$fext = $filesegs[$#filesegs];
					@filesegs = () ;
					if ($SYSTEM{'supportedimagemedia'} =~ m/$fext/i ) {
						if ($QUESTION{'qim'} eq '1') {
							$QUESTION{'illustration'} = "<A NAME=\"qimage\" HREF=\"$cgiroot/imagepop.pl?tid=$SESSION{'tid'}\&img=$_[1].$QUESTION{'id'}.$fext\" TARGET=\"illustrated\">Illustration</A>";
							$QUESTION{'defthumbnail'} = "<A NAME=\"qimage\" HREF=\"$cgiroot/imagepop.pl?tid=$SESSION{'tid'}\&img=$_[1].$QUESTION{'id'}.$fext\" TARGET=\"illustrated\"><IMG NAME=\"qimagetn\" SRC=\"$cgiroot/image.pl?tid=$SESSION{'tid'}\&img=$_[1].$QUESTION{'id'}.$fext\" width=100 BORDER=0></A>";
						} else {
							$QUESTION{'illustration'} = "<IMG NAME=\"qimage\" SRC=\"$cgiroot/image.pl?tid=$SESSION{'tid'}\&img=$_[1].$QUESTION{'id'}.$fext\" BORDER=0>";
							$QUESTION{'defthumbnail'} = "<A NAME=\"qimage\" HREF=\"$cgiroot/imagepop.pl?tid=$SESSION{'tid'}\&img=$_[1].$QUESTION{'id'}.$fext\" TARGET=\"illustrated\"><IMG NAME=\"qimagetn\" SRC=\"$cgiroot/image.pl?tid=$SESSION{'tid'}\&img=$_[1].$QUESTION{'id'}.$fext\" width=100 BORDER=0></A>";
						}
					} elsif ($SYSTEM{'supportedvideomedia'} =~ m/$fext/i ) {
						$QUESTION{'illustration'} = "<EMBED SRC=\"$cgiroot/image.pl?tid=$SESSION{'tid'}\&img=$_[1].$QUESTION{'id'}.$fext\" AUTOSTART=\"TRUE\" LOOP=\"false\" VOLUME=\"100\" CONTROLS=\"console\" HIDDEN=\"false\">";
					} elsif ($SYSTEM{'supportedaudiomedia'} =~ m/$fext/i ) {
						$QUESTION{'illustration'} = "<EMBED SRC=\"$cgiroot/image.pl?tid=$SESSION{'tid'}\&img=$_[1].$QUESTION{'id'}.$fext\" AUTOSTART=\"TRUE\" LOOP=\"false\" VOLUME=\"100\" WIDTH=\"100\" HEIGHT=\"50\" CONTROLS=\"small console\" HIDDEN=\"false\">";
					}
				}
				#if ($QUESTION{'qnxt'} eq '' ) {
					#$QUESTION{'qnxt'} = ($qcount < $#qrecs) ? $qcount + 1 : $#qrecs;
				#} else {
					#if ($QUESTION{'qnxt'} > $#qrecs) {
						#$QUESTION{'qnxt'} = $#qrecs;
					#}
				#}
				#if ($QUESTION{'qprv'} eq '' ) {
					#$QUESTION{'qprv'} = ($qcount == 1) ? 1 : $qcount - 1;
				#} else {
					#if ($QUESTION{'qprv'} > $#qrecs) {
						#$QUESTION{'qprv'} = $#qrecs;
					#}
				#}
				$QUESTION{'totdef'} = $#qrecs;
				$QUESTION{'chkobs'} = ($QUESTION{'qil'} eq 'Y') ? "CHECKED" : "";
 				$QUESTION{'exitpt'} = ($QUESTION{'qca'} eq 'Y') ? "Y" : "N";
 				$QUESTION{'chkexitpt'} = ($QUESTION{'exitpt'} eq 'Y') ? "CHECKED" : "";
				if ($QUESTION{'qtx'} =~ /:::/) {
					($QUESTION{'qtx'}, $QUESTION{'left_be'}, $QUESTION{'right_be'}, $QUESTION{'sub_text'}) = split(/:::/, $QUESTION{'qtx'});
					my @sub_text = split(/::/, $QUESTION{'sub_text'});
					my $sub_text_html = "<TABLE>\n";
					for (my $i=0; $i<=$#sub_text; $i++) {
						my $j = $i + 1;
						$sub_text_html .= "				<TR><TD align=right><FONT size=\"2\">Text area $j:</FONT></TD>";
						$sub_text_html .= "<TD align=left><TEXTAREA NAME=\"sub_text$j\">$sub_text[$i]</TEXTAREA><BR>";
						$sub_text_html .= "</TD></TR>\n";
					}
					$sub_text_html .= "			</TABLE><BR>\n";
					$QUESTION{'sub_text_html'} = $sub_text_html;
					$QUESTION{'sub_text_num'} = $#sub_text + 1;
					@sub_text = ();
				}
				if ($QUESTION{'layout'} =~ /:/) {
					($QUESTION{'layout'}, $QUESTION{'anslay'}) = split(/:/, $QUESTION{'layout'});
					$QUESTION{'anslayhchk'} = ($QUESTION{'anslay'} eq 'h') ? "CHECKED" : "";
				} else {
					$QUESTION{'anslay'} = "";
				}
				$QUESTION{'anslayvchk'} = ($QUESTION{'anslay'} ne 'h') ? "CHECKED" : "";
				$QUESTION{'layout2chk'} = ($QUESTION{'layout'} eq '2') ? "CHECKED" : "";
				$QUESTION{'layout3chk'} = ($QUESTION{'layout'} eq '3') ? "CHECKED" : "";
				$QUESTION{'layout4chk'} = ($QUESTION{'layout'} eq '4') ? "CHECKED" : "";
				$QUESTION{'layout5chk'} = ($QUESTION{'layout'} eq '5') ? "CHECKED" : "";
				$QUESTION{'layout1chk'} = ($QUESTION{'layout'} eq '1') ? "CHECKED" : "";
				if ($QUESTION{'layout'} eq '') {
					$QUESTION{'layout'} = '1';
					$QUESTION{'layout1chk'} = "CHECKED";
				}
# sac v start addition for comment input support
				my @qflags = split(/\./,$QUESTION{'flags'});
				$QUESTION{'qcmtprmpt'} = $qflags[0];
				$QUESTION{'chkqccmt'} = ($qflags[0] eq 'Y') ? "CHECKED" : "";
				$QUESTION{'qcprmpt'} = ($qflags[0] eq 'Y') ? $qflags[1] : "";
				$QUESTION{'promptcomments'}="";
				if ($qflags[0] eq 'Y') {
					$QUESTION{'promptcomments'}="
<FONT SIZE=\"4\">\&nbsp;<br>
<b><i>$qflags[1]</i></b><br>
<TEXTAREA NAME=\"qcucmt\" cols=\"50\" rows=\"3\"
	wrap=on onKeyPress=\"languagesupport(this)\"
	onFocus=\"return tGotFocus(this)\"
	onChange=\"return onConvert(this)\"></TEXTAREA>
</FONT><br>\n";
					if (($QUESTION{'layout'} eq '4') || ($QUESTION{'layout'} eq '5') || ($QUESTION{'qtyp'} eq 'nrt')) {
						$QUESTION{'promptcomments'}=join('',"\&nbsp;<br>",$QUESTION{'promptcomments'});
					} else {
						$QUESTION{'promptcomments'}=join('',"<tr><td>",$QUESTION{'promptcomments'},"</td></tr>");
					}
				}
# sac ^ end addition for comment input support
				return;
			} else { $qcount++;}
		}
	}
	$QUESTION{'totdef'} = $#qrecs;
}

sub put_question_definition {
	$FORM{'id'} = $FORM{'qid'};
	@qrecs = &get_question_list($_[0], $_[1]);
	$trash = join( $pathsep, $questionroot, "$_[0].$_[1]");
	if ( ! open (TSTFILE, ">$trash") ) {
		&logger::logerr("Unable to read $trash : $!");
		return 0;
	}
	$bFirst = 1;
	$FORM{'qtx'} =~ s/\n/\;/g;
	$FORM{'qca'} =~ s/\n/\;/g;
	$FORM{'qia'} =~ s/\n/\;/g;
	$FORM{'qrm'} =~ s/\n/\;/g;
# sac v start addition for comment input support
	$FORM{'flags'}="";
	$FORM{'flags'}=(lc($FORM{'qcmtprmpt'}) eq 'on') ? "Y." : "N.";
	if (lc($FORM{'qcmtprmpt'}) eq 'on') {
		$FORM{'qcprmpt'} =~ s/\n/\;/g;
		$FORM{'qcprmpt'} =~ s/\./ /g;
		$FORM{'flags'}=join('',$FORM{'flags'},$FORM{'qcprmpt'});
	} else {
		$FORM{'qcprmpt'} = "";
	}
# sac ^ end addition for comment input support
	if ($FORM{'left_be'}) {
		$FORM{'qtx'} = join(':::', $FORM{'qtx'}, $FORM{'left_be'}, $FORM{'right_be'}, $FORM{'sub_text'});
	}
	if ($FORM{'anslay'}) {
		$FORM{'layout'} .= ":".$FORM{'anslay'};
	}

	foreach $qrec (@qrecs) {
		chop ($qrec);
		if ($bFirst eq 1) {
			@flds = split(/&/, $qrec);
			$bFirst = 0;
			print TSTFILE "$qrec\n";
		} else {
			($id, $tname) = split(/\&/, $qrec);
			if ($id eq "$_[2]") {
				$qrec = $FORM{$flds[0]};
				for $i (1 .. $#flds) {
					$qrec = join('&', $qrec, $FORM{$flds[$i]});
				}
				print TSTFILE "$qrec\n";
			} else {
				print TSTFILE "$qrec\n";
			}
		}
	}
	if ($FORM{'new'} eq 'Y') {
		$qrec = $FORM{$flds[0]};
		for $i (1 .. $#flds) {
			$qrec = join('&', $qrec, $FORM{$flds[$i]});
		}
		print TSTFILE "$qrec\n";
	}
	close TSTFILE;

	return 1;
}

sub put_client_profile {
	require 'smilib.pl';
	$active = $FORM{'active'};
	$FORM{'active'} = join('.', "$FORM{'active'}","$FORM{'cllangflags'}", "$FORM{'swsys'}", "$FORM{'clalwrotip'}");
	if ($FORM{'clcnd1vals'} ne "" ) { 
		$FORM{'clcnd1'} .= ';'.$FORM{'clcnd1vals'}.';'.$FORM{'clcnd1format'}; 
	}
	if ($FORM{'clcnd2vals'} ne "" ) { 
		$FORM{'clcnd2'} .= ';'.$FORM{'clcnd2vals'}.';'.$FORM{'clcnd2format'}; 
	}
	if ($FORM{'clcnd3vals'} ne "" ) { 
		$FORM{'clcnd3'} .= ';'.$FORM{'clcnd3vals'}.';'.$FORM{'clcnd3format'}; 
	}
	if ($FORM{'clcnd4vals'} ne "" ) { 
		$FORM{'clcnd4'} .= ';'.$FORM{'clcnd4vals'}.';'.$FORM{'clcnd4format'}; 
	}
	@clnames = &get_client_list();
	$creclbl = shift @clnames;
	chop ($creclbl);
	if (!($creclbl =~ /&emlval&rstgrpown/)) { $creclbl .= "&emlval&rstgrpown"; }
	if (!($creclbl =~ /&savechange/)) { $creclbl .= "&savechange"; }
	if (!($creclbl =~ /&emlacl/)) { $creclbl .= "&emlacl"; }
	if (!($creclbl =~ /&emlacllst/)) { $creclbl .= "&emlacllst"; }
	if (!($creclbl =~ /&emlstrict/)) { $creclbl .= "&emlstrict"; }
	if (!($creclbl =~ /&rsttogrp&rstnongrps/)) { $creclbl .= "&rsttogrp&rstnongrps"; }
	if (!($creclbl =~ /&rsndtsteml/)) { $creclbl .= "&rsndtsteml"; }
	if (!($creclbl =~ /&pwdchange/)) { $creclbl .= "&pwdchange"; }
	if (!($creclbl =~ /&hidespinner/)) { $creclbl .= "&hidespinner"; }
	if (!($creclbl =~ /&testseldrop/)) { $creclbl .= "&testseldrop"; }
	if (!($creclbl =~ /&hidereview/)) { $creclbl .= "&hidereview"; }
	### DED 3/20/07 custom fields 3 & 4 not yet supported
	#if (!($creclbl =~ /&clcnd3/)) { $creclbl .= "&clcnd3"; }
	#if (!($creclbl =~ /&clcnd4/)) { $creclbl .= "&clcnd4"; }
	@lbls = split(/&/, $creclbl);
	foreach $crec (@clnames) {
		chop ($crec);
		if ($_[0] eq '0') {
			($id, $cname) = split(/\&/, $crec);
			if ($id eq $FORM{'clid'}) {
				$bFirstLbl = 1;
				foreach $lbl (@lbls) {
					if ($bFirstLbl) {
						$crec = $FORM{$lbl};
						$bFirstLbl = 0;
					} else {
						$crec = join('&', $crec, $FORM{$lbl});
					}
				}
				push @newclients, $crec;
			} else {
				push @newclients, $crec;
			}
		} else {
			push @newclients, $crec;
		}
	}
	if ($_[0] eq '1') {
		$bFirstLbl = 1;
		foreach $lbl (@lbls) {
			if ($bFirstLbl) {
				$crec = $FORM{$lbl};
				$bFirstLbl = 0;
			} else {
				$crec = join('&', $crec, $FORM{$lbl});
			}
		}
		push @newclients, $crec;
	}
	@clnames = sort @newclients;
	@newclients = @clnames;
	unshift @newclients, $creclbl;
	@clnames = ();
	&save_client_list;
	@newclients = ();
	if ($FORM{'languageext'}) { $FORM{'CDEFAULTLANG'} = $FORM{'languageext'}; }
	if ($FORM{'languagedef'}) { 
		my @tmp = param('languagedef');
		$FORM{'CALLOWEDLANGS'} = join(',', @tmp);
	}
	&put_client_configuration($FORM{'clid'});
	$FORM{'active'} = $active;
}

sub save_client_list {
	$trash = join( $pathsep, $dataroot, "clients.dat");
	open (TSTFILE, ">$trash");
	foreach $crec (@newclients) {
		print TSTFILE "$crec\n";
	}
	close TSTFILE;
}

sub print_noncfa_test_options {
	my ($clientID, $fh) = @_;
	$fh = (defined($fh) ? $fh : *STDOUT);
	$bFirst = 1;
	@trecs = &get_test_list($clientID);
	foreach $tstname (@trecs) {
		if ($bFirst eq 0) {
			if ( $tstname =~ m/\&cfa\&/i) {
				#ignore confidentialitiy agreements
			} else {
				($id, $desc, undef, undef, undef, undef, undef, undef, undef, undef, undef, undef, undef, undef, undef, undef, undef, undef, undef, undef, undef, undef, undef, undef, undef, $emlcnd) = split(/&/, $tstname);
				(undef, undef, undef, undef, undef, undef, $inactive) = split(/\./, $emlcnd);
				if ($inactive eq "") {
					$inactive = "N"
				}
				print $fh "<OPTION VALUE=\"$inactive$id\">$desc\n";
			}
		} else {
			$bFirst = 0;
		}
	}
}

sub print_std_test_options {
	my ($clientID, $fh) = @_;
	$fh = (defined($fh) ? $fh : *STDOUT);
	my $bFirst = 1;
	my @trecs = &get_test_list($clientID);
	my $tstname;
	my $id;
	my $desc;
	my $srtdsc;
	my @recs=();
	foreach $tstname (@trecs) {
		if ($bFirst eq 0) {
			chomp($tstname);
			my @data = split(/&/, $tstname);
			$srtdsc=uc($data[1]);
			if ($data[39] eq "Y") { 
				$data[1] = "#&nbsp;".$data[1]; 
			} else {
				$data[1] = "&nbsp;&nbsp;&nbsp;".$data[1]; 
			}
			$tstname=join('|',$srtdsc,$data[1],$data[0]);
			push @recs,$tstname;
			@data=();
		} else {
			$bFirst = 0;
		}
	}
	@trecs=sort @recs;
	@recs=();
	foreach $tstname (@trecs) {
		if ($bFirst eq 0) {
			($srtdsc,$desc,$id) = split(/\|/, $tstname);
			print $fh "<OPTION VALUE=\"$id\">$desc\n";
		} else {
			$bFirst = 0;
		}
	}
	@trecs=();
}

sub print_filtered_test_options {
	my ($clientID, $filterID, $fh) = @_;
	$fh = (defined($fh) ? $fh : *STDOUT);
	$bFirst = 1;
	@trecs = &get_test_list($clientID);
	@filterrecs = &get_test_list($filterID);
	$filters = "";
	foreach $filterrec (@filterrecs) {
		($id, $desc) = split(/&/, $filterrec);
		$filters = join(',', $filters, $id);
	}
	@filterrecs = ();
	$filters = join(',', $filters, "");
	foreach $tstname (@trecs) {
		if ($bFirst eq 0) {
			($id, $desc) = split(/&/, $tstname);
			unless ($filters =~ /,$id,/ ) {
				print "<OPTION VALUE=\"$id\">$desc\n";
			}
		} else {
			$bFirst = 0;
		}
	}
}

sub print_client_options {
	my ($fh) = @_;
	$fh = (defined($fh) ? $fh : *STDOUT);
	@clrecs = &get_client_list();
	$bFirst = 1;
	foreach $clrec (@clrecs) {
		if ($bFirst ne 1) {
			($id, $desc) = split(/&/, $clrec);
			$unsortedline = join('&', $desc, $id);
			push @unsortedoptions, $unsortedline;
		}
		$bFirst = 0;
	}
	@clrecs = sort @unsortedoptions;
	@unsortedoptions = ();
	foreach $clrec (@clrecs) {
		($desc, $id) = split(/&/, $clrec);
		print $fh "<OPTION VALUE=\"$id\">$desc\n";
	}
	@clrecs = ();
}

sub print_client_list {
	@clrecs = &get_client_list();
	shift @clrecs;
	$cllist = ":";
	foreach $clrec (@clrecs) {
		($id, $desc) = split(/&/, $clrec);
		$cllist .= "$id:";
	}
	@clrecs = ();
	return "$cllist";
}

# v sac function replaced to improve performance
sub print_client_cnd_options {
	my ($clientID, $fh) = @_;
	$fh = (defined($fh) ? $fh : *STDOUT);
	my @clnames = &get_client_cnd_list($clientID);
	my @clnamesort=();
	my @clidsort=();
	my $namesort;
	my $idsort;
	my $bFirst = 1;
	my $clrec;
	my $id;
	my $sal;
	my $pwd;
	my $nmf;
	my $nmn;
	my $nml;
	foreach $clrec (@clnames) {
		chop($clrec);
		if ($bFirst ne 1) {
			@flds = split(/&/, $clrec);
			($id, $pwd, $sal, $nmf, $nmm, $nml, $sr) = ($flds[0], $flds[1], $flds[2], $flds[3], $flds[4], $flds[5], $flds[17]);
			$namesort=join('&',$nml,$nmf,$nmm,$id,$sr);
			push @clnamesort, $namesort;
			$idsort=join('&',$id,$nml,$nmf,$nmm,$sr);
			push @clidsort, $idsort;
		}
		$bFirst = 0;
	}
	if ( $FORM{skey} eq 'login' ) {
		#
		#  Sort by login...
		#
		@clnames = sort sort_client_IDs @clidsort;
		@clidsort=();
		@clnamesort=();
		($i_am_grpowner, $grpmembers, $grpowners, $mygrp, $i_am_registrar) = &prepFilter($clientID); 
		foreach $clrec (@clnames) {
			($id, $nml, $nmf, $nmm, $sr) = split(/&/, $clrec);
			if ($sr eq "Y") {
					$pass_filters = &makeMeFilter($id, $clientID, $i_am_grpowner, $grpmembers, $grpowners, $mygrp, $i_am_registrar); 
					print $fh "<OPTION VALUE=\"$id\">*$id ($nml, $nmf $nmm)\n" unless $pass_filters eq 1;
			} else {
					$pass_filters = &makeMeFilter($id, $clientID, $i_am_grpowner, $grpmembers, $grpowners, $mygrp, $i_am_registrar); 
					print $fh "<OPTION VALUE=\"$id\">&nbsp;$id ($nml, $nmf $nmm)\n" unless $pass_filters eq 1;
			}
		}
	} else {
		#
		#  Sort by name by default (first by last name, then by first name)...
		#
		@clnames = sort @clnamesort;
		@clidsort=();
		@clnamesort=();
		($i_am_grpowner, $grpmembers, $grpowners, $mygrp, $i_am_registrar) = &prepFilter($clientID); 
		foreach $clrec (@clnames) {
			($nml, $nmf, $nmm, $id, $sr) = split(/&/, $clrec);
			if ($sr eq "Y") {
					$pass_filters = &makeMeFilter($id, $clientID, $i_am_grpowner, $grpmembers, $grpowners, $mygrp, $i_am_registrar); 
					print $fh "<OPTION VALUE=\"$id\">*$nml, $nmf $nmm ($id)\n" unless $pass_filters eq 1;
			} else {
					$pass_filters = &makeMeFilter($id, $clientID, $i_am_grpowner, $grpmembers, $grpowners, $mygrp, $i_am_registrar); 
					print $fh "<OPTION VALUE=\"$id\">&nbsp;$nml, $nmf $nmm ($id)\n" unless $pass_filters eq 1;
			}
		}
	}
}
# a sort routine to put numbers first and sort numerically,
# then alphanumerics and sort alphbetically
# jeffo Dec 8, 2003
sub sort_client_IDs {
    if ($a =~ /^\d+/) {
	if ($b =~ /^\d+/) {
	    return $a <=> $b;
	} else {
	    return -1;
	}
    } elsif ($b =~ /^\d+/) {
	return 1;
    } else {
	return $a cmp $b;
    }
}

# ^ sac end function replacement
# v sac start support for next previous new candidate
sub get_candidate_list_nav {
	my ($clid,$cndid,$dbop,$sortedkey) = @_;
	my @clnames = &get_client_cnd_list($clid);
	my @clnamesort=();
	my @clidsort=();
	my $namesort;
	my $idsort;
	my $bFirst = 1;
	my $clrec;
	my $id;
	my $sal;
	my $pwd;
	my $nmf;
	my $nmn;
	my $nml;
	my $nxtenb=0;
	my $prevenb=0;
	my $navtocnd=$cndid;
	my $i;
	my $j;
	foreach $clrec (@clnames) {
		if ($bFirst ne 1) {
			($id, $pwd, $sal, $nmf, $nmm, $nml) = split(/&/, $clrec);
			$namesort=join('&',$nml,$nmf,$nmm,$id);
			push @clnamesort, $namesort;
			$idsort=join('&',$id,$nml,$nmf,$nmm);
			push @clidsort, $idsort;
		}
		$bFirst = 0;
	}
	if ( $sortedkey eq 'login' ) {
		#
		#  Sort by login...
		#
		@clnames = sort @clidsort;
		@clidsort=();
		@clnamesort=();
		for $i (0 .. $#clnames) {
			$clrec=$clnames[$i];
			($id, $nml, $nmf, $nmm) = split(/&/, $clrec);
			if ("$id" eq "$cndid") {
				$j=$i;
				if ($dbop eq 'nxt') {
					$j++;
				} elsif ($dbop eq 'prev') {
					$j--;
				}
				$prevenb=($j > 0) ? 1 : 0;
				$nxtenb=($j < $#clnames) ? 1 : 0;
				if (($j >= 0) && ($j <=$#clnames)) {
					$clrec=$clnames[$j];
					($id, $nml, $nmf, $nmm) = split(/&/, $clrec);
					$navtocnd="$id";
				}
				last;
			}
		}
	} else {
		#
		#  Sort by name by default (first by last name, then by first name)...
		#
		@clnames = sort @clnamesort;
		@clidsort=();
		@clnamesort=();
		for $i (0 .. $#clnames) {
			$clrec=$clnames[$i];
			($nml, $nmf, $nmm, $id) = split(/&/, $clrec);
			if ("$id" eq "$cndid") {
				$j=$i;
				if ($dbop eq 'nxt') {
					$j++;
				} elsif ($dbop eq 'prev') {
					$j--;
				}
				$prevenb=($j > 0) ? 1 : 0;
				$nxtenb=($j < $#clnames) ? 1 : 0;
				if (($j >= 0) && ($j <=$#clnames)) {
					$clrec=$clnames[$j];
					($nml, $nmf, $nmm, $id) = split(/&/, $clrec);
					$navtocnd="$id";
				}
				last;
			}
		}
	}
	@clnames=();
	my @retarray=();
	push @retarray, $navtocnd;
	push @retarray, $prevenb;
	push @retarray, $nxtenb;
	return @retarray;
}
# ^ sac end support for next previous new candidate

sub get_selfreg_test_list {
	my ($clid, $completedlist) = @_;
	my $srtrecs = ();
	my @trecs=&get_data("tests.$clid");
	my $rec=shift @trecs;
	chop($rec);
	my @flds=();
	my @flds = split(/&/,$rec);
	my $skey;
	my %fldnm={};
	for (0..$#flds) {
		$skey=$flds[$_];
		$fldnm{$skey}=$_;
	}

	### Are there purchased tests?
	if ($CLIENT{'includepurchased'} eq "Y") {
		### Read purchased file
		my @allprecs=&get_data("purchased.$clid");
		my @precs = grep(/^$SESSION{'uid'}&.*$/, @allprecs);
		foreach my $prec (@precs) {
			my @pflds = split(/&/, $prec);
			my $expire = $pflds[7] + $pflds[6]*60*60*24;
			if (time() < $expire) {
				# add purchased tests to list
				@pitems = split(/:/, $pflds[2]);
				foreach $pitem (@pitems) {
					my $pgrepfor = "($pitem)\&.*\&(std|svy|dmg)\&(.*\)(:..)\&(Y|N)(\\.)(Y|N)(.*.)(1|unlimited)(.....)\&*";
					my @ptrecs = grep( /$pgrepfor/, @trecs);
					push(@srtrecs, $ptrecs[0]);
				}
			} ### DED add cleanup of old purchases
		}
	}

	### Add in regular tests

	### DED Will need to add back in pieces of this grepfor 
	###   	if we add back in retake options other than maxretakes
	#my $grepfor="(.*)\&(std|svy|dmg)\&(.*\)(:..)\&(Y\\.)(Y|N)(.*.)(1|2|3|4|5|up)(.)(o|f|b)(.)(o|0|1)(.)(0|1h|2h|4h|8h|24h|2d|3d|4d|5d|7d|10d|14d|21d|30d|45d|60d|90d|120d|6m|1y|2y)(.)(Y|N)(.)(1|2|3|4|5|a|b)\&*";
	###

	my $grepfor="(.*)\&(std|svy|dmg)\&(.*\)(:..)\&(Y\\.)(Y|N)(.*.)(1|unlimited)(.....)\&*";
	@tsrtrecs=grep( /$grepfor/, @trecs);

	### Check availability windows on self-reg tests
	@atsrtrecs=();
	foreach $tsr (@tsrtrecs) {
		my ($testid, $junk) = split('&', $tsr);
		if (&within_availability_window($clid, $testid, time)) {
			push @atsrtrecs, $tsr;
		}
	}

	my %union = ();
	foreach $e (@srtrecs, @atsrtrecs) { $union{$e}++}; 
	@srtrecs = keys %union;
        my $authed_tests = $CANDIDATE{'authlist'};
        my @autharray = split(';', $authed_tests);
	my @file_list = &get_data("tests.$clid");
	foreach $revolver (0..$#autharray) {
		foreach $i (@file_list) {
			if ($i =~ /^$autharray[$revolver]&/) {
				$autharray[$revolver] = $i;
			}
		}
	}
        my %union = ();
        foreach $e (@srtrecs, @autharray) { $union{$e}++};
        @srtrecs = keys %union;
	

	my $sortrec="";
	@trecs=();
	foreach $rec (@srtrecs) {
		chop($rec);
		@flds=split(/&/,$rec);
		$skey=$fldnm{'desc'};
		$sortrec=join('&',$flds[$skey],$rec);
		push @trecs,$sortrec;
	}
	@srtrecs=sort @trecs;
	@trecs=();
	my @arecs=();
	my $html="";
	my $stripfld;
	my $pwdtag="";
	my @flags=();
	foreach $rec (@srtrecs) {
		@flds=split(/&/,$rec);
		$stripfld=shift @flds;
		&get_test_profile($SESSION{'clid'},$flds[0]);

		### Check completed status and retake options
		
		if ( ((!("\;$completedlist\;" =~ /\;$flds[0]\;/i)) || ("\;$completedlist\;" =~ /\;$flds[0]\;/i && $TEST{'retkcnt'} eq "unlimited") ) && ($FORM{'testid'} eq "" || $FORM{'testid'} eq $flds[0]) ) {
			$skey=$fldnm{'availto'};
			@flags=split(/\./,$flds[$skey]);
			$pwdtag = ($flags[1] eq 'Y') ? "pwp" : "npw";
			$nopopuptag = ($TEST{'nopopup'} eq 'Y') ? "nop" : "pop";
			$html = join('',$html, "<option value=\"$pwdtag$nopopuptag$flds[0]\">$flds[1]\n");
		}
		@flags=();
		@flds=();
	}
	@srtrecs=();
	return $html;
}

sub get_group_record {
	$GROUP{'grpowner'} = $_[1];
	$GROUP{'grpid'} = $_[2];
	@grps = &get_data("groups.$_[0]");
	$grpownmask = "$_[1]\&$_[2]\&";
	$grp = $grps[0];
	chop ($grp);
	@grpflds = split(/&/, $grp);
	foreach $grp (@grps) {
		if ($grp =~ /$grpownmask/ ) {
			chop ($grp);
			@gpdata = split(/&/, $grp);
			for (0 .. $#grpflds) {
				$GROUP{$grpflds[$_]} = $gpdata[$_];
			}
			last
		}
	}
	@grps = ();
	@grpflds = ();
}

# parameters (clid, grplist)
sub get_group_roster {
	@cndlist = &get_data("cnd.$_[0]");
	$cndhdr = $cndlist[0];
	chop ($cndhdr);
	@cndflds = split(/&/, $cndhdr);
	for (0 .. $#cndflds) { $CNDFLDS{$cndflds[$_]} = $_;}
	@cndflds = ();
	$rosterlist = ",$_[1],";
	$rosterlist =~ s/\,\,/\,/g;
	unless (($#cndlist == -1) || ($rosterlist eq '')) {
		$idxcndid = $CNDFLDS{'uid'};
		$idxcndnmf = $CNDFLDS{'nmf'};
		$idxcndnmm = $CNDFLDS{'nmm'};
		$idxcndnml = $CNDFLDS{'nml'};
		foreach $cnd (@cndlist) {
			chop ($cnd);
			@cndflds = split(/&/, $cnd);
			if ($rosterlist =~ /\,$cndflds[$idxcndid]\,/ ) {
				$optlist = join('&', "$cndflds[$idxcndnml], $cndflds[$idxcndnmf] $cndflds[$idxcndnmm]", "<OPTION VALUE=\"$cndflds[$idxcndid]\">$cndflds[$idxcndnml], $cndflds[$idxcndnmf] $cndflds[$idxcndnmm]\n");
				push @listitems, $optlist;
			}
		}
		@sorteditems = sort @listitems;
		@listitems = ();
		$optlist = "";
		foreach $sorteditem (@sorteditems) {
			($trash, $listitem) = split(/&/, $sorteditem);
			$optlist = join('', $optlist, $listitem);
		}
		@sorteditems = ();
		@cndflds = ();
		%CNDFLDS = ();
		@cndlist = ();
		return $optlist;
	}
	@cndflds = ();
	%CNDFLDS = ();
	@cndlist = ();
	return "";
}

# parameters (clid, grpowner, includeunowned)
sub get_group_tests {
	@testlist = &get_data("tests.$_[0]");
	$testhdr = $testlist[0];
	chop ($testhdr);
	@testflds = split(/&/, $testhdr);
	for (0 .. $#testflds) { $TESTFLDS{$testflds[$_]} = $_;}
	@testflds = ();
	unless ($#testlist == -1) {
		@optionlist = ();
		$idxtestid = $TESTFLDS{'id'};
		$idxtestdesc = $TESTFLDS{'desc'};
		$idxtestowner = $TESTFLDS{'ownedby'};
#       &logger::logmsg("ownedby = $idxtestowner");
		foreach $test (@testlist) {
			chop ($test);
			@testflds = split(/&/, $test);
			if (($testflds[$idxtestowner] eq '') && ($_[2] == 1)) {
				$optlist = join('&', "$testflds[$idxtestdesc]", "<OPTION VALUE=\"$testflds[$idxtestid]\">\*$testflds[$idxtestdesc]\n");
				push @optionlist, $optlist;
			} elsif ($_[1] eq $testflds[$idxtestowner]) {
				$optlist = join('&', "$testflds[$idxtestdesc]", "<OPTION VALUE=\"$testflds[$idxtestid]\">$testflds[$idxtestdesc]\n");
				push @optionlist, $optlist;
			}
		}
		@sortedoptions = sort @optionlist;
		@optionlist = ();
		$optlist = "";
		foreach $listitem (@sortedoptions) {
			($trash, $listoption) = split(/&/, $listitem);
			$optlist = join('', $optlist, $listoption);
		}
		@sortedoptions = ();
		@testflds = ();
		%TESTFLDS = ();
		@testlist = ();
		return $optlist;
	}
	@testflds = ();
	%TESTFLDS = ();
	@testlist = ();
	return "";
}

sub get_gradebook {
#gbkid&cndid&tstid&retake&cndnme&desc&score&comments&dtercd
}

sub get_gradebooks_list {
	$GROUP{'grpowner'} = $_[1];
	@grps = &get_data("groups.$_[0]");
	$grpownmask = "$_[1]\&";
	@gblist = ();
	$grp = $grps[0];
	chop ($grp);
	@grpflds = split(/&/, $grp);
	for (0 .. $#grpflds) { $GROUPFLDS{$grpflds[$_]} = $_;}
	foreach $grp (@grps) {
		if ($grp =~ /$grpownmask/ ) {
			push @gblist, $grp;
		}
	}
	@grps = ();
	@grpflds = ();
	@gblsorted = sort @gblist;
	@gblist = ();
	return @gblsorted;
}

# $OK = &put_test_worksheet($TEST{'id'),$CLIENT{'clid'},$pageno, $html);
sub put_test_worksheet {
	$tmpws = join($pathsep, $questionroot, "Ins", "$_[0].$_[1].$_[2]");
	#
	# if file exists, remove it
	# 
	open (TMPWS, ">$tmpws") or return 0;
	print TMPWS "$_[3]";
	close TMPWS;
	$chmodok = chmod 0666,$tmpws;
	return 1;
}

# $html = &get_test_worksheet($TEST{'id'),$CLIENT{'clid'},$pageno);
sub get_test_worksheet {
	$tmpws = join($pathsep, $questionroot, "Ins", "$_[0].$_[1].$_[2]");
	open (TMPWS, "<$tmpws");
	@lines = <TMPWS>;
	close TMPWS;
	$sreturn = "";
	for (0 .. $#lines) {
		$sreturn = join('', $sreturn, $lines[$_]);
	}
	@lines=();
	return $sreturn;
}

sub get_test_worksheet_pagelist {
	$tmpws = join($pathsep, $questionroot, "Ins");
	opendir(DIR, $tmpws);
    @dots = readdir(DIR);
    closedir DIR;
	@tpagenos = ();
	$rmmask = "$_[1].$_[0].";
	$sreturn = "";
	foreach $rmfile (@dots) {
		if ($rmfile =~ /$rmmask/ ) {
			@segs = split(/\./,$rmfile);
			push @tpagenos, "$segs[$#segs]";
			@segs = ();
		}
	}
	@tpages = sort @tpagenos;
	if ($#tpages != -1) {
		$sreturn = $tpages[0];
		for (1 .. $#tpages) {
			$sreturn = join('.',$sreturn,$tpages[$_]);
		}
	}
	@tpages = ();
	@tpagenos = ();
	@dots = ();
	return $sreturn;
}

sub set_test_acl_hdr {
	return "wccndid&testid&euid&eunme&tcnt\n";
}

sub get_test_acl_file {
	my ($clid,$testid) = @_;
	my @trecs=();
	my $taccfile=join($pathsep, $dataroot,"tacl.$clid");
	if (&file_exists($taccfile)) {
		my @recs=(), @alrecs;
		@recs=&get_data("tacl.$clid");
		@trecs=grep( /\&$testid\&/, @recs);
		@alrecs=grep( /\&_____\&/, @trecs);
		if ($#alrecs < 0) {
			$TEST{'autologin'} = "N";
			$TEST{'chkautologin'} = "";
		} else {
			$TEST{'autologin'} = "Y";
			$TEST{'chkautologin'} = "CHECKED";
		}
		@recs=();
		@alrecs=();
	}
	$thdr=&set_test_acl_hdr();
	unshift @trecs,$thdr;
	return @trecs;
}

sub put_test_acl_file {
	my ($clid,$testid,$wcndid) = @_;
	my @dboperrs=();
	my @trecs=();
	my $taccfile=join($pathsep, $dataroot,"tacl.$clid");
	if (&file_exists($taccfile)) {
		my @recs=();
		@recs=&get_data("tacl.$clid");
		@trecs=grep( ! /\&$testid\&/, @recs);
		@recs=();
	}
	my $filedata=$FORM{'pwdlist'};
	$filedata=~ tr /+/ /;
	@recs=split(/\;/,$filedata);
	my $rec=shift @trecs;
	my @flds=();
	foreach $rec (@recs) {
		@flds=split(/\,/, $rec);
		if ($#flds != -1) {
			if ($#flds == 0 ) {
				$rec=join('&',$wcndid,$testid,$flds[0],"","1\n");
			} elsif ($#flds == 1) {
				$rec=join('&',$wcndid,$testid,$flds[0],$flds[1],"1\n");
			} else {
				$rec=join('&',$wcndid,$testid,$flds[0],$flds[1],"$flds[2]\n");
			}
			@flds=grep( /\&$testid\&$flds[0]\&/, @trecs);
			if ($#flds == -1) {
				push @trecs, "$rec";
			} else {
				push @dboperrs, "$rec";
			}
		}
		@flds=();
	}
	@recs = sort @trecs;
	@trecs=();
	$thdr=&set_test_acl_hdr();
	unshift @recs,$thdr;
	open (TMPFILE, ">$taccfile");
	foreach $rec (@recs) {
		print TMPFILE $rec;
	}
	close TMPFILE;
	@recs=();
	return "Test Access Control records for test $testid updated.";
}

sub drop_test_acl_file {
	my ($clid,$testid,$wcndid) = @_;
	my @trecs=();
	my $taccfile=join($pathsep, $dataroot,"tacl.$clid");
	if (&file_exists($taccfile)) {
		my @recs=();
		@recs=&get_data("tacl.$clid");
		@trecs=grep( ! /\&$testid\&/, @recs);
		@recs=();
	}
	open (TMPFILE, ">$taccfile");
	foreach $rec (@trecs) {
		print TMPFILE $rec;
	}
	close TMPFILE;
	@trecs=();
	return "Test Access Control records for test $testid removed.";
}

sub get_test_acl_list {
	my ($clid,$testid) = @_;
	my @trecs=&get_test_acl_file($clid,$testid);
	my $html="";
	my $rec;
	my $wcndid="";
	if ($#trecs > 0) {
		my $trash=shift @trecs;
		for (0 .. $#trecs) {
			@flds=split(/&/, $trecs[$_]);
			if ($wcndid eq "") { $wcndid="$flds[0]";}
			$html=join('',$html,"$flds[2],$flds[3];");
			@flds=();
		}
	}
	$html =~ tr/ /+/;
	@trecs=();
	my @rarray=();
	push @rarray, $wcndid;
	push @rarray, $html;
	return @rarray;
}

sub get_wildcard_cndids {
	my ($clid) = @_;
	my @recs=&get_data("cnd.$clid");
	my @trecs=grep( /\&#\&/ , @recs);
	@recs=();
	return @trecs;
}

sub get_acl_cndlist {
	my ($clid,$defcnd) = @_;
	my @trecs=get_wildcard_cndids($clid);
	my $html="";
	my $rowhtml;
	my $selected="";
	if ($#trecs != -1) {
		for (0 .. $#trecs) {
			@flds=split(/&/, $trecs[$_]);
			$selected=($flds[0] eq $defcnd) ? " selected" : "";
			$rowhtml="<option value=\"$flds[0]\"$selected> $flds[0]\r\n";
			$html=join('',$html,$rowhtml);
			@flds=();
		}
	}
	@trecs=();
	return $html;
}

sub get_tacl_profile {
	my ($isauto) = @_;
	my $taclrec;
	my $html="";
	my $html2="";
	my $flds=();
	my @tacltests=split(/::/, $SESSION{'taclauthtests'});
	my $ctests;
	my $comptests=get_completed_tests($SESSION{'clid'}, $SESSION{'taclid'});
	$comptests = substr($comptests,1);
	foreach $ctest (split(/\;/, $comptests)) {
		$ctests .= ":".$ctest.":";
	}
	foreach $taclrec (@tacltests) {
		@flds=split(/&/, $taclrec);
		$testid = $flds[1];
		&get_test_profile($SESSION{'clid'},$testid);
		if ($TEST{'retkcnt'} == 1 && $ctests =~ /:$testid:/) {
			if ($isauto eq "regauto") {
				$html2=join('', $html2, "<INPUT NAME=tstid TYPE=HIDDEN VALUE=\"$TEST{'id'}\">\n");
			} else {
				$html2=join('', $html2, "<OPTION VALUE=\"$TEST{'id'}\">$TEST{'desc'}</OPTION>\n");
			}
			next;
		}
		if ($isauto eq "regauto") {
			$html=join('', $html, "<INPUT NAME=tstid TYPE=HIDDEN VALUE=\"$TEST{'id'}\">\n");
		} else {
			$html=join('', $html, "<OPTION VALUE=\"$TEST{'id'}\">$TEST{'desc'}</OPTION>\n");
		}
	}
	$CANDIDATE{'tacltests'}="$html";
	$CANDIDATE{'taclctests'}="$html2";
	$CANDIDATE{'nmf'}="Anonymous";
	$CANDIDATE{'nml'}=$SESSION{'taclid'};
	return;
}

sub split_test_filename {
	my ($fn,$clid,$tstid) = @_;
	my @segs=();
	my @rsegs=split(/\./,$clid);
	my $i=$#rsegs;
	@rsegs=split(/\./,$tstid);
	my $j=$#rsegs;
	@rclid=();
	my $recseg="";
	my $joint="";
	my @flds=split(/\./,$fn);
	for (0 .. $#flds) {
		$recseg=join($joint,$recseg,$flds[$_]);
		$joint=".";
		if (($_ == $i) || ($_ == $#flds-$j-1)) {
			push @segs,$recseg;
			$recseg="";
			$joint="";
		}
	}
	$recseg=$flds[$#flds];
	@flds=();
	push @segs, $recseg;
	return @segs;
}

sub is_client_selfreg {
	$clid = $_[0];
	@recs = &get_data("tests.$clid");
	$rec = shift @recs;
	if ($#recs != -1) {
		LINE: foreach $rec (@recs) {
			@fields = split(/&/, $rec);
			@availtoflags = split (/\./, $fields[30]);
			$slfregenab = ($availtoflags[0] eq 'Y' ) ? 1 : 0;
			last LINE if ($slfregenab);
		}
		return $slfregenab;
	}
	return 0;
}

sub is_client_emlpwd {
	$clid = $_[0];
	@recs = &get_data("tests.$clid");
	$rec = shift @recs;
	if ($#recs != -1) {
		LINE: foreach $rec (@recs) {
			@fields = split(/&/, $rec);
			@availtoflags = split (/\./, $fields[30]);
			$emlpwdenab = ($availtoflags[10] eq 'Y' ) ? 1 : 0;
			last LINE if ($emlpwdenab);
		}
		return $emlpwdenab;
	}
	return 0;
}

sub prepFilter {
	my $clientID = $_[1];
	
	#this sets up the groups for parsing in the filters
	$grpfile = join( $pathsep, $dataroot, "groups.$clientID");
	open GRPFILE, "<$grpfile";
	my @grpraw;
	foreach (<GRPFILE>) {
		my @trasharray = split('&', $_);
		push @grpraw, $_;
	}
	my $grp_label = shift(@grpraw);
	chomp $grp_label;
	my @grp_label_array = split('&', $grp_label);
	my $grpmembers, $grpowners, $mygrp;	#variables to hold all members and owners
	my @current_members;			#temporary array to hold all members until set to scalar
	my %grphash = ();			#holds the various grps
	foreach (@grpraw) {
		chomp $_;
		my @trasharray = split('&', $_);
		foreach (0..$#grp_label_array) {
			$grphash{$grp_label_array[$_]} = $trasharray[$_];
		}
		if ($grphash{'grpowner'} eq $SESSION{'uid'}) {
			$mygrp .= "$grphash{'grplist'},";
		}
			
		@tmp_members = split(',', $grphash{'grplist'});
		my %union = ();
		$e = 0;
		foreach $e (@current_members, @tmp_members) { $union{$e}++}; 
		@current_members = keys %union;
		$grpowners .= "$grphash{'grpowner'}," unless $grpowners =~ /$grphash{'grpowner'}/;
	}
	foreach (@current_members) {
		$grpmembers .= "$_,";	#the union takes care of problems with passes
	}
		
	#this line finds out if you're a group owner or not, will have to change if grpowner status is not tracked by cnd.clientid
	$i_am_grpowner = &get_a_key("cnd.$clientID", $SESSION{'uid'}, "grpowner");
	$i_am_registrar = $CANDIDATE{'registrar'};
	return ($i_am_grpowner, $grpmembers, $grpowners, $mygrp, $i_am_registrar);
}

sub makeMeFilter {
	#If you have more required fields, you'll have to add them to the stack in every place makeMeFilter is called
	my ($id, $clientID, $i_am_grpowner, $grpmembers, $grpowners, $mygrp, $i_am_registrar) = @_;

	$filter_count = 0;
	$cnd_pass = 0;
	#$filter_count is the number of filters
	#run on the cnds, specified by the
	#drop down menus on maintcnd.htt.
	#$cnd_pass is the number of filters the
	#cnd in question has passed.
	#if $cnd_pass ne $filter_count, then
	#the cnd failed the filters

	#BEGIN FILTERS
	if ( $CLIENT{'rstnongrps'} eq "Y" ) {	#filters out non grouped cnds
		$filter_count += 1;
		if ($i_am_grpowner eq "Y") {
			if ($grpmembers =~ /$id,/ && $grpowners =~ /$SESSION{'uid'}/) {
				$cnd_pass += 1;
			}
		} else {
			$cnd_pass += 1;
		}
	}
	if ( $CLIENT{'rsttogrp'} eq "Y" ) {	#filters out only GROUPED cnds not in your group (i.e., ungrouped cnds are still viewed)
		$filter_count += 1;
		if ($i_am_grpowner eq "Y") {
			if ($mygrp =~ /$id,/ || !($grpmembers =~ /$id/)) {
				$cnd_pass += 1;
			}
		} else {
			$cnd_pass += 1;
		}
	}
		
	if ( $CLIENT{'rstgrpown'} eq "Y" ) {	#filters out other groupowners
		$filter_count += 1;
		if ($i_am_grpowner eq "Y") {
			if ( !($grpowners =~ /$id/) || $id eq $SESSION{'uid'}) {
				$cnd_pass += 1;
			}
		} else {
			$cnd_pass += 1;
		}
	}
	if ( defined($day_filter) && $day_filter > 0 ) {	#active cnd filter
		$filter_count += 1;
		$file_time = &get_last_cnd_action($clientID, $id);
		$clean_cnd = &compare_time($id, $file_time, $day_filter);
		$cnd_pass += 1 unless $clean_cnd eq 1;
	}
	if ( defined($date_filter) && $date_filter > 0 ) {	#createdate filter
		$filter_count += 1;
		$file_time = &get_a_key("cnd.$clientID", $id, "createdate");
		$clean_cnd = &compare_time($id, $file_time, $date_filter);
		$cnd_pass += 1 unless $clean_cnd eq 1;
	}
	if ($cnd1_filter ne '' ) {	#filters cnd special field 1 mismatch
		$filter_count += 1;
		$cnd1_val = &get_a_key("cnd.$clientID", $id, "cnd1");
		$cnd_pass += 1 unless $cnd1_val ne $cnd1_filter;
	}
	if ($cnd2_filter ne '' ) {	#filters cnd special field 2 mismatch
		$filter_count += 1;
		$cnd2_val = &get_a_key("cnd.$clientID", $id, "cnd2");
		$cnd_pass += 1 unless $cnd2_val ne $cnd2_filter;
	}
	if ($cnd3_filter ne '' ) {	#filters cnd special field 3 mismatch
		$filter_count += 1;
		$cnd3_val = &get_a_key("cnd.$clientID", $id, "cnd3");
		$cnd_pass += 1 unless $cnd3_val ne $cnd3_filter;
	}
	if ($cnd4_filter ne '' ) {	#filters cnd special field 4 mismatch
		$filter_count += 1;
		$cnd4_val = &get_a_key("cnd.$clientID", $id, "cnd4");
		$cnd_pass += 1 unless $cnd4_val ne $cnd4_filter;
	}
	if ($i_am_registrar eq "Y" && $SESSION{'uid'} ne $id) {	#filters registrars to their own cnds
		$cnd_creator = &get_a_key("cnd.$clientID", $id, "createdby");
		$filter_count += 1;
		$cnd_pass += 1 unless $cnd_creator ne $SESSION{'uid'};
	}

	#The filters are added up here
	if ($filter_count eq $cnd_pass) {	
		return 0;
	} else {
		return 1;
	}
}

# end with True because this is a require file
1