You can not select more than 25 topics
Topics must start with a letter or number, can include dashes ('-') and can be up to 35 characters long.
2175 lines
68 KiB
2175 lines
68 KiB
4 months ago
|
#!/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;
|
||
|
# 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'} = "<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=\"300\" 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
|