#!/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 "\n"; } print "\n"; print "\n"; print "\n"; print "\n"; print "\n"; print "\n"; print "\n"; print "\n"; print "\n"; print "\n"; print "\n"; print "\n"; if ($TEST{'seq'} ne 'svy' && $TEST{'seq'} ne 'dmg') { print "\n"; } else { print "\n"; } print "\n"; print "\n"; print "\n"; print "\n"; if ($TEST{'seq'} eq 'svy' || $TEST{'seq'} eq 'dmg') { print "\n"; print "\n"; } else { print "\n"; print "\n"; } print "\n"; print "\n"; print "

 ID:
Subject:
Skill Level:
$QUESTION{'id'}
$qsubj
$skilllevel[$sklvl]
Question:$QUESTION{'qtx'}

Login IDName
Credit Question Number
$itemdescription-Taker ResponseCorrect Response$itemdescription-Taker Response

\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"; foreach (0 .. $#qcolhdr) { $studentkey .= ""; } $studentkey .= "\n"; $i=0; foreach $row (0 .. $#qrowhdr) { $studentkey .= ""; foreach $col (0 .. $#qcolhdr) { if ($qtype eq 'mtx') { $studentkey .= ""; } else { $studentkey .= ""; } $i++; } $studentkey .= "\n"; } $studentkey .= "
 $qcolhdr[$_]
$qrowhdr[$row]
\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"; foreach (0 .. $#qcolhdr) { $studentkey .= ""; } $studentkey .= "\n"; $i=0; foreach $row (0 .. $#qrowhdr) { $studentkey .= ""; foreach $col (0 .. $#qcolhdr) { if ($qtype eq 'mtx') { $studentkey .= ""; } else { $studentkey .= ""; } $i++; } $studentkey .= "\n"; } $studentkey .= "
 $qcolhdr[$_]
$qrowhdr[$row]
\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 }