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.
532 lines
21 KiB
532 lines
21 KiB
4 months ago
|
#!/usr/bin/perl
|
||
|
|
#
|
||
|
|
# $Id: testdata.pl,v 1.10 2006/11/29 14:44:59 ddoughty Exp $
|
||
|
|
#
|
||
|
|
# Source File: testdata.pl
|
||
|
|
|
||
|
|
# Get config
|
||
|
|
use FileHandle;
|
||
|
|
use Reporter;
|
||
|
|
use Data::Dumper;
|
||
|
|
require 'sitecfg.pl';
|
||
|
|
require 'testlib.pl';
|
||
|
|
use strict;
|
||
|
|
use vars qw(%FORM %SESSION %CLIENT %TEST_SESSION %SUBTEST_QUESTIONS %TEST
|
||
|
|
%SUBTEST_SUMMARY %CANDIDATE %SUBTEST_ANSWERS %SYSTEM %REPORT
|
||
|
|
%SUBTEST_RESPONSES);
|
||
|
|
use vars qw($testcomplete $cgiroot $pathsep $dataroot $testgraphic $graphroot);
|
||
|
|
|
||
|
|
&app_initialize;
|
||
|
|
&LanguageSupportInit();
|
||
|
|
&get_client_profile($SESSION{'clid'});
|
||
|
|
|
||
|
|
# Make sure we have a valid session, and exit if we don't
|
||
|
|
if (not &get_session($FORM{'tid'})) {
|
||
|
|
exit(0);
|
||
|
|
}
|
||
|
|
my $options;
|
||
|
|
|
||
|
|
if (exists $FORM{'testid'}) {
|
||
|
|
@{$options}{qw(showquest displayquest active inactive remediation bysubject subjfilter bydiff difffilter answers)} =
|
||
|
|
@FORM{qw(showquest displayquest active inactive remediation bysubject subjfilter bydiff difffilter answers)};
|
||
|
|
&DisplayQuestions($SESSION{'clid'},$FORM{'testid'},$options);
|
||
|
|
} else {
|
||
|
|
&ReportChooser($SESSION{'clid'});
|
||
|
|
}
|
||
|
|
|
||
|
|
# There should only be function definitions beyond this point.
|
||
|
|
exit(0);
|
||
|
|
|
||
|
|
sub ReportChooser {
|
||
|
|
my ($client) = @_;
|
||
|
|
print &Reporter::HTMLHeader("Test Data");
|
||
|
|
# options to be implemented -
|
||
|
|
# drop down menu to choose test
|
||
|
|
# checkbox and text field to choose subset of questions
|
||
|
|
# remediation checkbox
|
||
|
|
# show active checkbox
|
||
|
|
# show inactive checkbox
|
||
|
|
# filter by subjct multichoice
|
||
|
|
# filter by difficulty
|
||
|
|
print "<form name=\"testdatarpt\" action=\"/cgi-bin/creports.pl\" method=\"Post\" target=\"rptwindow\" enctype=\"multipart/form-data\" >\n";
|
||
|
|
print "<input type=\"hidden\" name=\"tid\" value=\"$SESSION{'tid'}\">\n";
|
||
|
|
print "<input type=hidden name=\"rptno\" value=\"$FORM{'rptno'}\">\n";
|
||
|
|
print "<input type=hidden name=\"rptdesc\" value=\"$REPORT{'rptdesc'}\">\n";
|
||
|
|
print "<input type=hidden name=\"rptid\" value=\"$REPORT{'rptid'}\">\n";
|
||
|
|
|
||
|
|
print "<table>\n";
|
||
|
|
#print "<tr><th>Test</th><th>Questions</th><th>S
|
||
|
|
print "<tr valign=\"top\"><td><b>Select Test:</b><br><select name=\"testid\">\n";
|
||
|
|
my @tests = &get_test_list($client);
|
||
|
|
shift @tests;
|
||
|
|
my (@details,%subjects);
|
||
|
|
foreach my $testid (@tests) {
|
||
|
|
my ($id,$desc) = split(/&/,$testid);
|
||
|
|
print "<option value=\"$id\">$desc</option>\n";
|
||
|
|
my $tmp = &get_question_definitions($client,$id);
|
||
|
|
push @details, $tmp;
|
||
|
|
@subjects{map($_->{'subj'},@$tmp)} = 1;
|
||
|
|
}
|
||
|
|
print "</select></td>";
|
||
|
|
print "<td><b>Show Questions:</b><br><input type=\"radio\" name=\"showquest\" value=\"all\" checked>All<br>".
|
||
|
|
"<input type=\"radio\" name=\"showquest\" value=\"subset\">Subset: <input type=\"text\" name=\"displayquest\"></td>";
|
||
|
|
print "<td><b>Display:</b><br><input type=\"checkbox\" name=\"active\" checked>Active Questions<br>".
|
||
|
|
"<input type=\"checkbox\" name=\"inactive\">Inactive Questions<br>".
|
||
|
|
"<input type=\"checkbox\" name=\"answers\">Question Answers<br>".
|
||
|
|
"<input type=\"checkbox\" name=\"remediation\">Remediation<br></td>";
|
||
|
|
print "</tr>\n";
|
||
|
|
print "</table><table>\n";
|
||
|
|
print "<tr><td colspan=\"3\"><b>Filter By:</b></tr>\n";
|
||
|
|
#my @subjects = qw(astronomy geology physics);
|
||
|
|
print "<tr valign=\"top\"><td><input type=\"checkbox\" name=\"bysubject\">Subject:<select name=\"subjfilter\" MULTIPLE>";
|
||
|
|
foreach my $subject (sort keys %subjects) {
|
||
|
|
print "<option value=\"$subject\">$subject</option>\n";
|
||
|
|
}
|
||
|
|
my @difficulties = ([0,'basic'],[1,'intermediate'],[2,'advanced']);
|
||
|
|
print "</td><td><input type=\"checkbox\" name=\"bydiff\">Difficulty:<select name=\"difffilter\">";
|
||
|
|
foreach my $difficulty (@difficulties) {
|
||
|
|
print "<option value=\"$difficulty->[0]\">$difficulty->[1]</option>\n";
|
||
|
|
}
|
||
|
|
print "</select></td>";
|
||
|
|
print "</tr>\n";
|
||
|
|
print "</table>\n";
|
||
|
|
print "<input type=\"submit\" value=\"Get Test\">\n";
|
||
|
|
print &Reporter::HTMLFooter();
|
||
|
|
}
|
||
|
|
|
||
|
|
sub DisplayQuestions {
|
||
|
|
my ($client,$test,$options) = @_;
|
||
|
|
&get_test_profile($client,$test);
|
||
|
|
my $details = &get_question_definitions($client,$test);
|
||
|
|
print &Reporter::HTMLHeaderPlain("Test Data for $TEST{'desc'}");
|
||
|
|
print "<h1>Test Data for $TEST{'desc'}</h1>\n";
|
||
|
|
print "<form>\n";
|
||
|
|
my (@questnum,%subjects,$difficulty);
|
||
|
|
if ($options->{'showquest'} eq 'subset') {
|
||
|
|
$options->{'displayquest'} =~ s/\s+//g; #eliminate whitespace
|
||
|
|
foreach (split(/,/,$options->{'displayquest'})) {
|
||
|
|
if (/^\d+$/) {$questnum[$_] = 1;}
|
||
|
|
if (/^(\d+)-$/) {foreach ($1 .. (scalar(@$details)+1)) {$questnum[$_]=1;}}
|
||
|
|
if (/^-(\d+)$/) {foreach (1 .. $1) {$questnum[$_]=1;}}
|
||
|
|
if (/^(\d+)-(\d+)$/) {foreach ($1 .. $2) {$questnum[$_]=1;}}
|
||
|
|
}
|
||
|
|
}
|
||
|
|
if ($options->{'bysubject'}) {
|
||
|
|
%subjects = map(($_=>1),split(/,/,$options->{'subjfilter'}));
|
||
|
|
}
|
||
|
|
if ($options->{'bydiff'}) {
|
||
|
|
$difficulty = $options->{'difffilter'};
|
||
|
|
}
|
||
|
|
my $questcount = 0;
|
||
|
|
foreach my $question (@$details) {
|
||
|
|
### DED 7/28/04 Some questions have qil blank; look for !N instead of Y
|
||
|
|
#if (not (($options->{'active'} and $question->{'qil'} eq 'N') or
|
||
|
|
# ($options->{'inactive'} and $question->{'qil'} eq 'Y'))) {
|
||
|
|
if (not (($options->{'active'} and $question->{'qil'} ne 'Y') or
|
||
|
|
($options->{'inactive'} and $question->{'qil'} eq 'Y'))) {
|
||
|
|
next;
|
||
|
|
}
|
||
|
|
if ($options->{'bysubject'} and not $subjects{$question->{'subj'}}) {next;}
|
||
|
|
if ($options->{'bydiff'} and ($question->{'skilllevel'} != $options->{'difffilter'})) {next;}
|
||
|
|
my (undef, $qindex) = split(/\./,$question->{'id'});
|
||
|
|
if (($options->{'showquest'} eq 'subset') and not $questnum[$qindex]) {next;}
|
||
|
|
$questcount++;
|
||
|
|
if ($question->{'qil'} eq 'Y') {
|
||
|
|
print "<font color=\"red\"><h3>$question->{'id'} - Inactive</h3></font>\n";
|
||
|
|
} else {
|
||
|
|
print "<h3>$question->{'id'}</h3>\n";
|
||
|
|
}
|
||
|
|
print "Subject: $question->{'subj'}, Skill: ".(qw(basic intermediate advanced))[$question->{'skilllevel'}].
|
||
|
|
"<p>\n";
|
||
|
|
if ($question->{'qim'}) {
|
||
|
|
print $question->{'illustration'}."<br>\n";
|
||
|
|
}
|
||
|
|
if ($question->{'qtp'} eq 'tf') {
|
||
|
|
print formatTF($question,$options);
|
||
|
|
} elsif ($question->{'qtp'} eq 'esa') {
|
||
|
|
print formatESA($question,$options);
|
||
|
|
} elsif ($question->{'qtp'} eq 'nrt') {
|
||
|
|
print formatNRT($question,$options);
|
||
|
|
} elsif ($question->{'qtp'} eq 'mch' or $question->{'qtp'} eq 'ord') {
|
||
|
|
print formatMCHORD($question,$options);
|
||
|
|
} elsif ($question->{'qtp'} eq 'mcs' or $question->{'qtp'} eq 'mcm') {
|
||
|
|
print formatMC($question,$options);
|
||
|
|
} elsif ($question->{'qtp'} eq 'mtx' or $question->{'qtp'} eq 'mtr') {
|
||
|
|
print formatMT($question,$options);
|
||
|
|
} else {
|
||
|
|
#print "<pre>".Dumper($question)."</pre>";
|
||
|
|
}
|
||
|
|
if ($options->{"remediation"}) {
|
||
|
|
if ($question->{'qrm'}) {
|
||
|
|
print "Remdiation:<br>\n$question->{'qrm'}<br>\n";
|
||
|
|
} else {
|
||
|
|
print "No Remediation.<br>\n";
|
||
|
|
}
|
||
|
|
}
|
||
|
|
print "<hr>\n";
|
||
|
|
}
|
||
|
|
print "</form\n";
|
||
|
|
if (not $questcount) {
|
||
|
|
print "<h3>No Matching Questions Found.</h3>\n";
|
||
|
|
}
|
||
|
|
#print "<pre>".Dumper($details,$options)."</pre>";
|
||
|
|
print &Reporter::HTMLFooter();
|
||
|
|
}
|
||
|
|
|
||
|
|
sub formatTF {
|
||
|
|
my ($question,$options) = @_;
|
||
|
|
my ($optTrue,$optFalse) = ('','');
|
||
|
|
#my $outline = "<h3>$question->{'id'}</h3>\n";
|
||
|
|
my $outline = "$question->{'qtx'}<p>\n";
|
||
|
|
if ($options->{'answers'}) {
|
||
|
|
$optTrue = ($question->{'qca'}=~/(true|yes)/i ? "checked" : "" );
|
||
|
|
$optFalse = ($question->{'qca'}=~/(false|no)/i ? "checked" : "" );
|
||
|
|
}
|
||
|
|
my ($true,$false) = ($question->{'qca'}, $question->{'qia'});
|
||
|
|
if ($question->{'qca'} !~ /(true|yes)/i) {
|
||
|
|
($true,$false) = ($false,$true);
|
||
|
|
}
|
||
|
|
$outline .= "<input type=\"radio\" name=\"$question->{'id'}\" value=\"$true\" $optTrue>$true<BR>\n";
|
||
|
|
$outline .= "<input type=\"radio\" name=\"$question->{'id'}\" value=\"$false\" $optFalse>$false<P>\n";
|
||
|
|
return $outline;
|
||
|
|
}
|
||
|
|
|
||
|
|
sub formatESA {
|
||
|
|
my ($question,$options) = @_;
|
||
|
|
my ($tmp);
|
||
|
|
#my @esaanswers = split(/\n/,$question->{'qca'});
|
||
|
|
my $len;
|
||
|
|
$tmp = "<ul>\n";
|
||
|
|
foreach (split(/[;\n]/,$question->{'qca'})) {
|
||
|
|
$tmp .= "<li>$_</li>\n";
|
||
|
|
$len = ($len < length($_)? length($_): $len);
|
||
|
|
}
|
||
|
|
$tmp .= "</ul>\n";
|
||
|
|
$len += 5;
|
||
|
|
my $anslist = "<input type=\"text\" name=\"$question->{'id'}\" VALUE=\"\" SIZE=$len>";
|
||
|
|
my $qtext = $question->{'qtx'};
|
||
|
|
if ($qtext =~ /<box>/ ) {
|
||
|
|
$qtext =~ s/<box>/$anslist/g;
|
||
|
|
} else {
|
||
|
|
$qtext .= "<p>$anslist\n";
|
||
|
|
}
|
||
|
|
my $outline .= "$qtext<p>\n";
|
||
|
|
if ($options->{'answers'}) {
|
||
|
|
$outline .= "Answers:<br>\n";
|
||
|
|
$outline .= $tmp;
|
||
|
|
}
|
||
|
|
return $outline;
|
||
|
|
}
|
||
|
|
|
||
|
|
sub formatMCHORD {
|
||
|
|
my ($question,$options) = @_;
|
||
|
|
my $tmp = $question->{'qca'};
|
||
|
|
$tmp =~ s/\r/\n/g; $tmp =~ s/\n\n/\n/g;
|
||
|
|
my @ansopt = split(/\n/,$tmp);
|
||
|
|
$tmp = $question->{'qia'};
|
||
|
|
$tmp =~ s/\r/\n/g; $tmp =~ s/\n\n/\n/g;
|
||
|
|
my @desc = split(/\n/,$tmp);
|
||
|
|
my @albls = set_answer_labels($question->{'qalb'});
|
||
|
|
my $outline = "$question->{'qtx'}<p>\n";
|
||
|
|
my $num = (@ansopt > @desc? @ansopt: @desc);
|
||
|
|
$outline .= "<table>\n";
|
||
|
|
my @answers;
|
||
|
|
if ($options->{'answers'}) {@answers = @albls;}
|
||
|
|
for (my $i=0; $i<$num; $i++) {
|
||
|
|
if ($question->{'qtp'} eq 'mch') {
|
||
|
|
$outline .= "<tr><td align=\"left\"><INPUT TYPE=TEXT SIZE=\"2\" NAME=\"$question->{'id'}.$i\" value=\"$answers[$i]\">".
|
||
|
|
" $ansopt[$i] </td>";
|
||
|
|
$outline .= "<TD align=\"left\" width=80> </TD>";
|
||
|
|
$outline .= "<TD align=\"left\"><b>$albls[$i]</b> $desc[$i]</TD></TR>\n";
|
||
|
|
} else {
|
||
|
|
my $answer = ($options->{'answers'}?" value=\"".($i+1)."\"":"");
|
||
|
|
$outline .= "<tr><td align=\"left\"><INPUT TYPE=TEXT SIZE=\"2\" NAME=\"$question->{'id'}.$i\"$answer>".
|
||
|
|
" $ansopt[$i] </td>";
|
||
|
|
}
|
||
|
|
$outline .= "</tr>\n";
|
||
|
|
}
|
||
|
|
$outline .= "</table><p>\n";
|
||
|
|
return $outline;
|
||
|
|
}
|
||
|
|
|
||
|
|
sub formatNRT {
|
||
|
|
my ($question,$options) = @_;
|
||
|
|
my $outline = "$question->{'qtx'}<p>\n";
|
||
|
|
my $nrtmaxlen = $question->{'qca'};
|
||
|
|
my $nrtcols = 50;
|
||
|
|
my $nrtrows = $nrtmaxlen/$nrtcols;
|
||
|
|
$nrtrows = ($nrtrows > 5) ? 5 : $nrtrows;
|
||
|
|
$outline .= "<textarea name=\"$question->{'id'}\" ROWS=\"$nrtrows\" COLS=\"$nrtcols\" wrap=\"on\"></TEXTAREA>\n";
|
||
|
|
return $outline;
|
||
|
|
}
|
||
|
|
|
||
|
|
sub formatMC {
|
||
|
|
my ($question,$options) = @_;
|
||
|
|
my ($inptyp);
|
||
|
|
if (($question->{'qtp'} eq 'mcs' ) || ($question->{'qtp'} eq 'mca')) {
|
||
|
|
$inptyp = "RADIO";
|
||
|
|
} elsif ($question->{'qtp'} eq 'mcm' ) {
|
||
|
|
$inptyp = "CHECKBOX";
|
||
|
|
} else{
|
||
|
|
return undef;
|
||
|
|
}
|
||
|
|
if ($question->{'anslay'} eq "h") {
|
||
|
|
$inptyp .= ":".$question->{'anslay'};
|
||
|
|
}
|
||
|
|
my @albls = set_answer_labels($question->{'qalb'});
|
||
|
|
my $qca = $question->{'qca'};
|
||
|
|
$qca =~ s/\r/\n/g; $qca =~ s/\n\n/\n/g;
|
||
|
|
my %qansopt = map(($_=>{'correct' =>1}), split(/\n/, $qca));
|
||
|
|
my $qia = $question->{'qia'};
|
||
|
|
$qia =~ s/\r/\n/g; $qia =~ s/\n\n/\n/g;
|
||
|
|
foreach (split(/\n/, $qia)) {$qansopt{$_}->{'correct'} = 0;}
|
||
|
|
my @order;
|
||
|
|
push @order,split(/\n/, $qca), split(/\n/, $qia);
|
||
|
|
|
||
|
|
my $outline="$question->{'qtx'}<p>\n";
|
||
|
|
my $iord=0;
|
||
|
|
foreach (@order) {
|
||
|
|
my $qans;
|
||
|
|
if ($question->{'qalb'} ne "x") {
|
||
|
|
$qansopt{$_}->{'formatted'} = $albls[$iord].") $_";
|
||
|
|
} else {
|
||
|
|
$qansopt{$_}->{'formatted'} = $_;
|
||
|
|
}
|
||
|
|
$qansopt{$_}->{'index'} = $iord++;
|
||
|
|
}
|
||
|
|
|
||
|
|
if ($inptyp eq 'RADIO:h') {
|
||
|
|
my $colspan = scalar(keys(%qansopt))+2;
|
||
|
|
$outline = "<TABLE cellspacing=10>\n";
|
||
|
|
$outline .= " <TR><TD colspan=$colspan>";
|
||
|
|
$outline .= " <TABLE width=100%>\n";
|
||
|
|
$outline .= " <TR><TD align=left>$question->{'left_be'}</TD>";
|
||
|
|
$outline .= " <TD align=right>$question->{'right_be'}</TD></TR>\n";
|
||
|
|
$outline .= " </TABLE>\n";
|
||
|
|
$outline .= " </TD></TR>\n";
|
||
|
|
$outline .= " <TR><TD> </TD>";
|
||
|
|
}
|
||
|
|
foreach my $qans (@order) {
|
||
|
|
my $optselected = (($options->{'answers'} and $qansopt{$qans}->{'correct'}) ? "CHECKED" : "");
|
||
|
|
if ($inptyp eq 'RADIO') {
|
||
|
|
$outline .= "<INPUT TYPE=$inptyp NAME=\"$question->{'id'}\" VALUE=\"$qansopt{$qans}->{'index'}\" $optselected>$qansopt{$qans}->{'formatted'}<BR>\n";
|
||
|
|
} elsif ($inptyp eq 'RADIO:h') {
|
||
|
|
$outline .= "<TD align=center><INPUT TYPE=RADIO NAME=\"$question->{'id'}\" VALUE=\"$qansopt{$qans}->{'index'}\" $optselected></TD>";
|
||
|
|
} else {
|
||
|
|
my $akey = "$question->{'id'}.$qansopt{$qans}->{'index'}";
|
||
|
|
$outline .= "<INPUT TYPE=$inptyp NAME=\"$akey\" VALUE=\"$qansopt{$qans}->{'index'}\" $optselected>$qansopt{$qans}->{'formatted'}<BR>\n";
|
||
|
|
}
|
||
|
|
}
|
||
|
|
if ($inptyp eq 'RADIO:h') {
|
||
|
|
$outline .= "<TD> </TD></TR>\n";
|
||
|
|
$outline .= " <TR><TD> </TD>";
|
||
|
|
foreach my $qans (@order) {
|
||
|
|
$outline .= "<TD align=center>$qansopt{$qans}->{'formatted'}</TD>";
|
||
|
|
}
|
||
|
|
$outline .= "<TD> </TD></TR>\n";
|
||
|
|
$outline .= "</TABLE>\n";
|
||
|
|
}
|
||
|
|
return $outline."<P>\n";;
|
||
|
|
}
|
||
|
|
|
||
|
|
sub formatMT {
|
||
|
|
my ($question,$options) = @_;
|
||
|
|
|
||
|
|
my $outline = "$question->{'qtx'}<p>\n";
|
||
|
|
# Split qia into row and col headers
|
||
|
|
my $qia = $question->{'qia'};
|
||
|
|
$qia =~ s/\r/\n/g;
|
||
|
|
$qia =~ s/\n\n/\n/g;
|
||
|
|
my ($qrowhdr, $qcolhdr) = split(/RC/,$qia);
|
||
|
|
my @qrowhdr = split(/\n/, $qrowhdr);
|
||
|
|
my @qcolhdr = split(/\n/, $qcolhdr);
|
||
|
|
|
||
|
|
#@optvalues = split(/\?/, $_[2]);
|
||
|
|
#shift @optvalues;
|
||
|
|
my @optvalues = ();
|
||
|
|
my $i=0;
|
||
|
|
my @chmatrix;
|
||
|
|
if ($question->{'qtp'} eq 'mtx') {
|
||
|
|
# Mark previous selections with "CHECKED"
|
||
|
|
foreach my $row (0 .. $#qrowhdr) {
|
||
|
|
foreach my $col (0 .. $#qcolhdr) {
|
||
|
|
if ($optvalues[$i] != "xxx") {
|
||
|
|
$chmatrix[$row][$col]="CHECKED";
|
||
|
|
} else {
|
||
|
|
$chmatrix[$row][$col]="";
|
||
|
|
}
|
||
|
|
$i++;
|
||
|
|
}
|
||
|
|
}
|
||
|
|
} else {
|
||
|
|
# Mark previous selections with "SELECTED"
|
||
|
|
foreach my $row (0 .. $#qrowhdr) {
|
||
|
|
foreach my $col (0 .. $#qcolhdr) {
|
||
|
|
my $rank = $optvalues[$i];
|
||
|
|
foreach my $irank (0 .. 5) {
|
||
|
|
if ($irank eq $rank) {
|
||
|
|
$chmatrix[$i][$irank]="SELECTED";
|
||
|
|
} else {
|
||
|
|
$chmatrix[$i][$irank]="";
|
||
|
|
}
|
||
|
|
}
|
||
|
|
$i++;
|
||
|
|
}
|
||
|
|
}
|
||
|
|
}
|
||
|
|
|
||
|
|
# Build matrix html
|
||
|
|
$outline="<table border=2>\n<tr><td> </td>";
|
||
|
|
foreach (0 .. $#qcolhdr) {
|
||
|
|
$outline .= "<td>$qcolhdr[$_]</td>";
|
||
|
|
}
|
||
|
|
$outline .= "</tr>\n";
|
||
|
|
$i=0;
|
||
|
|
foreach my $row (0 .. $#qrowhdr) {
|
||
|
|
$outline .= "<tr><td>$qrowhdr[$row]</td>";
|
||
|
|
foreach my $col (0 .. $#qcolhdr) {
|
||
|
|
if ($question->{'qtp'} eq 'mtx') {
|
||
|
|
$outline .= "<td align=center><input type=checkbox name=\"qrs$row$col\" value=\"1\" $chmatrix[$row][$col]></td>";
|
||
|
|
} else {
|
||
|
|
$outline .= "<td align=center><select name=\"qrs$row$col\"><option value='' $chmatrix[$i][0]>\ \;</option><option value=1 $chmatrix[$i][1]>1</option><option value=2 $chmatrix[$i][2]>2</option><option value=3 $chmatrix[$i][3]>3</option><option value=4 $chmatrix[$i][4]>4</option><option value=5 $chmatrix[$i][5]>5</option></select></td>";
|
||
|
|
}
|
||
|
|
$i++;
|
||
|
|
}
|
||
|
|
$outline .= "</tr>\n";
|
||
|
|
}
|
||
|
|
$outline .= "</table>\n";
|
||
|
|
return $outline;
|
||
|
|
}
|
||
|
|
|
||
|
|
sub get_question_definitions {
|
||
|
|
my ($clid, $testid) = @_;
|
||
|
|
my $qcount = 0;
|
||
|
|
my $questions = [];
|
||
|
|
my @qrecs = &get_question_list($testid, $clid);
|
||
|
|
chomp $qrecs[0];
|
||
|
|
my @flds = split(/&/,shift(@qrecs));
|
||
|
|
foreach my $qrec (@qrecs) {
|
||
|
|
chomp ($qrec);
|
||
|
|
#($id, $qtyp) = split(/&/, $qrec);
|
||
|
|
my @rowdata = split(/&/, $qrec);
|
||
|
|
my $i=0;
|
||
|
|
my $question = {};
|
||
|
|
@{$question}{@flds} = @rowdata;
|
||
|
|
($question->{'subj'},$question->{'skilllevel'}) = split(/\./,$question->{'subj'});
|
||
|
|
$question->{'tf'} = ($question->{'qtp'} eq 'tf') ? "SELECTED" : "";
|
||
|
|
$question->{'mcs'} = ($question->{'qtp'} eq 'mcs') ? "SELECTED" : "";
|
||
|
|
$question->{'mcm'} = ($question->{'qtp'} eq 'mcm') ? "SELECTED" : "";
|
||
|
|
$question->{'esa'} = ($question->{'qtp'} eq 'esa') ? "SELECTED" : "";
|
||
|
|
$question->{'nrt'} = ($question->{'qtp'} eq 'nrt') ? "SELECTED" : "";
|
||
|
|
$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->{'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->{'qim0'} = ($question->{'qim'} eq '0') ? "SELECTED" : "";
|
||
|
|
$question->{'qim1'} = "";
|
||
|
|
$question->{'qim2'} = "";
|
||
|
|
my $illus = join($pathsep, $testgraphic, "$clid.$question->{'id'}");
|
||
|
|
my $supportedmedia = join(';', $SYSTEM{'supportedimagemedia'}, $SYSTEM{'supportedaudiomedia'}, $SYSTEM{'supportedvideomedia'});
|
||
|
|
my $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 '') {
|
||
|
|
my @filesegs = split(/\./, $illusfile);
|
||
|
|
my $fext = $filesegs[$#filesegs];
|
||
|
|
@filesegs = () ;
|
||
|
|
if ($SYSTEM{'supportedimagemedia'} =~ m/$fext/i ) {
|
||
|
|
if ($question->{'qim'} eq '1') {
|
||
|
|
$question->{'illustration'} = "<A NAME=\"qimage\" HREF=\"$cgiroot/imagepop.pl?tid=$SESSION{'tid'}\&img=$clid.$question->{'id'}.$fext\" TARGET=\"illustrated\">Illustration</A>";
|
||
|
|
$question->{'defthumbnail'} = "<A NAME=\"qimage\" HREF=\"$cgiroot/imagepop.pl?tid=$SESSION{'tid'}\&img=$clid.$question->{'id'}.$fext\" TARGET=\"illustrated\"><IMG NAME=\"qimagetn\" SRC=\"$cgiroot/image.pl?tid=$SESSION{'tid'}\&img=$clid.$question->{'id'}.$fext\" width=100 BORDER=0></A>";
|
||
|
|
} else {
|
||
|
|
$question->{'illustration'} = "<IMG NAME=\"qimage\" SRC=\"$cgiroot/image.pl?tid=$SESSION{'tid'}\&img=$clid.$question->{'id'}.$fext\" BORDER=0>";
|
||
|
|
$question->{'defthumbnail'} = "<A NAME=\"qimage\" HREF=\"$cgiroot/imagepop.pl?tid=$SESSION{'tid'}\&img=$clid.$question->{'id'}.$fext\" TARGET=\"illustrated\"><IMG NAME=\"qimagetn\" SRC=\"$cgiroot/image.pl?tid=$SESSION{'tid'}\&img=$clid.$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=$clid.$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=$clid.$question->{'id'}.$fext\" AUTOSTART=\"TRUE\" LOOP=\"false\" VOLUME=\"100\" WIDTH=\"100\" HEIGHT=\"50\" CONTROLS=\"small console\" HIDDEN=\"false\">";
|
||
|
|
}
|
||
|
|
}
|
||
|
|
#if ($question->{'qnxt'} eq '' ) {
|
||
|
|
#$question->{'qnxt'} = ($qcount < $#qrecs) ? $qcount + 1 : $#qrecs;
|
||
|
|
#} else {
|
||
|
|
#if ($question->{'qnxt'} > $#qrecs) {
|
||
|
|
#$question->{'qnxt'} = $#qrecs;
|
||
|
|
#}
|
||
|
|
#}
|
||
|
|
#if ($question->{'qprv'} eq '' ) {
|
||
|
|
#$question->{'qprv'} = ($qcount == 1) ? 1 : $qcount - 1;
|
||
|
|
#} else {
|
||
|
|
#if ($question->{'qprv'} > $#qrecs) {
|
||
|
|
#$question->{'qprv'} = $#qrecs;
|
||
|
|
#}
|
||
|
|
#}
|
||
|
|
$question->{'totdef'} = $#qrecs;
|
||
|
|
$question->{'chkobs'} = ($question->{'qil'} eq 'Y') ? "CHECKED" : "";
|
||
|
|
if ($question->{'qtx'} =~ /:::/) {
|
||
|
|
($question->{'qtx'}, $question->{'left_be'}, $question->{'right_be'}) = split(/:::/, $question->{'qtx'});
|
||
|
|
}
|
||
|
|
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;
|
||
|
|
push @$questions, $question;
|
||
|
|
}
|
||
|
|
return $questions;
|
||
|
|
}
|