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

Get_Candidate_Profile Chop= $ded

\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 .= '®istrar'."\n"; } unshift(@crecs, $shift_hack); foreach $crec (@crecs) { $ded = chop ($crec); if ( "$ded" ne "\n" ) { print "

Put_Candidate_Profile Chop= $ded

\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] .= '®istrar'."\n"; } $crecs[0] =~ (s/grpid/createdby/); $ded = chop ($chgrec); if ( "$ded" ne "\n" ) { print "

Add_Candidate_Profile Chop= $ded

\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. unless ($_[0]) {warn "get_client_profile called without a client id." ;} @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 warn "get_client_profile failed for $_[0]." ; } 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, ""); $logo_html = join('', $logo_html, $srcsep, ""); $testlogo_html = join('', $testlogo_html, ""); unless ($srcsep) { $srcsep = ($CLIENT{'clalgn'} eq 'vt') ? "
\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'} = ""; } $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 = ; 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; # Old default was now. New default is set in sitecfg.pl. $year = $UI{DEFAULT_AVAILTHRU_YEAR} ; $mon = 11 ; # December, 0 based. my $realMon = $mon + 1 ; $day = 31 ; # End of December. ($hour,$minute) = ($UI{DEFAULT_AVAILTHRU_HR}, sprintf("%2d",$UI{DEFAULT_AVAILTHRU_MIN})); $TEST->{availthru} = "$realMon/$day/$year-$hour:$minute" ; # Fill in computed default. } $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 ($instanceof ne '') { $params->{'instance'} = "Y"; $params->{'instanceof'} = "$instanceof"; } else { $params->{'instance'} = "N"; $params->{'instanceof'} = ""; } @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'} = ""; 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'} = "Reference Page"; } if ($illusfile ne '') { @filesegs = split(/\./, $illusfile); $fext = $filesegs[$#filesegs]; @filesegs = () ; my $IllustrationLabel = "" ; if ($fext =~ /pdf$/i ) { $IllustrationLabel = "Click Here" ; } else { $IllustrationLabel = "Illustration" ; } if ($SYSTEM{'supportedimagemedia'} =~ m/$fext/i ) { if ($QUESTION{'qim'} eq '1') { $QUESTION{'illustration'} = "$IllustrationLabel"; $QUESTION{'defthumbnail'} = ""; } else { $QUESTION{'illustration'} = ""; $QUESTION{'defthumbnail'} = ""; } } elsif ($SYSTEM{'supportedvideomedia'} =~ m/$fext/i ) { $QUESTION{'illustration'} = ""; } elsif ($SYSTEM{'supportedaudiomedia'} =~ m/$fext/i ) { $QUESTION{'illustration'} = ""; } } #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 = "\n"; for (my $i=0; $i<=$#sub_text; $i++) { my $j = $i + 1; $sub_text_html .= " "; $sub_text_html .= "\n"; } $sub_text_html .= "
Text area $j:
"; $sub_text_html .= "

\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'}="
$qflags[1]

\n"; if (($QUESTION{'layout'} eq '4') || ($QUESTION{'layout'} eq '5') || ($QUESTION{'qtyp'} eq 'nrt')) { $QUESTION{'promptcomments'}=join('',"\ 
",$QUESTION{'promptcomments'}); } else { $QUESTION{'promptcomments'}=join('',"",$QUESTION{'promptcomments'},""); } } # 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 "