anomalist
/
survey-manager
1
0
Fork 0
Code Issues Pull Requests Projects Releases Wiki Activity
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.
6 Commits
1 Branch
0 Tags
244 MiB
 
 
 
 
 
 
Branch: master
Branches Tags
${ item.name }
Create tag ${ searchTerm }
Create branch ${ searchTerm }
from 'master'
${ noResults }
survey-manager/survey-nginx/cgi-bin/cybertestlib.bu.pl

2135 lines
67 KiB
Raw Permalink Blame History

#!/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