#!/usr/bin/perl
#
# $Id: byquesrpt.pl,v 1.2 2004/08/13 14:32:58 ddoughty Exp $
#
# Source File: byquesrpt.pl
# Get config
use FileHandle;
#use Time::Local;
#use Data::Dumper;
require 'sitecfg.pl';
require 'testlib.pl';
require 'tstatlib.pl';
require 'qlib.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 );
&app_initialize;
&LanguageSupportInit();
#print STDERR Dumper(\%SESSION);
# Make sure we have a valid session, and exit if we don't
if (not &get_session($FORM{'tid'})) {
exit(0);
}
&get_client_profile($SESSION{'clid'});
# Generate the reports
if ($FORM{'reportname'} eq 'byques') {
&ByQuestionReport();
} elsif ($FORM{'reportname'} eq 'tests') {
print "Content-Type: text/html\n\n";
&show_template("testselect");
} elsif ($FORM{'reportname'} eq 'questions') {
&get_test_profile($CLIENT{'clid'}, $FORM{'tstid'});
&build_question_select_list();
&show_template("quesselect");
} elsif ($FORM{'reportname'} eq 'selectpg') {
print "Content-Type: text/html\n\n";
&show_template("selectpg");
} else {
&show_template("selectframe");
}
# There should only be function definitions beyond this point.
exit(0);
sub HTMLHeader {
return "\n
\n$_[0]\n".
"\n\n".
"\n";
}
sub HTMLHeaderPlain {
return "\n\n$_[0]\n".
"\n\n".
"\n";
}
sub HTMLFooter {
return "\n\n";
}
sub ByQuestionReport {
if ($FORM{'csv'}) {
print "Content-Disposition: attachment;filename=report.csv\n\n";
} else {
print "Content-Type: text/html\n\n";
print &HTMLHeaderPlain("Candidate Responses by Question");
}
&get_test_profile($CLIENT{'clid'}, $FORM{'tstid'});
&get_question_definition($TEST{'id'},$CLIENT{'clid'},$FORM{'qid'});
if ($FORM{'csv'}) {
&PrintByQuesCSVHeader();
} else {
&PrintByQuesHeader();
print "\n";
}
my @filelist = &get_test_result_files($testcomplete, "$CLIENT{'clid'}","$TEST{'id'}");
for (my $fidx = 0; $fidx <= $#filelist; $fidx++ ) {
$user = $filelist[$fidx];
$user =~ s/.$TEST{'id'}$//;
$user =~ s/^$CLIENT{'clid'}.//;
&get_candidate_profile($CLIENT{'clid'}, $user);
&get_test_sequence_for_reports( $CLIENT{'clid'}, $user, $TEST{'id'});
if ($FORM{'csv'}) {
&PrintByQuesCSV();
} else {
&PrintByQues();
}
}
if (!$FORM{'csv'}) {
print "
\n";
print &HTMLFooter();
}
}
sub PrintByQuesHeader {
if ($TEST{'seq'} eq 'svy' || $TEST{'seq'} eq 'dmg') {
@skilllevel = ( '','','','' );
$itemdescription = "Survey";
} elsif ($FORM{'remed'} == 1) {
$TEST{'seq'} = 'svy';
@skilllevel = ( '','','','' );
$itemdescription = "Test";
} else {
@skilllevel = ( 'Basic','Intermediate','Advanced','' );
$itemdescription = "Test";
}
my ($qsubj, $sklvl) = split(/\./, $QUESTION{'subj'});
if ($sklvl eq '') { $sklvl = 3; }
print "$itemdescription Results
\n";
print "Site: $CLIENT{'clid'}
\n";
print "Test: $TEST{'id'} - $TEST{'desc'}
\n";
print "\n";
print "\n";
print "
|
\n";
print "\n";
if ($TEST{'seq'} eq 'svy' || $TEST{'seq'} eq 'dmg') {
print " | \n";
} else {
print "ID: Subject: Skill Level: | \n";
}
print "$QUESTION{'id'} $qsubj $skilllevel[$sklvl] | \n";
print "
\n";
print "\n";
print "Question: | \n";
print "$QUESTION{'qtx'} | \n";
print "
\n";
print "
|
\n";
print "\n";
print "Login ID | \n";
print "Name | \n";
print "
\n";
print "\n";
if ($TEST{'seq'} ne 'svy' && $TEST{'seq'} ne 'dmg') {
print "Credit | \n";
} else {
print " | \n";
}
print "Question Number | \n";
print "
\n";
print "\n";
print "\ | \n";
if ($TEST{'seq'} eq 'svy' || $TEST{'seq'} eq 'dmg') {
print "$itemdescription-Taker Response | \n";
print "\ | \n";
} else {
print "Correct Response | \n";
print "$itemdescription-Taker Response | \n";
}
print "
\n";
print "
|
\n";
print "
\n";
}
sub PrintByQues {
my $correctanswertag = "$xlatphrase[137]";
my $incorrectanswertag = "$xlatphrase[692]";
my $noanswertag = "$xlatphrase[791]";
my @myalbls=();
my @questions = split(/&/,$SUBTEST_QUESTIONS{2});
my @keyanswers = split(/&/,$SUBTEST_ANSWERS{2});
my @studentanswers = split(/&/,$SUBTEST_RESPONSES{2});
my ($correctans, $incorrectans, $score, $trash) = split(/&/, $SUBTEST_SUMMARY{2});
### Set the questionindex
for ($questionindex=1; $questionindex <= $#questions; $questionindex++) {
if ($questions[$questionindex] eq $FORM{'qid'}) {
last;
}
}
my $qtype = $QUESTION{'qtp'};
my $myqalb = $QUESTION{'qalb'};
my ($studentresponse,$studentcomments) = split(/::/,lc($studentanswers[$questionindex]));
$studentcomments = unmunge($studentcomments);
$studentcomments =~ s/\"/\"/g;
$studentcomments =~ s/\+/" "/g;
# ^ sac start changes to support question optional comments
my ($keyresponse,$kflags) = split(/::/, lc($keyanswers[$questionindex]));
my $scoreable = 1;
my $credit = $noanswertag;
my $checked = "";
my $answerkey = "";
my $studentkey = "";
my $qanswermatch = "";
my @txts = ();
if ($TEST{'seq'} ne 'svy' && $TEST{'seq'} ne 'dmg') {
if ($qtype eq 'nrt') {
$scoreable = 0;
if ($studentresponse eq '') {
$credit = $noanswertag;
} else {
$credit = "unscoreable";
if ($keyresponse ne '') {
my ($manuallyscored,$keycomments) = split(/\./, $keyresponse);
}
# end ADT
}
$studentkey = "$studentresponse\n";
$studentkey =~ s/\%0D\%0A/\
/g;
$studentkey = unmunge($studentkey);
}
if ($qtype eq 'tf') {
$answerkey = $keyresponse;
$studentkey = $studentresponse;
if ($studentkey eq $answerkey) {
$credit = $correctanswertag;
} else {
$credit = $incorrectanswertag;
if ($studentresponse eq '') { $credit = $noanswertag;}
}
}
if ($qtype eq 'esa') {
$answerkey = $keyresponse;
$studentkey = $studentresponse;
if ($answerkey =~ /\;/) {
@txts = split(/\;/, $keyresponse);
$credit = $incorrectanswertag;
foreach $answerkey (@txts) {
if (lc($studentresponse) eq lc($answerkey)) {
$credit = $correctanswertag;
}
}
$answerkey =~ s/\;/
/g;
} else {
if (lc($studentresponse) eq lc($keyresponse)) {
$credit = $correctanswertag;
} else {
$credit = $incorrectanswertag;
if ($studentresponse eq '') { $credit = $noanswertag;}
}
}
}
if ($qtype eq 'mcs') {
@myalbls=&set_answer_labels($myqalb);
$studentresponse =~ s/xxx//g;
push @txts, $QUESTION{'qca'};
@txts_wro = split(/\n/, $QUESTION{'qia'});
foreach $qia (@txts_wro) {
push @txts, $qia;
}
@kans = split(/\?/,$keyresponse);
foreach $j (1 .. $#kans) {
$jidx = $j-1;
@indexs = split(/=/, $kans[$j]);
$checked = ($indexs[1] == '1') ? " CHECKED" : "";
$answerkey = join('',$answerkey,"$myalbls[$jidx]. $txts[$indexs[0]]
\n");
$checked = ($studentresponse =~ /$jidx/) ? " CHECKED" : "";
$studentkey = join('',$studentkey,"$myalbls[$jidx]. $txts[$indexs[0]]
\n");
}
if ($studentkey eq $answerkey) {
$credit = $correctanswertag;
} else {
$credit = $incorrectanswertag;
if ($studentresponse eq '') { $credit = $noanswertag;}
}
}
if ($qtype eq 'mcm') {
@myalbls=&set_answer_labels($myqalb);
$studentresponse =~ s/xxx//g;
@txts = split(/\n/, $QUESTION{'qca'});
@txts_wro = split(/\n/, $QUESTION{'qia'});
foreach $qia (@txts_wro) {
push @txts, $qia;
}
@kans = split(/\?/,$keyresponse);
foreach $j (1 .. $#kans) {
$jidx = $j-1;
@indexs = split(/=/, $kans[$j]);
$checked = ($indexs[1] == '1') ? " CHECKED" : "";
$answerkey = join('',$answerkey," $txts[$indexs[0]]
\n");
$checked = ($studentresponse =~ /$jidx/) ? " CHECKED" : "";
$studentkey = join('',$studentkey," $txts[$indexs[0]]
\n");
}
if ($studentkey eq $answerkey) {
$credit = $correctanswertag;
} else {
$credit = $incorrectanswertag;
if ($studentresponse eq '') { $credit = $noanswertag;}
}
}
if ($qtype eq 'mch') {
$qanswermatch = "\
\n";
@txts = split(/\n/, $QUESTION{'qca'});
@txts_wro = split(/\n/, $QUESTION{'qia'});
@ansopts = split(/\./, $keyresponse);
$anstype = shift @ansopts;
@albls=&set_answer_labels($anstype);
$keyresponse = "";
### DED-02 7/17/2002 Added following 2 lines
### and changed studentkey join below
### to allow for "?" delimiter in response
@studentresponse = split(/\?/, $studentresponse);
shift @studentresponse;
for (0 .. $#ansopts) {
$cansord[$ansopts[$_]] = $albls[$_];
$qanswermatch = join('',$qanswermatch, "($cansord[$ansopts[$_]]) $txts_wro[$ansopts[$_]]
\n");
}
foreach $cansord (@cansord) {
$keyresponse = join('', $keyresponse, $cansord);
}
for (0 .. $#ansopts) {
$answerkey = join('',$answerkey,"($cansord[$_]) $txts[$_]
\n");
### DED-06 7/23/2002 added following if
### to print " " instead of "xxx"
### for blank response
if ( $studentresponse[$_] eq "xxx" ) {
$studentresponse[$_] = " ";
}
### DED-02 changed
#$studentkey = join('',$studentkey,"(",substr($studentresponse,$_,1),") $txts[$_]
\n");
### to
$studentkey = join('',$studentkey,"(",$studentresponse[$_],") $txts[$_]
\n");
}
@cansord = ();
### DED-02 vvv
$studentresponse="";
for (0 .. $#studentresponse) {
$studentresponse=join('', $studentresponse, $studentresponse[$_]);
}
### END DED-02
if ($studentresponse eq $keyresponse) {
$credit = $correctanswertag;
} else {
$studentresponse =~ s/x//g;
$credit = $incorrectanswertag;
if ($studentresponse eq '') { $credit = $noanswertag;}
}
}
if ($qtype eq 'ord') {
### DED 8/10/2002 Got rid of labels because
### "o" designator now working
@txts = split(/\n/, $QUESTION{'qca'});
@studentresponse = split(/\?/, $studentresponse);
shift @studentresponse;
@ansopts = split(/\./, $keyresponse);
$ansopt = shift @ansopts;
for (0 .. $#ansopts) {
$ansopt = $ansopts[$_];
$ansopt++;
$answerkey = join('',$answerkey,"($ansopt) $txts[$ansopts[$_]]
\n");
### DED-07 7/23/2002 added following if
### to print " " instead of "xxx"
### for blank response
if ( $studentresponse[$_] eq "xxx" ) {
$studentresponse[$_] = " ";
}
### DED-03 changed
#$studentkey = join('',$studentkey,"(",substr($studentresponse,$_,1),") $txts[$ansopts[$_]]
\n");
### to
$studentkey = join('',$studentkey,"(",$studentresponse[$_],") $txts[$ansopts[$_]]
\n");
}
if ($studentkey eq $answerkey) {
$credit = $correctanswertag;
} else {
$credit = $incorrectanswertag;
if ($studentresponse eq '') { $credit = $noanswertag;}
}
}
} else {
if ($qtype eq 'nrt') {
$studentkey = "$studentresponse\n";
$studentkey =~ s/\%0D\%0A/\
/g;
$studentkey = unmunge($studentkey);
}
if ($qtype eq 'tf') {
$studentkey = $studentresponse;
if ($studentresponse eq '') { $credit = $noanswertag;}
}
if ($qtype eq 'esa') {
$studentkey = $studentresponse;
if ($studentresponse eq '') { $credit = $noanswertag;}
}
if ($qtype eq 'mcs' || $qtype eq 'mca') {
@myalbls=&set_answer_labels($myqalb);
$studentresponse =~ s/xxx//g;
@txts = ();
if ($QUESTION{'qca'} ne '') {
push @txts, $QUESTION{'qca'};
}
@txts_wro = split(/\n/, $QUESTION{'qia'});
foreach $qia (@txts_wro) {
push @txts, $qia;
}
@kans = split(/\?/,$keyresponse);
foreach $j (1 .. $#kans) {
$jidx = $j-1;
@indexs = split(/=/, $kans[$j]);
$checked = ($studentresponse =~ /$jidx/) ? " CHECKED" : "";
$studentkey = join('',$studentkey,"($myalbls[$jidx]) $txts[$indexs[0]]
\n");
}
if ($studentresponse eq '') { $credit = $noanswertag;}
}
if ($qtype eq 'mtx' || $qtype eq 'mtr') {
$studentkey="";
# Split qia into row and col headers
$qia = $QUESTION{'qia'};
$qia =~ s/\r/\n/g;
$qia =~ s/\n\n/\n/g;
($qrowhdr, $qcolhdr) = split(/RC/,$qia);
@qrowhdr = split(/\n/, $qrowhdr);
@qcolhdr = split(/\n/, $qcolhdr);
if ($qtype eq 'mtx') {
# Mark selections with "CHECKED"
@optvalues = split(/\?/, $studentresponse);
shift @optvalues;
$i=0;
foreach $row (0 .. $#qrowhdr)
{
foreach $col (0 .. $#qcolhdr)
{
if ($optvalues[$i] != "xxx")
{
$chmatrix[$row][$col]="CHECKED";
}
else
{
$chmatrix[$row][$col]="";
}
$i++;
}
}
} else {
# Mark selections with "SELECTED"
@optvalues = split(/\?/, $studentresponse);
shift @optvalues;
$i=0;
foreach $row (0 .. $#qrowhdr)
{
foreach $col (0 .. $#qcolhdr)
{
$rank = $optvalues[$i];
foreach $irank (0 .. 5)
{
if ($irank eq $rank)
{
$chmatrix[$i][$irank]="SELECTED";
}
else
{
$chmatrix[$i][$irank]="";
}
}
$i++;
}
}
}
# Build matrix html
$studentkey="\n";
@qrowhdr = ();
@qcolhdr = ();
@chmatrix = ();
if ($studentresponse eq '') { $credit = $noanswertag;}
}
if ($qtype eq 'mcm') {
@myalbls=&set_answer_labels($myqalb);
$studentresponse =~ s/xxx//g;
@txts = ();
if ($QUESTION{'qca'} ne '') {
@txts = split(/\n/, $QUESTION{'qca'});
}
@txts_wro = split(/\n/, $QUESTION{'qia'});
foreach $qia (@txts_wro) {
push @txts, $qia;
}
@kans = split(/\?/,$keyresponse);
foreach $j (1 .. $#kans) {
$jidx = $j-1;
@indexs = split(/=/, $kans[$j]);
$checked = ($studentresponse =~ /$jidx/) ? " CHECKED" : "";
$studentkey = join('',$studentkey,"($myalbls[$jidx]) $txts[$indexs[0]]
\n");
}
if ($studentresponse eq '') { $credit = $noanswertag;}
}
if ($qtype eq 'mch') {
### DED-04 7/17/2002 Same as DED-02
@studentresponse = split(/\?/, $studentresponse);
shift @studentresponse;
$qanswermatch = "\
\n";
@txts = split(/\n/, $QUESTION{'qca'});
@txts_wro = split(/\n/, $QUESTION{'qia'});
@ansopts = split(/\./, $keyresponse);
$anstype = shift @ansopts;
@albls=&set_answer_labels($anstype);
$keyresponse = "";
for (0 .. $#ansopts) {
$cansord[$ansopts[$_]] = $albls[$_];
$qanswermatch = join('',$qanswermatch, "($cansord[$ansopts[$_]]) $txts_wro[$ansopts[$_]]
\n");
}
foreach $cansord (@cansord) {
$keyresponse = join('', $keyresponse, $cansord);
}
for (0 .. $#ansopts) {
$studentkey = join('',$studentkey,"(",$studentresponse[$_],") $txts[$_]
\n");
}
@cansord = ();
$studentresponse =~ s/x//g;
if ($studentresponse eq '') { $credit = $noanswertag;}
}
if ($qtype eq 'ord') {
### DED-05 7/17/2002 Same as DED-02
@studentresponse = split(/\?/, $studentresponse);
shift @studentresponse;
@albls = &set_answer_labels($QUESTION{'qalb'});
@txts = split(/\n/, $QUESTION{'qca'});
@ansopts = split(/\./, $keyresponse);
$ansopt = shift @ansopts;
for (0 .. $#ansopts) {
$ansopt = $ansopts[$_];
$ansopt++;
$studentkey = join('',$studentkey,"(",$studentresponse[$_],") $txts[$ansopts[$_]]
\n");
}
if ($studentresponse eq '') { $credit = $noanswertag;}
}
}
print "\n";
print "$user | \n";
print "$CANDIDATE{'nmf'} $CANDIDATE{'nmm'} $CANDIDATE{'nml'} | \n";
print "
\n";
if ($TEST{'seq'} ne 'svy' && $TEST{'seq'} ne 'dmg') {
print "\n";
if ($scoreable || $credit eq $noanswertag) {
print "$credit | \n";
} else {
print "nbsp; | \n";
}
print "$questionindex. | \n";
print "
\n";
print "\n";
if ($qanswermatch ne "") {
print "\ $qanswermatch | \n";
}
print "
\n";
print "\n";
print "\ | \n";
if (($qtype eq 'nrt') && ($studentresponse ne '')) {
if ($keycomments eq '') {
print "Comments:
| \n";
} else {
print "Comments:
| \n";
}
} else {
print "$answerkey | \n";
}
print "$studentkey | \n";
print "
\n";
if (($TEST{'remt'} ne '0') && ($TEST{'emlcndopt'} eq 'Y')
&& ($SESSION{'uac'} eq 'cnd')) {
print "\n";
print " | \n";
print "$QUESTION{'qrm'} | \n";
print "
\n";
}
if ($QUESTION{'qcmtprmpt'} eq 'Y') {
print "\n";
print "
| \n";
print "\ (Student Comments) $QUESTION{'qcprmpt'} $studentcomments | \n";
print "
\n";
}
} else {
print "\n";
print " | \n";
print "$questionindex. | \n";
print "
\n";
if ($qanswermatch ne "") {
print "\n";
print "$qanswermatch | \n";
print "
\n";
}
print "\n";
print " | \n";
print "$studentkey | \n";
print "
\n";
if (($TEST{'remt'} ne '0') && ($TEST{'emlcndopt'} eq 'Y')
&& ($SESSION{'uac'} eq 'cnd')) {
print "\n";
print " | \n";
print "$QUESTION{'qrm'} | \n";
print "
\n";
}
if ($QUESTION{'qcmtprmpt'} eq 'Y') {
print "\n";
print "
| \n";
print "\ (Student Comments) $QUESTION{'qcprmpt'} $studentcomments | \n";
print "
\n";
}
}
print "
|
\n";
### End of question printout
}
sub PrintByQuesCSVHeader {
if ($TEST{'seq'} eq 'svy' || $TEST{'seq'} eq 'dmg') {
@skilllevel = ( '','','','' );
$itemdescription = "Survey";
} elsif ($FORM{'remed'} == 1) {
$TEST{'seq'} = 'svy';
@skilllevel = ( '','','','' );
$itemdescription = "Test";
} else {
@skilllevel = ( 'Basic','Intermediate','Advanced','' );
$itemdescription = "Test";
}
my ($qsubj, $sklvl) = split(/\./, $QUESTION{'subj'});
if ($sklvl eq '') { $sklvl = 3; }
print "$itemdescription Results\n";
print "Site:,$CLIENT{'clid'}\n";
print "Test:,\"$TEST{'id'} - $TEST{'desc'}\"\n";
print "ID,Subject,Skill Level,Question\n";
print "$QUESTION{'id'},\"$qsubj\",$skilllevel[$sklvl],\"$QUESTION{'qtx'}\"\n";
print "Login ID,Name,";
if ($TEST{'seq'} ne 'svy' && $TEST{'seq'} ne 'dmg') {
print "Credit,Question Number,Correct Response,$itemdescription-Taker Response,Student Comments\n";
} else {
print "Question Number,$itemdescription-Taker Response,Student Comments\n";
}
}
sub PrintByQuesCSV {
my $correctanswertag = "$xlatphrase[137]";
my $incorrectanswertag = "$xlatphrase[692]";
my $noanswertag = "$xlatphrase[791]";
my @myalbls=();
my @questions = split(/&/,$SUBTEST_QUESTIONS{2});
my @keyanswers = split(/&/,$SUBTEST_ANSWERS{2});
my @studentanswers = split(/&/,$SUBTEST_RESPONSES{2});
my ($correctans, $incorrectans, $score, $trash) = split(/&/, $SUBTEST_SUMMARY{2});
### Set the questionindex
for ($questionindex=1; $questionindex <= $#questions; $questionindex++) {
if ($questions[$questionindex] eq $FORM{'qid'}) {
last;
}
}
my $qtype = $QUESTION{'qtp'};
my $myqalb = $QUESTION{'qalb'};
my ($studentresponse,$studentcomments) = split(/::/,lc($studentanswers[$questionindex]));
$studentcomments = unmunge($studentcomments);
$studentcomments =~ s/\"/\"/g;
$studentcomments =~ s/\+/" "/g;
# ^ sac start changes to support question optional comments
my ($keyresponse,$kflags) = split(/::/, lc($keyanswers[$questionindex]));
my $scoreable = 1;
my $credit = $noanswertag;
my $checked = "";
my $answerkey = "";
my $studentkey = "";
my $qanswermatch = "";
my @txts = ();
if ($TEST{'seq'} ne 'svy' && $TEST{'seq'} ne 'dmg') {
if ($qtype eq 'nrt') {
$scoreable = 0;
if ($studentresponse eq '') {
$credit = $noanswertag;
} else {
$credit = "unscoreable";
if ($keyresponse ne '') {
my ($manuallyscored,$keycomments) = split(/\./, $keyresponse);
}
}
$studentkey = "$studentresponse";
$studentkey =~ s/\%0D\%0A/\;/g;
$studentkey = unmunge($studentkey);
}
if ($qtype eq 'tf') {
$answerkey = $keyresponse;
$studentkey = $studentresponse;
if ($studentkey eq $answerkey) {
$credit = $correctanswertag;
} else {
$credit = $incorrectanswertag;
if ($studentresponse eq '') { $credit = $noanswertag;}
}
}
if ($qtype eq 'esa') {
$answerkey = $keyresponse;
$studentkey = $studentresponse;
if ($answerkey =~ /\;/) {
@txts = split(/\;/, $keyresponse);
$credit = $incorrectanswertag;
foreach $answerkey (@txts) {
if (lc($studentresponse) eq lc($answerkey)) {
$credit = $correctanswertag;
}
}
} else {
if (lc($studentresponse) eq lc($keyresponse)) {
$credit = $correctanswertag;
} else {
$credit = $incorrectanswertag;
if ($studentresponse eq '') { $credit = $noanswertag;}
}
}
}
if ($qtype eq 'mcs') {
$studentresponse =~ s/xxx//g;
push @txts, $QUESTION{'qca'};
@txts_wro = split(/\n/, $QUESTION{'qia'});
foreach $qia (@txts_wro) {
push @txts, $qia;
}
@kans = split(/\?/,$keyresponse);
foreach $j (1 .. $#kans) {
$jidx = $j-1;
@indexs = split(/=/, $kans[$j]);
if ($indexs[1] == '1') {
$answerkey = $txts[$indexs[0]];
}
if ($studentresponse =~ /$jidx/) {
$studentkey = $txts[$indexs[0]];
}
}
if ($studentkey eq $answerkey) {
$credit = $correctanswertag;
} else {
$credit = $incorrectanswertag;
if ($studentresponse eq '') { $credit = $noanswertag;}
}
}
if ($qtype eq 'mcm') {
@myalbls=&set_answer_labels($myqalb);
$studentresponse =~ s/xxx//g;
@txts = split(/\n/, $QUESTION{'qca'});
@txts_wro = split(/\n/, $QUESTION{'qia'});
foreach $qia (@txts_wro) {
push @txts, $qia;
}
@kans = split(/\?/,$keyresponse);
foreach $j (1 .. $#kans) {
$jidx = $j-1;
@indexs = split(/=/, $kans[$j]);
if ($indexs[1] == '1') {
$answerkey = join('',$answerkey,"$txts[$indexs[0]]\;");
}
if ($studentresponse =~ /$jidx/) {
$studentkey = join('',$studentkey,"$txts[$indexs[0]]\;");
}
}
if ($studentkey) { $studentkey = substr($studentkey,0,-1) }
if ($answerkey) { $answerkey = substr($answerkey,0,-1) }
if ($studentkey eq $answerkey) {
$credit = $correctanswertag;
} else {
$credit = $incorrectanswertag;
if ($studentresponse eq '') { $credit = $noanswertag;}
}
}
if ($qtype eq 'mch') {
$qanswermatch = "\
\n";
@txts = split(/\n/, $QUESTION{'qca'});
@txts_wro = split(/\n/, $QUESTION{'qia'});
@ansopts = split(/\./, $keyresponse);
$anstype = shift @ansopts;
@albls=&set_answer_labels($anstype);
$keyresponse = "";
### DED-02 7/17/2002 Added following 2 lines
### and changed studentkey join below
### to allow for "?" delimiter in response
@studentresponse = split(/\?/, $studentresponse);
shift @studentresponse;
for (0 .. $#ansopts) {
$cansord[$ansopts[$_]] = $albls[$_];
$qanswermatch = join('',$qanswermatch, "($cansord[$ansopts[$_]]) $txts_wro[$ansopts[$_]]
\n");
}
foreach $cansord (@cansord) {
$keyresponse = join('', $keyresponse, $cansord);
}
for (0 .. $#ansopts) {
$answerkey = join('',$answerkey,"($cansord[$_]) $txts[$_]
\n");
### DED-06 7/23/2002 added following if
### to print " " instead of "xxx"
### for blank response
if ( $studentresponse[$_] eq "xxx" ) {
$studentresponse[$_] = " ";
}
### DED-02 changed
#$studentkey = join('',$studentkey,"(",substr($studentresponse,$_,1),") $txts[$_]
\n");
### to
$studentkey = join('',$studentkey,"(",$studentresponse[$_],") $txts[$_]
\n");
}
@cansord = ();
### DED-02 vvv
$studentresponse="";
for (0 .. $#studentresponse) {
$studentresponse=join('', $studentresponse, $studentresponse[$_]);
}
### END DED-02
if ($studentresponse eq $keyresponse) {
$credit = $correctanswertag;
} else {
$studentresponse =~ s/x//g;
$credit = $incorrectanswertag;
if ($studentresponse eq '') { $credit = $noanswertag;}
}
}
if ($qtype eq 'ord') {
### DED 8/10/2002 Got rid of labels because
### "o" designator now working
@txts = split(/\n/, $QUESTION{'qca'});
@studentresponse = split(/\?/, $studentresponse);
shift @studentresponse;
@ansopts = split(/\./, $keyresponse);
$ansopt = shift @ansopts;
for (0 .. $#ansopts) {
$ansopt = $ansopts[$_];
$ansopt++;
$answerkey = join('',$answerkey,"($ansopt) $txts[$ansopts[$_]]
\n");
### DED-07 7/23/2002 added following if
### to print " " instead of "xxx"
### for blank response
if ( $studentresponse[$_] eq "xxx" ) {
$studentresponse[$_] = " ";
}
### DED-03 changed
#$studentkey = join('',$studentkey,"(",substr($studentresponse,$_,1),") $txts[$ansopts[$_]]
\n");
### to
$studentkey = join('',$studentkey,"(",$studentresponse[$_],") $txts[$ansopts[$_]]
\n");
}
if ($studentkey eq $answerkey) {
$credit = $correctanswertag;
} else {
$credit = $incorrectanswertag;
if ($studentresponse eq '') { $credit = $noanswertag;}
}
}
} else {
if ($qtype eq 'nrt') {
$studentkey = "$studentresponse";
$studentkey =~ s/\%0D\%0A/\;/g;
$studentkey = unmunge($studentkey);
}
if ($qtype eq 'tf') {
$studentkey = $studentresponse;
if ($studentresponse eq '') { $credit = $noanswertag;}
}
if ($qtype eq 'esa') {
$studentkey = $studentresponse;
if ($studentresponse eq '') { $credit = $noanswertag;}
}
if ($qtype eq 'mcs' || $qtype eq 'mca') {
$studentresponse =~ s/xxx//g;
@txts = ();
if ($QUESTION{'qca'} ne '') {
push @txts, $QUESTION{'qca'};
}
@txts_wro = split(/\n/, $QUESTION{'qia'});
foreach $qia (@txts_wro) {
push @txts, $qia;
}
@kans = split(/\?/,$keyresponse);
foreach $j (1 .. $#kans) {
$jidx = $j-1;
@indexs = split(/=/, $kans[$j]);
if ($studentresponse =~ /$jidx/) {
$studentkey = $txts[$indexs[0]];
}
}
if ($studentresponse eq '') { $credit = $noanswertag;}
}
if ($qtype eq 'mtx' || $qtype eq 'mtr') {
$studentkey="";
# Split qia into row and col headers
$qia = $QUESTION{'qia'};
$qia =~ s/\r/\n/g;
$qia =~ s/\n\n/\n/g;
($qrowhdr, $qcolhdr) = split(/RC/,$qia);
@qrowhdr = split(/\n/, $qrowhdr);
@qcolhdr = split(/\n/, $qcolhdr);
if ($qtype eq 'mtx') {
# Mark selections with "CHECKED"
@optvalues = split(/\?/, $studentresponse);
shift @optvalues;
$i=0;
foreach $row (0 .. $#qrowhdr)
{
foreach $col (0 .. $#qcolhdr)
{
if ($optvalues[$i] != "xxx")
{
$chmatrix[$row][$col]="CHECKED";
}
else
{
$chmatrix[$row][$col]="";
}
$i++;
}
}
} else {
# Mark selections with "SELECTED"
@optvalues = split(/\?/, $studentresponse);
shift @optvalues;
$i=0;
foreach $row (0 .. $#qrowhdr)
{
foreach $col (0 .. $#qcolhdr)
{
$rank = $optvalues[$i];
foreach $irank (0 .. 5)
{
if ($irank eq $rank)
{
$chmatrix[$i][$irank]="SELECTED";
}
else
{
$chmatrix[$i][$irank]="";
}
}
$i++;
}
}
}
# Build matrix html
$studentkey="\n";
@qrowhdr = ();
@qcolhdr = ();
@chmatrix = ();
if ($studentresponse eq '') { $credit = $noanswertag;}
}
if ($qtype eq 'mcm') {
$studentresponse =~ s/xxx//g;
@txts = ();
if ($QUESTION{'qca'} ne '') {
@txts = split(/\n/, $QUESTION{'qca'});
}
@txts_wro = split(/\n/, $QUESTION{'qia'});
foreach $qia (@txts_wro) {
push @txts, $qia;
}
@kans = split(/\?/,$keyresponse);
foreach $j (1 .. $#kans) {
$jidx = $j-1;
@indexs = split(/=/, $kans[$j]);
if ($studentresponse =~ /$jidx/) {
$studentkey = join('',$studentkey,"$txts[$indexs[0]]\;");
}
}
if ($studentresponse eq '') { $credit = $noanswertag;}
}
if ($qtype eq 'mch') {
### DED-04 7/17/2002 Same as DED-02
@studentresponse = split(/\?/, $studentresponse);
shift @studentresponse;
$qanswermatch = "\
\n";
@txts = split(/\n/, $QUESTION{'qca'});
@txts_wro = split(/\n/, $QUESTION{'qia'});
@ansopts = split(/\./, $keyresponse);
$anstype = shift @ansopts;
@albls=&set_answer_labels($anstype);
$keyresponse = "";
for (0 .. $#ansopts) {
$cansord[$ansopts[$_]] = $albls[$_];
$qanswermatch = join('',$qanswermatch, "($cansord[$ansopts[$_]]) $txts_wro[$ansopts[$_]]
\n");
}
foreach $cansord (@cansord) {
$keyresponse = join('', $keyresponse, $cansord);
}
for (0 .. $#ansopts) {
$studentkey = join('',$studentkey,"(",$studentresponse[$_],") $txts[$_]
\n");
}
@cansord = ();
$studentresponse =~ s/x//g;
if ($studentresponse eq '') { $credit = $noanswertag;}
}
if ($qtype eq 'ord') {
### DED-05 7/17/2002 Same as DED-02
@studentresponse = split(/\?/, $studentresponse);
shift @studentresponse;
@albls = &set_answer_labels($QUESTION{'qalb'});
@txts = split(/\n/, $QUESTION{'qca'});
@ansopts = split(/\./, $keyresponse);
$ansopt = shift @ansopts;
for (0 .. $#ansopts) {
$ansopt = $ansopts[$_];
$ansopt++;
$studentkey = join('',$studentkey,"(",$studentresponse[$_],") $txts[$ansopts[$_]]
\n");
}
if ($studentresponse eq '') { $credit = $noanswertag;}
}
}
print "$user,\"$CANDIDATE{'nmf'} $CANDIDATE{'nmm'} $CANDIDATE{'nml'}\",";
if ($TEST{'seq'} ne 'svy' && $TEST{'seq'} ne 'dmg') {
if ($scoreable || $credit eq $noanswertag) {
print "$credit,";
}
print "$questionindex,";
### Move to header and make part of "Question"
#if ($qanswermatch ne "") {
#print "$qanswermatch";
#}
### DED 8/11/04 What is this?
#if (($qtype eq 'nrt') && ($studentresponse ne '')) {
#if ($keycomments eq '') {
#print "Comments:
| \n";
#} else {
#print "Comments:
| \n";
#}
#} else {
print "\"$answerkey\",";
#}
print "\"$studentkey\",";
### DED 8/11/04 Don't include remediation
#if (($TEST{'remt'} ne '0') && ($TEST{'emlcndopt'} eq 'Y')
#&& ($SESSION{'uac'} eq 'cnd')) {
#print "\n";
#print " | \n";
#print "$QUESTION{'qrm'} | \n";
#print "
\n";
#}
if ($QUESTION{'qcmtprmpt'} eq 'Y') {
print "\"$studentcomments\"";
}
print "\n";
} else {
print "$questionindex,";
#if ($qanswermatch ne "") {
#print "\n";
#print "$qanswermatch | \n";
#print "
\n";
#}
print "\"$studentkey\",";
### DED 8/11/04 Don't include remediation
#if (($TEST{'remt'} ne '0') && ($TEST{'emlcndopt'} eq 'Y')
#&& ($SESSION{'uac'} eq 'cnd')) {
#print "\n";
#print " | \n";
#print "$QUESTION{'qrm'} | \n";
#print "
\n";
#}
if ($QUESTION{'qcmtprmpt'} eq 'Y') {
print "\"$studentcomments\"";
}
print "\n";
}
### End of question printout
}