#!/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 .= '®istrar'."\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] .= '®istrar'."\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. 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, "<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 ($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'} = "<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 = () ; 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'} = "<A NAME=\"qimage\" HREF=\"$cgiroot/imagepop.pl?tid=$SESSION{'tid'}\&img=$_[1].$QUESTION{'id'}.$fext\" TARGET=\"illustrated\">$IllustrationLabel</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\">\ <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('',"\ <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] = "# ".$data[1]; } else { $data[1] = " ".$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\"> $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\"> $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|2|3|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=(); my $posttest_ok = 1 ; my $trash3 = join($pathsep, $testcomplete, "$SESSION{'clid'}.$SESSION{'uid'}.Eval"); foreach $rec (@srtrecs) { @flds=split(/&/,$rec); $stripfld=shift @flds; &get_test_profile($SESSION{'clid'},$flds[0]); my $mul_allowed = 0 ; my $mul_cnt_taken = 0 ; unless ($TEST{'retkcnt'} == 1 || $TEST{'retkcnt'} eq "unlimited") { $mul_allowed = 1 ; $mul_cnt_taken = get_cnd_test_cnt_from_history($testcomplete,$SESSION{'clid'},$SESSION{'uid'},$flds[0]) ; } # HBI Add hard coded test to not allow test posttest if test eval is not complete. # HBI Requested per BC and IBM. if ($flds[0] eq "posttest" && $SESSION{'clid'} eq "sysfound") { if ( -e $trash3 ) { $posttest_ok = 1 ; } else { $posttest_ok = 0 ; } } else { $posttest_ok = 1 ; } ### Check completed status and retake options if ( ( (!("\;$completedlist\;" =~ /\;$flds[0]\;/i)) || ("\;$completedlist\;" =~ /\;$flds[0]\;/i && $TEST{'retkcnt'} eq "unlimited") || ($mul_allowed && ($mul_cnt_taken < $TEST{'retkcnt'})) ) && ($FORM{'testid'} eq "" || $FORM{'testid'} eq $flds[0]) && $posttest_ok) { $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 = $_[0]; #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