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.
762 lines
18 KiB
762 lines
18 KiB
4 months ago
|
#!/usr/bin/perl
|
||
|
|
#
|
||
|
|
# $Id: sbalib.pl
|
||
|
|
#
|
||
|
|
# Source File: sbalib.pl
|
||
|
|
|
||
|
|
sub create_subjarea_file {
|
||
|
|
my ($clid, $tstid, $mid) = @_;
|
||
|
|
my $sasysfn;
|
||
|
|
my $sacmfn;
|
||
|
|
my $sactfn;
|
||
|
|
my $bOK;
|
||
|
|
|
||
|
|
$sasysfn = join( $pathsep, $dataroot, "subjarea.std");
|
||
|
|
$sactfn = join( $pathsep, $questionroot, "$tstid.$clid.sba");
|
||
|
|
$sacmfn = join( $pathsep, $dataroot, "subjarea.$clid");
|
||
|
|
|
||
|
|
$bOK=true;
|
||
|
|
if (&file_exists($sacmfn)==0) {
|
||
|
|
$bOK=&make_file($sacmfn,$sasysfn,0);
|
||
|
|
}
|
||
|
|
if ($bOK) {
|
||
|
|
if (&file_exists($satcfn)==0) {
|
||
|
|
$bOK=&make_file($sactfn,$sacmfn,1);
|
||
|
|
}
|
||
|
|
}
|
||
|
|
return $bOK;
|
||
|
|
}
|
||
|
|
|
||
|
|
sub add_subjarea_to_master {
|
||
|
|
my ($clid, $tstid, $opts) = @_;
|
||
|
|
my @satrecs;
|
||
|
|
my $satrec;
|
||
|
|
my @samrecs;
|
||
|
|
my $samrec;
|
||
|
|
my $ntrecs;
|
||
|
|
my $nmrecs;
|
||
|
|
my $nadd;
|
||
|
|
my @flds;
|
||
|
|
my @xflds;
|
||
|
|
my $i;
|
||
|
|
my $j;
|
||
|
|
my $k;
|
||
|
|
my $n;
|
||
|
|
my $rid;
|
||
|
|
my $bfound;
|
||
|
|
my @sbamids = split(/\,/, $opts);
|
||
|
|
$nadd=$#sbamids;
|
||
|
|
if (($nadd==-1) && ($opts eq "")) { return 1;}
|
||
|
|
@samrecs=&get_subjarea_masters($clid,"","");
|
||
|
|
$nmrecs=$#samrecs;
|
||
|
|
if ($nmrecs == -1) {
|
||
|
|
$rid=0;
|
||
|
|
} else {
|
||
|
|
$samrec=$samrecs[$nmrecs];
|
||
|
|
@flds=split(/&/,$samrec);
|
||
|
|
$rid=int($flds[0]);
|
||
|
|
}
|
||
|
|
@satrecs=&get_subjarea_masters($clid,$tstid,"");
|
||
|
|
$ntrecs=$#satrecs;
|
||
|
|
$n=0;
|
||
|
|
for $i (1 .. $ntrecs) {
|
||
|
|
$satrec=$satrecs[$i];
|
||
|
|
for $j (0 .. $nadd) {
|
||
|
|
if ($sbamids[$j] ne "") {
|
||
|
|
@flds=split(/&/,$satrec);
|
||
|
|
if ($flds[0] eq $sbamids[$j]) {
|
||
|
|
$bfound=0;
|
||
|
|
for $k (1 .. $nmrecs) {
|
||
|
|
$samrec=$samrecs[$k];
|
||
|
|
@xflds=split(/&/,$samrec);
|
||
|
|
if ($xflds[1] eq $flds[0]) {
|
||
|
|
$bfound=1;
|
||
|
|
break;
|
||
|
|
}
|
||
|
|
}
|
||
|
|
if ($bfound==0) {
|
||
|
|
$rid++;
|
||
|
|
$samrec=join('&',$rid,$flds[0],"$flds[2]");
|
||
|
|
push @samrecs, $samrec;
|
||
|
|
$n++;
|
||
|
|
}
|
||
|
|
}
|
||
|
|
}
|
||
|
|
if ($bfound) { break;}
|
||
|
|
}
|
||
|
|
}
|
||
|
|
if ($n) {
|
||
|
|
my $trash = join( $pathsep, $dataroot, "subjarea.$clid");
|
||
|
|
open (TSTFILE, ">$trash");
|
||
|
|
foreach $samrec (@samrecs) {
|
||
|
|
print TSTFILE "$samrec";
|
||
|
|
}
|
||
|
|
close TSTFILE;
|
||
|
|
}
|
||
|
|
return 1;
|
||
|
|
}
|
||
|
|
|
||
|
|
sub add_subjarea_fm_master {
|
||
|
|
my ($clid, $tstid, $opts) = @_;
|
||
|
|
my @satrecs;
|
||
|
|
my $satrec;
|
||
|
|
my @samrecs;
|
||
|
|
my $samrec;
|
||
|
|
my $ntrecs;
|
||
|
|
my $nmrecs;
|
||
|
|
my $nadd;
|
||
|
|
my @flds;
|
||
|
|
my @xflds;
|
||
|
|
my $i;
|
||
|
|
my $j;
|
||
|
|
my $k;
|
||
|
|
my $n;
|
||
|
|
my $bfound;
|
||
|
|
my @sbamids = split(/\,/, $opts);
|
||
|
|
$nadd=$#sbamids;
|
||
|
|
if (($nadd==-1) && ($opts eq "")) { return 1;}
|
||
|
|
@samrecs=&get_subjarea_masters($clid,"","");
|
||
|
|
$nmrecs=$#samrecs;
|
||
|
|
@satrecs=&get_subjarea_masters($clid,$tstid,"");
|
||
|
|
$ntrecs=$#satrecs;
|
||
|
|
$n=0;
|
||
|
|
for $i (1 .. $nmrecs) {
|
||
|
|
$samrec=$samrecs[$i];
|
||
|
|
chop($samrec);
|
||
|
|
for $j (0 .. $nadd) {
|
||
|
|
if ($sbamids[$j] ne "") {
|
||
|
|
@flds=split(/&/,$samrec);
|
||
|
|
if ($flds[0] eq $sbamids[$j]) {
|
||
|
|
$bfound=0;
|
||
|
|
for $k (1 .. $ntrecs) {
|
||
|
|
$satrec=$satrecs[$k];
|
||
|
|
@xflds=split(/&/,$satrec);
|
||
|
|
if ($xflds[0] eq $flds[1]) {
|
||
|
|
$bfound=1;
|
||
|
|
break;
|
||
|
|
}
|
||
|
|
}
|
||
|
|
if ($bfound==0) {
|
||
|
|
$k=&count_subj_skill_questions($clid,$tstid,1,"$flds[1]");
|
||
|
|
$satrec=join('&',$flds[1],$flds[0],$flds[2],"$k\n");
|
||
|
|
push @satrecs, $satrec;
|
||
|
|
$n++;
|
||
|
|
}
|
||
|
|
}
|
||
|
|
}
|
||
|
|
if ($bfound) { break;}
|
||
|
|
}
|
||
|
|
}
|
||
|
|
if ($n) {
|
||
|
|
$satrec = shift @satrecs;
|
||
|
|
@samrecs = sort(@satrecs);
|
||
|
|
unshift @samrecs, $satrec;
|
||
|
|
my $trash = join( $pathsep, $questionroot, "$tstid.$clid.sba");
|
||
|
|
open (TSTFILE, ">$trash");
|
||
|
|
foreach $satrec (@samrecs) {
|
||
|
|
print TSTFILE "$satrec";
|
||
|
|
}
|
||
|
|
close TSTFILE;
|
||
|
|
}
|
||
|
|
return 1;
|
||
|
|
}
|
||
|
|
|
||
|
|
sub get_subjarea_pctinptbl {
|
||
|
|
my ($clid, $tstid, $opts) = @_;
|
||
|
|
my $i;
|
||
|
|
my $j;
|
||
|
|
my $inpnm;
|
||
|
|
my $rowhtml;
|
||
|
|
my $htmlcode="";
|
||
|
|
my @sarecs=();
|
||
|
|
my $sarec="";
|
||
|
|
my @flds=();
|
||
|
|
if ($opts) {
|
||
|
|
@sarecs=split(/\n/,$opts);
|
||
|
|
} else {
|
||
|
|
@sarecs=&get_subjarea_masters($clid,$tstid,"");
|
||
|
|
}
|
||
|
|
my $nsarecs=$#sarecs;
|
||
|
|
$j=0;
|
||
|
|
for $i (1 .. $nsarecs) {
|
||
|
|
$rowhtml="";
|
||
|
|
$sarec=$sarecs[$i];
|
||
|
|
@flds=split(/&/,$sarec);
|
||
|
|
$flds[3]=&count_subj_skill_questions($clid,$tstid,1,"$flds[0]");
|
||
|
|
$rowhtml=join('', $rowhtml, "<TR>\n");
|
||
|
|
$inpnm=join('', "sapmtxr","$j", "n");
|
||
|
|
$rowhtml=join('', $rowhtml, "<TD ALIGN=LEFT><FONT SIZE=2><INPUT TYPE=TEXT NAME=\"$inpnm\" VALUE=\"\" SIZE=4 MAXLENGTH=3 onChange=\"return sapmtxPChange($j,-1,this)\"></FONT>");
|
||
|
|
$inpnm=join('', "sapmtxrnm","$j");
|
||
|
|
$rowhtml=join('', $rowhtml, "<INPUT TYPE=hidden NAME=\"$inpnm\" VALUE=\"$flds[0]\"></TD>\n");
|
||
|
|
$rowhtml=join('', $rowhtml, "<TD ALIGN=LEFT><FONT SIZE=1><u>$flds[3]</u>\ </TD>\n");
|
||
|
|
$rowhtml=join('', $rowhtml, "<TD ALIGN=LEFT><FONT SIZE=1>$flds[0]\ </FONT></TD>\n");
|
||
|
|
$inpnm=join('', "sapmtxrnd","$j");
|
||
|
|
$rowhtml=join('', $rowhtml, "<TD ALIGN=right><FONT SIZE=2><INPUT TYPE=checkbox NAME=\"$inpnm\" onClick=\"return sapmtxQRChange($j,this)\"></TD>\n");
|
||
|
|
$inpnm=join('', "sapmtxrord","$j");
|
||
|
|
$rowhtml=join('', $rowhtml, "<TD ALIGN=right><FONT SIZE=2><INPUT TYPE=TEXT NAME=\"$inpnm\" VALUE=\"$i\" SIZE=3 MAXLENGTH=3 onChange=\"return sapmtxFOChange($j,this)\"></TD>\n");
|
||
|
|
$rowhtml=join('', $rowhtml, "</TR>\n");
|
||
|
|
$htmlcode = join('', $htmlcode, $rowhtml);
|
||
|
|
$j++;
|
||
|
|
}
|
||
|
|
return $htmlcode;
|
||
|
|
}
|
||
|
|
|
||
|
|
sub get_skilllvl_masters {
|
||
|
|
my ($clid, $tstid, $opts) = @_;
|
||
|
|
my $skdata = "id\&lvl\&qcnt;BASIC\&0\&0;INTERMEDIATE\&1\&0;ADVANCED\&2\&0";
|
||
|
|
my @skrecs = split(/\;/,$skdata);
|
||
|
|
return @skrecs;
|
||
|
|
}
|
||
|
|
|
||
|
|
sub count_subj_skill_questions {
|
||
|
|
my ($clid, $tstid, $opts, $svalue) = @_;
|
||
|
|
my $i;
|
||
|
|
my $j;
|
||
|
|
my $c;
|
||
|
|
my $sfind;
|
||
|
|
my @flds=();
|
||
|
|
my @qcnts=();
|
||
|
|
my @qrs = &get_question_list($tstid,$clid);
|
||
|
|
my $qrec = shift @qrs;
|
||
|
|
my $nq=$#qrs;
|
||
|
|
@flds=split(/&/, $qrec);
|
||
|
|
for $i (0 .. $#flds) {
|
||
|
|
if ($flds[$i] eq "subj") {
|
||
|
|
$j=$i;
|
||
|
|
break;
|
||
|
|
}
|
||
|
|
}
|
||
|
|
for $i (0 .. $nq) {
|
||
|
|
@flds=split(/&/,$qrs[$i]);
|
||
|
|
if ($flds[$j] =~ /\./ ) {
|
||
|
|
$qrs[$i]="\&$flds[$j]\&\n";
|
||
|
|
} else {
|
||
|
|
$qrs[$i]="\&$flds[$j].0\&\n";
|
||
|
|
}
|
||
|
|
}
|
||
|
|
if ($opts == 1) {
|
||
|
|
$sfind="\&$svalue\.";
|
||
|
|
} elsif ($opts == 2) {
|
||
|
|
$sfind="\.$svalue\&";
|
||
|
|
} else {
|
||
|
|
$sfind="\&$svalue\&";
|
||
|
|
}
|
||
|
|
@qcnts=grep(/$sfind/,@qrs);
|
||
|
|
$c=$#qcnts+1;
|
||
|
|
@qcnts=();
|
||
|
|
return "$c";
|
||
|
|
}
|
||
|
|
|
||
|
|
sub get_skilllevel_pctinptbl {
|
||
|
|
my ($clid, $tstid, $opts) = @_;
|
||
|
|
my $i;
|
||
|
|
my $j;
|
||
|
|
my $inpnm;
|
||
|
|
my $rowhtml;
|
||
|
|
my $htmlcode="";
|
||
|
|
my @skrecs=();
|
||
|
|
my $skrec="";
|
||
|
|
my @flds=();
|
||
|
|
if ($opts) {
|
||
|
|
@skrecs=split(/\n/,$opts);
|
||
|
|
} else {
|
||
|
|
@skrecs=&get_skilllvl_masters($clid,$tstid,"");
|
||
|
|
}
|
||
|
|
my $nskrecs=$#skrecs;
|
||
|
|
$j=0;
|
||
|
|
for $i (1 .. $nskrecs) {
|
||
|
|
$rowhtml="";
|
||
|
|
$inpnm=join('', "sapmtxc","$j","n");
|
||
|
|
$skrec=$skrecs[$i];
|
||
|
|
@flds=split(/&/,$skrec);
|
||
|
|
$flds[2]=&count_subj_skill_questions($clid,$tstid,2,"$flds[1]");
|
||
|
|
$rowhtml=join('', $rowhtml, "<TR>\n<TD ALIGN=LEFT><FONT SIZE=2>\ ");
|
||
|
|
$rowhtml=join('', $rowhtml, "<INPUT TYPE=TEXT NAME=\"$inpnm\" VALUE=\"\"");
|
||
|
|
$rowhtml=join('', $rowhtml, " SIZE=4 MAXLENGTH=3 onChange=\"return sapmtxPChange(-1,");
|
||
|
|
$rowhtml=join('', $rowhtml, "$j");
|
||
|
|
$rowhtml=join('', $rowhtml, ",this)\"></FONT>");
|
||
|
|
$inpnm=join('', "sapmtxcnm","$j");
|
||
|
|
$rowhtml=join('', $rowhtml, "<INPUT TYPE=hidden NAME=\"$inpnm\" VALUE=\"$flds[0]\">");
|
||
|
|
$rowhtml=join('', $rowhtml, "</TD>\n");
|
||
|
|
$rowhtml=join('', $rowhtml, "<TD ALIGN=LEFT><FONT SIZE=1><u>");
|
||
|
|
$rowhtml=join('', $rowhtml, "$flds[2]");
|
||
|
|
$rowhtml=join('', $rowhtml, "</u>\ ");
|
||
|
|
$rowhtml=join('', $rowhtml, "$flds[0]");
|
||
|
|
$rowhtml=join('', $rowhtml, "\ </FONT></TD></TR>\n");
|
||
|
|
$htmlcode = join('', $htmlcode, $rowhtml);
|
||
|
|
$j++;
|
||
|
|
}
|
||
|
|
return $htmlcode;
|
||
|
|
}
|
||
|
|
|
||
|
|
sub get_subjskill_cntgrdtbl {
|
||
|
|
my ($clid, $tstid, $opts) = @_;
|
||
|
|
my $i;
|
||
|
|
my $j;
|
||
|
|
my $k;
|
||
|
|
my $htmlcode="";
|
||
|
|
my @flds=();
|
||
|
|
#
|
||
|
|
# get subject areas
|
||
|
|
#
|
||
|
|
&upd_subjarea_qcount($clid,$tstid,"");
|
||
|
|
my @sarecs=&get_subjarea_masters($clid,$tstid,"");
|
||
|
|
my $nsarecs=$#sarecs;
|
||
|
|
my $sarec="";
|
||
|
|
|
||
|
|
#
|
||
|
|
# get skill levels
|
||
|
|
#
|
||
|
|
my @skrecs=&get_skilllvl_masters($clid,$tstid,"");
|
||
|
|
my $nskrecs=$#skrecs;
|
||
|
|
my $skrec="";
|
||
|
|
|
||
|
|
#
|
||
|
|
# get subject areas percentage input table rows html code
|
||
|
|
#
|
||
|
|
my $rowhtml="";
|
||
|
|
for $i (0 .. $nsarecs) {
|
||
|
|
$rowhtml = join('', $rowhtml, "$sarecs[$i]");
|
||
|
|
}
|
||
|
|
$SUBJAREA{'subjareapit'}=&get_subjarea_pctinptbl($clid, $tstid, $rowhtml);
|
||
|
|
|
||
|
|
#
|
||
|
|
# get skill level percentage input table rows html code
|
||
|
|
#
|
||
|
|
$rowhtml="";
|
||
|
|
for $i (0 .. $nskrecs) {
|
||
|
|
$rowhtml = join('', $rowhtml, "$skrecs[$i]\n");
|
||
|
|
}
|
||
|
|
$SUBJAREA{'skilllvlpit'}=&get_skilllevel_pctinptbl($clid, $tstid, $rowhtml);
|
||
|
|
|
||
|
|
#
|
||
|
|
# build subject area - skill level counts grid table html code
|
||
|
|
#
|
||
|
|
$rowhtml="";
|
||
|
|
$tablestarthtml="<TABLE cellpadding=0 cellspacing=0 border=0>
|
||
|
|
<TR>
|
||
|
|
<TD ALIGN=CENTER colspan=5><FONT SIZE=1>\ <br></FONT></TD>
|
||
|
|
</TR>\n";
|
||
|
|
$htmlcode = join('', $htmlcode, $tablestarthtml);
|
||
|
|
$tableYcols="<TR>
|
||
|
|
<TD ALIGN=CENTER><FONT SIZE=1><I>(Subject Area)</I></FONT></TD>
|
||
|
|
<TD ALIGN=CENTER><FONT SIZE=1>\ <br></FONT></TD>";
|
||
|
|
for $i (1 .. $nskrecs) {
|
||
|
|
$tableYcols= join('', $tableYcols, "<TD ALIGN=CENTER><FONT SIZE=1>\#</FONT></TD>");
|
||
|
|
}
|
||
|
|
$tableYcols= join('', $tableYcols, "</TR>\n");
|
||
|
|
|
||
|
|
$htmlcode = join('', $htmlcode, $tableYcols);
|
||
|
|
for $i (1 .. $nsarecs) {
|
||
|
|
@flds = split(/&/, $sarecs[$i]);
|
||
|
|
$i--;
|
||
|
|
$rowhtml = "<TR>\n";
|
||
|
|
$rowhtml = join('', $rowhtml, "<TD ALIGN=LEFT><FONT SIZE=1>\ $flds[0]\ </FONT></TD>");
|
||
|
|
$inpnm=join('', "cbuser", "$i");
|
||
|
|
$rowhtml = join('', $rowhtml, "<TD ALIGN=RIGHT><FONT SIZE=1>");
|
||
|
|
$rowhtml = join('', $rowhtml, "<input type=checkbox name=$inpnm onClick=\"return cbuseChange($i,-1)\">");
|
||
|
|
$rowhtml = join('', $rowhtml, "</FONT></TD>\n");
|
||
|
|
for $j (1 .. $nskrecs) {
|
||
|
|
$j--;
|
||
|
|
$defltval=&count_subj_skill_questions($clid,$tstid,2,"$flds[0].$j");
|
||
|
|
$inpnm = join('', "sapmtxr", "$i", "c", "$j");
|
||
|
|
$rowhtml = join('', $rowhtml, "<TD ALIGN=LEFT><FONT SIZE=2>");
|
||
|
|
$rowhtml = join('', $rowhtml, "<INPUT TYPE=TEXT NAME=\"$inpnm\" VALUE=\"\" SIZE=4 MAXLENGTH=3 onChange=\"return sapmtxChange($i,$j,this)\"><u>$defltval</u>");
|
||
|
|
$rowhtml = join('', $rowhtml, "</FONT></TD>\n");
|
||
|
|
$j++;
|
||
|
|
}
|
||
|
|
$rowhtml = join('', $rowhtml, "<\TR>\n");
|
||
|
|
$htmlcode = join('', $htmlcode, $rowhtml);
|
||
|
|
$i++;
|
||
|
|
}
|
||
|
|
$tableendhtml="<TR>\n<TD ALIGN=RIGHT colspan=2><FONT SIZE=1>(use)</FONT></TD>\n";
|
||
|
|
$j=0;
|
||
|
|
for $i (1 .. $nskrecs) {
|
||
|
|
$tableendhtml= join('', $tableendhtml, "<TD ALIGN=CENTER><FONT SIZE=1>\n");
|
||
|
|
$tableendhtml= join('', $tableendhtml, "<input type=checkbox name=cbusec$j onClick=\"return cbuseChange(-1,$j)\">");
|
||
|
|
$tableendhtml= join('', $tableendhtml, "</FONT></TD>\n");
|
||
|
|
$j++;
|
||
|
|
}
|
||
|
|
$tableendhtml=join('', $tableendhtml, "</TR>\n");
|
||
|
|
$tableendhtml=join('', $tableendhtml, "<TR>\n");
|
||
|
|
$tableendhtml=join('', $tableendhtml, "<TD ALIGN=CENTER VALIGN=MIDDLE colspan=2><FONT SIZE=1><I>(Skill Level)</I></FONT></TD>\n");
|
||
|
|
for $i (1 .. $nskrecs) {
|
||
|
|
$tableendhtml= join('', $tableendhtml, "<TD ALIGN=CENTER><FONT SIZE=1>");
|
||
|
|
$tableendhtml= join('', $tableendhtml, "<img src=\"$PATHS{'graphurl'}/linev.gif\">");
|
||
|
|
$tableendhtml= join('', $tableendhtml, "</FONT></TD>\n");
|
||
|
|
}
|
||
|
|
$tableendhtml= join('', $tableendhtml, "</TR>\n");
|
||
|
|
|
||
|
|
for $i (1 .. $nskrecs) {
|
||
|
|
$tableendhtml=join('', $tableendhtml, "<TR>\n");
|
||
|
|
@flds = split(/&/, $skrecs[$i]);
|
||
|
|
$k=$i+1;
|
||
|
|
$tableendhtml= join('', $tableendhtml, "<TD ALIGN=RIGHT colspan=$k><FONT SIZE=1>$flds[0]</FONT></TD>\n");
|
||
|
|
$tableendhtml= join('', $tableendhtml, "<TD ALIGN=CENTER><FONT SIZE=1>");
|
||
|
|
$tableendhtml= join('', $tableendhtml, "<img src=\"$PATHS{'graphurl'}/linedl.gif\">");
|
||
|
|
$tableendhtml= join('', $tableendhtml, "</FONT></TD>\n");
|
||
|
|
for $j ($i .. $nskrecs) {
|
||
|
|
if ($j != $i) {
|
||
|
|
$tableendhtml= join('', $tableendhtml, "<TD ALIGN=CENTER><FONT SIZE=1>");
|
||
|
|
$tableendhtml= join('', $tableendhtml, "<img src=\"$PATHS{'graphurl'}/linev.gif\">");
|
||
|
|
$tableendhtml= join('', $tableendhtml, "</FONT></TD>\n");
|
||
|
|
}
|
||
|
|
}
|
||
|
|
$tableendhtml=join('', $tableendhtml, "</TR>\n");
|
||
|
|
}
|
||
|
|
$tableendhtml= join('', $tableendhtml, "</TR>\n</TABLE></CENTER>\n");
|
||
|
|
$htmlcode = join('', $htmlcode, $tableendhtml);
|
||
|
|
$htmlcode = join('', $htmlcode, "<INPUT NAME=\"sapmtxmaxr\" TYPE=HIDDEN VALUE=\"$nsarecs\">\n");
|
||
|
|
$htmlcode = join('', $htmlcode, "<INPUT NAME=\"sapmtxmaxc\" TYPE=HIDDEN VALUE=\"$nskrecs\">\n");
|
||
|
|
return $htmlcode;
|
||
|
|
}
|
||
|
|
|
||
|
|
sub get_subjarea_masters {
|
||
|
|
my ($clid, $tstid, $opts) = @_;
|
||
|
|
my @sarecs;
|
||
|
|
|
||
|
|
if ($tstid) {
|
||
|
|
my $trash = join( $pathsep, $questionroot, "$tstid.$clid.sba");
|
||
|
|
if ( ! open (TMPFILE, "<$trash") ) {
|
||
|
|
if ($opts) {
|
||
|
|
return "";
|
||
|
|
} else {
|
||
|
|
return @sarecs;
|
||
|
|
}
|
||
|
|
}
|
||
|
|
@sarecs = <TMPFILE>;
|
||
|
|
close TMPFILE;
|
||
|
|
} else {
|
||
|
|
@sarecs = &get_data("subjarea.$clid");
|
||
|
|
}
|
||
|
|
if ($opts) {
|
||
|
|
my $sarec;
|
||
|
|
my $htmlcode;
|
||
|
|
my $slbls;
|
||
|
|
my @flds;
|
||
|
|
my $nflds;
|
||
|
|
my $nopts;
|
||
|
|
my $i;
|
||
|
|
my $j;
|
||
|
|
my @lbls;
|
||
|
|
my $nrecs;
|
||
|
|
my @optflds;
|
||
|
|
my $optval;
|
||
|
|
my $opttxt;
|
||
|
|
my $stmp;
|
||
|
|
my $ssadata;
|
||
|
|
my @sadata = ();
|
||
|
|
|
||
|
|
$htmlcode="";
|
||
|
|
$sarec=$sarecs[0];
|
||
|
|
chop ($sarec);
|
||
|
|
@lbls = split(/&/, $sarec);
|
||
|
|
$nrecs = $#lbls;
|
||
|
|
$slbls="";
|
||
|
|
|
||
|
|
@optflds=split(/\,/,$opts);
|
||
|
|
$nopts=$#optflds;
|
||
|
|
for $i (0 .. $nrecs) {
|
||
|
|
for $j (0 .. $nopts) {
|
||
|
|
if ($lbls[$i] eq $optflds[$j]) {
|
||
|
|
$stmp=$slbls;
|
||
|
|
$slbls=join('&',$stmp,$i);
|
||
|
|
}
|
||
|
|
}
|
||
|
|
}
|
||
|
|
@lbls = split(/&/, $slbls);
|
||
|
|
$nopts=$#lbls;
|
||
|
|
$nrecs = $#sarecs;
|
||
|
|
for $i (1 .. $nrecs) {
|
||
|
|
$sarec=$sarecs[$i];
|
||
|
|
chop ($sarec);
|
||
|
|
@flds = split(/&/, $sarec);
|
||
|
|
$opttxt="";
|
||
|
|
for $j (1 .. $nopts) {
|
||
|
|
$slbls=$lbls[$j];
|
||
|
|
if ($j==1) {
|
||
|
|
$optval=$flds[$slbls];
|
||
|
|
} else {
|
||
|
|
$opttxt=join(' ', $opttxt, $flds[$slbls]);
|
||
|
|
}
|
||
|
|
}
|
||
|
|
if ($tstid) {
|
||
|
|
$htmlcode=join('', $htmlcode, "<OPTION value=\"$optval\">$opttxt\n");
|
||
|
|
} else {
|
||
|
|
$ssadata=join('&', $opttxt, $optval,"\n");
|
||
|
|
push @sadata, $ssadata;
|
||
|
|
}
|
||
|
|
}
|
||
|
|
if ($tstid eq "") {
|
||
|
|
@sarecs = sort(@sadata);
|
||
|
|
foreach $sarec (@sarecs) {
|
||
|
|
@flds = split(/&/,$sarec);
|
||
|
|
$htmlcode=join('', $htmlcode, "<OPTION value=\"$flds[1]\">$flds[0]\n");
|
||
|
|
}
|
||
|
|
}
|
||
|
|
return $htmlcode;
|
||
|
|
} else {
|
||
|
|
return @sarecs;
|
||
|
|
}
|
||
|
|
}
|
||
|
|
|
||
|
|
sub get_subjarea {
|
||
|
|
my ($clid, $tstid, $mid) = @_;
|
||
|
|
my @sarecs = &get_subjarea_masters($clid,$tstid,"");
|
||
|
|
my $nrecs=$#sarecs;
|
||
|
|
if ($nrecs != -1) {
|
||
|
|
my $r;
|
||
|
|
my $f;
|
||
|
|
my $nflds;
|
||
|
|
my $keyfld=0;
|
||
|
|
my $sarec=$sarecs[0];
|
||
|
|
chop ($sarec);
|
||
|
|
my @lbls = split(/&/, $sarec);
|
||
|
|
for $r (1 .. $nrecs) {
|
||
|
|
$sarec=$sarecs[$r];
|
||
|
|
chop ($sarec);
|
||
|
|
@flds = split(/&/, $sarec);
|
||
|
|
$nflds=$#flds;
|
||
|
|
if ($flds[$keyfld] eq $mid) {
|
||
|
|
for $f (0 .. $nflds) {
|
||
|
|
$SUBJAREA{$lbls[$f]} = $flds[$f];
|
||
|
|
}
|
||
|
|
return 1;
|
||
|
|
}
|
||
|
|
}
|
||
|
|
}
|
||
|
|
return 0;
|
||
|
|
}
|
||
|
|
|
||
|
|
sub put_subjarea {
|
||
|
|
my ($clid, $tstid, $mid) = @_;
|
||
|
|
my @sarecs = &get_subjarea_masters($clid,$tstid,"");
|
||
|
|
my $nrecs=$#sarecs;
|
||
|
|
my @ssarecs;
|
||
|
|
my $sanames;
|
||
|
|
my $sarec;
|
||
|
|
my @flds;
|
||
|
|
my $i;
|
||
|
|
my $found=0;
|
||
|
|
my $trash;
|
||
|
|
if ($FORM{'qcnt'} eq "") { $FORM{'qcnt'} = "0";}
|
||
|
|
if ($nrecs == -1) {
|
||
|
|
if (&create_subjarea_file($clid, $tstid, $mid)) {
|
||
|
|
@sarecs = &get_subjarea_masters($clid,$tstid,"");
|
||
|
|
$sanames = shift @sarecs;
|
||
|
|
chop($sanames);
|
||
|
|
$sarec=join('&',$FORM{'sbaid'},$FORM{'mid'},$FORM{'desc'},$FORM{'qcnt'});
|
||
|
|
@sarecs = ();
|
||
|
|
unshift @sarecs, $sarec;
|
||
|
|
unshift @sarecs, $sanames;
|
||
|
|
} else {
|
||
|
|
$SUBJAREA{'id'} = "";
|
||
|
|
$SUBJAREA{'mid'} = "";
|
||
|
|
$SUBJAREA{'desc'} = "";
|
||
|
|
$SUBJAREA{'qcnt'} = "0";
|
||
|
|
return 0;
|
||
|
|
}
|
||
|
|
} else {
|
||
|
|
for $i (1 .. $nrecs) {
|
||
|
|
$sarec=$sarecs[$i];
|
||
|
|
chop($sarec);
|
||
|
|
if ($found) {
|
||
|
|
push @ssarecs, $sarec;
|
||
|
|
} else {
|
||
|
|
@flds=split(/&/,$sarec);
|
||
|
|
if ($flds[0] eq $mid) {
|
||
|
|
$sarec=join('&',$FORM{'sbaid'},$FORM{'mid'},$FORM{'desc'},$FORM{'qcnt'});
|
||
|
|
$found=1;
|
||
|
|
}
|
||
|
|
push @ssarecs, $sarec;
|
||
|
|
}
|
||
|
|
}
|
||
|
|
$sanames = shift @sarecs;
|
||
|
|
chop($sanames);
|
||
|
|
if ($found == 0) {
|
||
|
|
$sarec=join('&',$FORM{'sbaid'},$FORM{'mid'},$FORM{'desc'},$FORM{'qcnt'});
|
||
|
|
push @ssarecs, $sarec;
|
||
|
|
}
|
||
|
|
@sarecs = sort(@ssarecs);
|
||
|
|
unshift @sarecs, $sanames;
|
||
|
|
$nrecs=$#sarecs;
|
||
|
|
}
|
||
|
|
$trash = join( $pathsep, $questionroot, "$tstid.$clid.sba");
|
||
|
|
open (TSTFILE, ">$trash");
|
||
|
|
foreach $sarec (@sarecs) {
|
||
|
|
print TSTFILE "$sarec\n";
|
||
|
|
}
|
||
|
|
close TSTFILE;
|
||
|
|
|
||
|
|
$SUBJAREA{'id'} = $FORM{'sbaid'};
|
||
|
|
$SUBJAREA{'mid'} = $FORM{'mid'};
|
||
|
|
$SUBJAREA{'desc'} = $FORM{'desc'};
|
||
|
|
$SUBJAREA{'qcnt'} = $FORM{'qcnt'};
|
||
|
|
return 1;
|
||
|
|
}
|
||
|
|
|
||
|
|
sub drop_subjarea {
|
||
|
|
my ($clid, $tstid, $mid) = @_;
|
||
|
|
my @sarecs = &get_subjarea_masters($clid,$tstid,"");
|
||
|
|
my $nrecs=$#sarecs;
|
||
|
|
my @ssarecs;
|
||
|
|
my $sanames;
|
||
|
|
my $sarec;
|
||
|
|
my @flds;
|
||
|
|
my $mymid;
|
||
|
|
my @mids=split(/\,/,$mid);
|
||
|
|
my $midct=$#mids;
|
||
|
|
my $i;
|
||
|
|
my $n=0;
|
||
|
|
my $found=0;
|
||
|
|
if (($nrecs != -1) && ($midct != -1)) {
|
||
|
|
$midct++;
|
||
|
|
for $i (1 .. $nrecs) {
|
||
|
|
$sarec=$sarecs[$i];
|
||
|
|
if ($found) {
|
||
|
|
push @ssarecs, $sarec;
|
||
|
|
} else {
|
||
|
|
@flds=split(/&/,$sarec);
|
||
|
|
foreach $mymid (@mids) {
|
||
|
|
if ($flds[0] eq $mymid) {
|
||
|
|
$found=1;
|
||
|
|
$n++;
|
||
|
|
break;
|
||
|
|
}
|
||
|
|
}
|
||
|
|
if ($found) {
|
||
|
|
if ($n != $midct) {
|
||
|
|
$found=0;
|
||
|
|
}
|
||
|
|
} else {
|
||
|
|
push @ssarecs, $sarec;
|
||
|
|
}
|
||
|
|
}
|
||
|
|
}
|
||
|
|
if ($n) {
|
||
|
|
$sanames = shift @sarecs;
|
||
|
|
@sarecs = sort(@ssarecs);
|
||
|
|
unshift @sarecs, $sanames;
|
||
|
|
my $trash = join( $pathsep, $questionroot, "$tstid.$clid.sba");
|
||
|
|
open (TSTFILE, ">$trash");
|
||
|
|
foreach $sarec (@sarecs) {
|
||
|
|
print TSTFILE "$sarec";
|
||
|
|
}
|
||
|
|
close TSTFILE;
|
||
|
|
}
|
||
|
|
$SUBJAREA{'id'} = "";
|
||
|
|
$SUBJAREA{'mid'} = "";
|
||
|
|
$SUBJAREA{'desc'} = "";
|
||
|
|
$SUBJAREA{'qcnt'} = "0";
|
||
|
|
return $found;
|
||
|
|
}
|
||
|
|
return 0;
|
||
|
|
}
|
||
|
|
|
||
|
|
sub update_subjarea {
|
||
|
|
my ($clid, $tstid, $mid) = @_;
|
||
|
|
return put_subjarea($clid, $tstid, $mid);
|
||
|
|
}
|
||
|
|
|
||
|
|
sub build_subjarea {
|
||
|
|
my ($clid, $tstid, $mid) = @_;
|
||
|
|
my @qrs = &get_question_list($tstid,$clid);
|
||
|
|
my $nq=$#qrs;
|
||
|
|
if ($nq == -1) { return 1;}
|
||
|
|
my $i;
|
||
|
|
my $sct=0;
|
||
|
|
my $subjfld=-1;
|
||
|
|
my @sarecs=();
|
||
|
|
my @ssarecs=();
|
||
|
|
my @subjs;
|
||
|
|
my $subj;
|
||
|
|
my $sfind;
|
||
|
|
my $sadbd;
|
||
|
|
my $sarec;
|
||
|
|
my $subject;
|
||
|
|
my $skill;
|
||
|
|
my $qrec=$qrs[0];
|
||
|
|
my @qflds=split(/&/,$qrec);
|
||
|
|
my $j=$#qflds;
|
||
|
|
for $i (1 .. $j) {
|
||
|
|
if ($qflds[$i] eq "subj") {
|
||
|
|
$subjfld = $i;
|
||
|
|
break;
|
||
|
|
}
|
||
|
|
}
|
||
|
|
@ssarecs = ();
|
||
|
|
for $i (1 .. $nq) {
|
||
|
|
$qrec=$qrs[$i];
|
||
|
|
@qflds=split(/&/,$qrec);
|
||
|
|
($subject,$skill)=split(/\./,$qflds[$subjfld]);
|
||
|
|
$sfind=".$subject.";
|
||
|
|
if (!($subj =~ /$sfind/)) {
|
||
|
|
$sct++;
|
||
|
|
$subj=join('',$subj,$sfind);
|
||
|
|
$sarec=join('&',$subject,"","$subject\n");
|
||
|
|
push @ssarecs, $sarec;
|
||
|
|
}
|
||
|
|
}
|
||
|
|
@qrs=();
|
||
|
|
$subj="";
|
||
|
|
# @sarecs=&get_subjarea_masters($clid,$tstid,"");
|
||
|
|
$sadbd=join('&',"id","mid","desc","qcnt");
|
||
|
|
@sarecs = ();
|
||
|
|
if ($sct) {
|
||
|
|
@sarecs = sort(@ssarecs);
|
||
|
|
my $trash = join( $pathsep, $questionroot, "$tstid.$clid.sba");
|
||
|
|
open (TSTFILE, ">$trash");
|
||
|
|
print TSTFILE "$sadbd\n";
|
||
|
|
foreach $sarec (@sarecs) {
|
||
|
|
print TSTFILE "$sarec";
|
||
|
|
}
|
||
|
|
close TSTFILE;
|
||
|
|
}
|
||
|
|
return 1;
|
||
|
|
}
|
||
|
|
|
||
|
|
sub upd_subjarea_qcount {
|
||
|
|
my ($clid, $tstid, $opts) = @_;
|
||
|
|
my @ssarecs=&get_subjarea_masters($clid,$tstid,"");
|
||
|
|
if ($#ssarecs == -1) { return 1;}
|
||
|
|
|
||
|
|
my $i;
|
||
|
|
my $j;
|
||
|
|
my $sfind;
|
||
|
|
my @sarecs=();
|
||
|
|
my @scnts=();
|
||
|
|
my @flds;
|
||
|
|
my @qrs = &get_question_list($tstid,$clid);
|
||
|
|
my $qrec = shift @qrs;
|
||
|
|
my $nq=$#qrs;
|
||
|
|
|
||
|
|
my $sarec = shift @ssarecs;
|
||
|
|
$sarec=join('&',"id","mid","desc","qcnt\n");
|
||
|
|
push @sarecs, $sarec;
|
||
|
|
for $i (0 .. $#ssarecs) {
|
||
|
|
$sarec = $ssarecs[$i];
|
||
|
|
chop($sarec);
|
||
|
|
@flds=split(/&/,$sarec);
|
||
|
|
$sarec=join('&',$flds[0],$flds[1],$flds[2]);
|
||
|
|
if ($nq == -1) {
|
||
|
|
$sarec=join('&', $sarec, "0\n");
|
||
|
|
} else {
|
||
|
|
$sfind="\&$flds[0]\.";
|
||
|
|
@scnts=grep(/$sfind/, @qrs);
|
||
|
|
$j=$#scnts+1;
|
||
|
|
$sarec=join('&', $sarec, "$j\n");
|
||
|
|
@scnts=();
|
||
|
|
}
|
||
|
|
push @sarecs, $sarec;
|
||
|
|
}
|
||
|
|
my $trash = join( $pathsep, $questionroot, "$tstid.$clid.sba");
|
||
|
|
open (TSTFILE, ">$trash");
|
||
|
|
foreach $sarec (@sarecs) {
|
||
|
|
print TSTFILE "$sarec";
|
||
|
|
}
|
||
|
|
close TSTFILE;
|
||
|
|
return 1;
|
||
|
|
}
|
||
|
|
# End Library
|
||
|
|
1
|