#!/usr/bin/perl # # $Id: testreport.pl,v 1.27 2006/09/14 21:24:44 ddoughty Exp $ # # Source File: testreport.pl # Get config use Data::Dumper; require 'sitecfg.pl'; require 'testlib.pl'; require 'tstatlib.pl'; &app_initialize; $FORM{'frm'}=""; if ($ARGV[0]) { $FORM{'tid'} = $ARGV[0]; $FORM{'clid'} = $ARGV[1]; $FORM{'cndid'} = $ARGV[2]; $FORM{'tstid'} = $ARGV[3]; $FORM{'testdates'} = "$ARGV[4]"; $FORM{'correct'} = "$ARGV[5]"; $FORM{'incorrect'} = $ARGV[6]; $FORM{'total'} = $ARGV[7]; $FORM{'percent'} = $ARGV[8]; $FORM{'format'} = $ARGV[9]; $tofile = 1; } else { $tofile = 0; } if (&get_session($FORM{'tid'})) { &LanguageSupportInit(); &get_client_profile($SESSION{'clid'}); #($mycndid,$mytacl)=split(/\./,$FORM{'cndid'}); $testdate=""; if ($mytacl eq '') { &get_candidate_profile( $SESSION{'clid'}, $FORM{'cndid'}); &get_test_profile($CLIENT{'clid'}, $FORM{'tstid'}); if ($FORM{'testdates'} ne '') { $testdate = $FORM{'testdates'}; my $spc=" "; $testdate =~ s/\,//g; $testdate =~ s/\_/$spc/g; } if ($FORM{'testdates'} ne '' && !$ARGV[0]) { if (!&get_test_sequence_from_history($testcomplete, $CLIENT{'clid'}, $FORM{'cndid'}, $TEST{'id'}, $testdate)) { $msg = "No entry in history file.\n"; } } else { &get_test_sequence( $CLIENT{'clid'}, $CANDIDATE{'uid'}, $TEST{'id'}, $testcomplete); } } else { &get_candidate_profile( $SESSION{'clid'}, $mycndid); &get_tacl_profile(); &get_test_profile($CLIENT{'clid'}, $FORM{'tstid'}); if ($FORM{'testdates'} ne '') { $testdate = $FORM{'testdates'}; my $spc=" "; $testdate =~ s/\,//g; $testdate =~ s/\_/$spc/g; } if ($FORM{'testdates'} ne '' && !$ARGV[0]) { if (!&get_test_sequence_from_history($testcomplete, $CLIENT{'clid'}, $FORM{'cndid'}, $TEST{'id'}, $testdate)) { $msg = "No entry in history file.\n"; } } else { &get_test_sequence( $CLIENT{'clid'}, $FORM{'cndid'}, $TEST{'id'}, $testcomplete); } } # ADT - 2/15/2002 -- Moved these variable declarations here so they can be modified # by the UpdateScore routine if need be. @questions = split(/&/,$SUBTEST_QUESTIONS{2}); @keyanswers = split(/&/,$SUBTEST_ANSWERS{2}); @studentanswers = split(/&/,$SUBTEST_RESPONSES{2}); if ($FORM{'submit'} eq 'Update') { &UpdateScore(); } ($correctans, $incorrectans, $score, $trash) = split(/&/, $SUBTEST_SUMMARY{2}); # convert $testdate to new format (dd-mmm-yyyy) DED 1/9/04 my @datestamparray = split(/ /, $testdate); my @datearray = split(/-/, $datestamparray[0]); if (length($datearray[0]) == 4) { my @months = ("Jan", "Feb", "Mar", "Apr", "May", "Jun", "Jul", "Aug", "Sep", "Oct", "Nov", "Dec"); $datearray[1]--; $datestamparray[0] = "$datearray[2]-$months[$datearray[1]]-$datearray[0]"; $testdate = join(" ", @datestamparray); } @datestamparray = (); @datearray = (); if ($FORM{'format'} eq "csv") { &PrintCSV($tofile); } else { &PrintForm($tofile); } } # ADT 9/25/2001 # This subroutine was here. However, it was empty. I'm filling it! # ADT 2/25/2001 -- Modified this function greatly to coordinate changes with # what is on the production server. sub UpdateScore() { # Retrieve the number of essay answers to which credit was given my $creditGiven = $FORM{'graded'}; my $msg = "Score Updated."; my $numCorrectAnswers, $numIncorrectAnswers, $score, $answerString; my @answers, $answer; my $answerCntr, @questionIds; my $result, $studentAnswer, $correctAnswer; my $keyResponse, $kFlags; my $manuallyScored, $keyComments; # Split the summary ( $numCorrectAnswers, $numIncorrectAnswers, $score, $jpeg, $length, $answerString ) = split( /&/, $SUBTEST_SUMMARY{2} ); # Calculate the new score $numCorrectAnswers += $creditGiven; $numIncorrectAnswers -= $creditGiven; $numTotal = $numCorrectAnswers + $numIncorrectAnswers; if ($numTotal == 0) { $score = 0; } else { $score = sprintf( "%3.1f", $numCorrectAnswers / ( $numTotal ) * 100 ); } @answers = split( /\//, $answerString ); $questionCntr = 0; foreach $question ( @questions ) { ( $result, $correctAnswer, $studentAnswer ) = split( /\./, @answers[$questionCntr], 3 ); ( $keyResponse, $kFlags ) = split( /::/, $keyanswers[$questionCntr] ); ( $manuallyScored, $keyComments ) = split( /\./, $keyresponse ); my $comment = "cm".$questions[$questionCntr]; $keyComments = $FORM{$comment}; $keyComments =~ tr/\r\n\&:\.//d; # Remove characters that can mess up the file $manuallyScored = 0; $result = 0; if( defined( $FORM{$questions[$questionCntr]} ) ) { if( $FORM{$questions[$questionCntr]} eq "on" ) { $manuallyScored = 1; $result = 1; } } $answers[$questionCntr] = join( '.', $result, $correctAnswer, $studentAnswer ); $keyResponse = join( '.', $manuallyScored, $keyComments ); $keyanswers[$questionCntr] = join( "::", $keyResponse, $kFlags ); $questionCntr++; } # Put the answers back together $answerString = join( '/', @answers ); $SUBTEST_SUMMARY{2} = join( '&', $numCorrectAnswers, $numIncorrectAnswers, $score, $jpeg, $length, $answerString ); $SUBTEST_ANSWERS{2} = join( '&', @keyanswers ); # Save the changes to the file &put_test_sequence( $testcomplete, $CLIENT{'clid'}, $CANDIDATE{'uid'}, $TEST{'id'} ); } # END ADT sub PrintForm() { if ($FORM{'remed'} == "") { $FORM{'remed'} = 0; } if ($TEST{'seq'} eq 'svy' || $TEST{'seq'} eq 'dmg') { @skilllevel = ( '','','','' ); $itemdescription = "Survey"; } elsif ($FORM{'remed'} == 1) { $TEST{'seq'} = 'svy'; @skilllevel = ( '','','','' ); $itemdescription = "Test"; } elsif ($FORM{'remed'} == 2) { $TEST{'seq'} = 'svy'; @skilllevel = ( '','','','' ); $itemdescription = "Incorrect Test"; } else { @skilllevel = ( 'Basic','Intermediate','Advanced','' ); $itemdescription = "Test"; } if (!$_[0]) { print "Content-Type: text/html\n\n"; } print "\n"; print "
\n"; print "\n"; print "\n"; print "\n"; print "\n"; print "\n"; } sub PrintCSV() { print "Content-Disposition: attachment;filename=report.csv\n\n"; #if (!$_[0]) { print "Content-Type: text/html\n\n"; } #print "\n";
if ($FORM{'remed'} == "") { $FORM{'remed'} = 0; }
if ($TEST{'seq'} eq 'svy' || $TEST{'seq'} eq 'dmg') {
@skilllevel = ( '','','','' );
$itemdescription = "Survey";
} elsif ($FORM{'remed'} == 1) {
$TEST{'seq'} = 'svy';
@skilllevel = ( '','','','' );
$itemdescription = "Test";
} elsif ($FORM{'remed'} == 2) {
$TEST{'seq'} = 'svy';
@skilllevel = ( '','','','' );
$itemdescription = "Incorrect Test";
} else {
@skilllevel = ( 'Basic','Intermediate','Advanced','' );
$itemdescription = "Test";
}
$header = "Site,Test";
$outline = "\"".$CLIENT{'clid'}."\",\"$TEST{'id'} - $TEST{'desc'}\"";
if ($FORM{'testdates'} ne '') {
$header .= ",Date";
$outline .= ",$testdate";
}
$header .= ",\"Last Name\",\"First Name\",\"Middle Initial\"";
$outline .= ",\"$CANDIDATE{'nml'}\",\"$CANDIDATE{'nmf'}\",\"$CANDIDATE{'nmm'}\"";
$header .= ",Address,City,State,\"Postal Code\",Country,E-mail";
$outline .= ",\"$CANDIDATE{'adr'}\",\"$CANDIDATE{'cty'}\",\"$CANDIDATE{'ste'}\",\"$CANDIDATE{'pst'}\",\"$CANDIDATE{'ctry'}\",\"$CANDIDATE{'eml'}\"";
if ($CLIENT{'clcnd1'} ne "") {
$header .= ",\"Custom Field 1\"";
$outline .= ",\"$CANDIDATE{'cnd1'}\"";
}
if ($CLIENT{'clcnd2'} ne "") {
$header .= ",\"Custom Field 2\"";
$outline .= ",\"$CANDIDATE{'cnd2'}\"";
}
if ($CLIENT{'clcnd3'} ne "") {
$header .= ",\"Custom Field 3\"";
$outline .= ",\"$CANDIDATE{'cnd3'}\"";
}
if ($CLIENT{'clcnd4'} ne "") {
$header .= ",\"Custom Field 4\"";
$outline .= ",\"$CANDIDATE{'cnd4'}\"";
}
if (($FORM{'testdates'} ne '' || $FORM{'percent'} ne '') && $FORM{'remed'} == 0) {
if ($FORM{'testdates'} ne '') {
my $history = get_testhistory_from_log($CLIENT{'clid'},$CANDIDATE{'uid'},$TEST{'id'},$testdate);
if (not defined $history) {
$header .= ",\"Start Time\"";
$outline .= ",\"Test Log Not Available\"";
$header .= ",\"Stop Time\"";
$outline .= ",\"Test Log Not Available\"";
$header .= ",\"Total Time\"";
$outline .= ",\"Test Log Not Available\"";
$header .= ",\"Actual Time\"";
$outline .= ",\"Test Log Not Available\"";
} else {
foreach my $event (@{$history->{'history'}}) {
my $action = $event->{'action'};
if ($action eq 'Start' or $action eq 'Pause' or $action eq 'Resume' or $action eq 'Complete') {
($sec,$min,$hour,$mday,$mon,$year,$wday,$yday) = gmtime($event->{'time'});
my @months = ("Jan", "Feb", "Mar", "Apr", "May", "Jun", "Jul", "Aug", "Sep", "Oct", "Nov", "Dec");
$year += 1900;
if ($mday < 10) { $mday = "0$mday"; }
if ($sec < 10) { $sec = "0$sec"; }
if ($min < 10) { $min = "0$min"; }
if ($hour < 10) { $hour = "0$hour"; }
$header .= ",\"$action Time\"";
$outline .= ",\"$mday-$months[$mon]-$year $hour:$min:$sec GMT\"";
}
}
$header .= ",\"Total Time\"";
$outline .= ",\"".fmtDuration($history->{'total'})."\"";
$header .= ",\"Actual Time\"";
$outline .= ",\"".fmtDuration($history->{'actual'})."\"";
}
}
if ($FORM{'percent'} ne '') {
$header .= ",\"Correct Answers\"";
$outline .= ",".$FORM{'correct'};
$header .= ",\"Incorrect Answers\"";
$outline .= ",".$FORM{'incorrect'};
$header .= ",\"Total Number of Questions\"";
$outline .= ",".$FORM{'total'};
$header .= ",\"Score\"";
$outline .= ",\"".$FORM{'percent'}." %\"";
$minpass = ($TEST{'minpass'} eq "") ? "Not Specified" : $TEST{'minpass'}." \%";
$header .= ",\"Passing Score\"";
$outline .= ",\"$minpass\"";
}
}
$allowupdate = 0;
$scored = 1;
$correctanswertag = "$xlatphrase[137]";
$incorrectanswertag = "INCORRECT";
$noanswertag = "UNANSWERED";
@myalbls=();
foreach $questionindex (1 .. $#questions) {
&get_question_definition($TEST{'id'},$CLIENT{'clid'},$questions[$questionindex]);
$qtype = $QUESTION{'qtp'};
if ($FORM{'remed'} != 1) {
if ($TEST{'seq'} ne 'svy' && $TEST{'seq'} ne 'dmg') {
$header .= ",Credit";
}
$header .= ",\"Question Number\"";
#if ($FORM{'remed'} == 0) {
#$header .= ",\"Question ID\",\"Subject Area\",\"Skill Level\"";
#}
#$header .= ",\"Question Text\"";
if ($qtype ne "mtx") {
if ($TEST{'seq'} eq 'svy' || $TEST{'seq'} eq 'dmg') {
$header .= ",\"$itemdescription-Taker Response\"";
} else {
#$header .= ",\"Subject Skill Level\"";
#$header .= ",\"Correct Response\"";
$header .= ",\"$itemdescription-Taker Response\"";
}
}
}
if ($qtype eq 'plc') { next; }
$myqalb = $QUESTION{'qalb'};
($qsubj, $sklvl) = split(/\./, $QUESTION{'subj'});
if ($sklvl eq '') { $sklvl = 3; }
my $trash = $studentanswers[$questionindex];
($studentresponse,$studentcomments) = split(/::/,lc($studentanswers[$questionindex]));
$studentcomments =unmunge($studentcomments);
$studentcomments =~ s/\"/\"/g;
$studentcomments =~ s/\+/" "/g;
($keyresponse,$kflags) = split(/::/, lc($keyanswers[$questionindex]));
$scoreable = 1;
$credit = $noanswertag;
$checked = "";
$answerkey = "";
$studentkey = "";
$qanswermatch = "";
@txts = ();
if (($TEST{'seq'} ne 'svy' && $TEST{'seq'} ne 'dmg') || $FORM{'remed'} == 2) {
if ($qtype eq 'nrt') {
$scored = 0;
$scoreable = 0;
$tmpsr = $studentresponse;
$tmpsr =~ s/\?//g;
$tmpsr =~ s/xxx//g;
$tmpsr =~ s/ //g;
if ($studentresponse eq '') {
$credit = $noanswertag;
} else {
$credit = "unscoreable";
if ($keyresponse ne '') {
($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;
$corsc++;
} else {
$credit = $incorrectanswertag;
$studentresponse =~ s/\?//g;
$studentresponse =~ s/xxx//g;
$studentresponse =~ s/ //g;
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;
$corsc++;
}
}
$answerkey =~ s/\,/
/g;
} else {
if (lc($studentresponse) eq lc($keyresponse)) {
$credit = $correctanswertag;
$corsc++;
} else {
$credit = $incorrectanswertag;
$studentresponse =~ s/\?//g;
$studentresponse =~ s/xxx//g;
$studentresponse =~ s/ //g;
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\?/ || $studentresponse =~ /\?$jidx$/) ? " CHECKED" : "";
$studentkey = join('',$studentkey,"$myalbls[$jidx]. $txts[$indexs[0]]
\n");
}
if ($studentkey eq $answerkey) {
$credit = $correctanswertag;
$corsc++;
} else {
$credit = $incorrectanswertag;
$studentresponse =~ s/\?//g;
$studentresponse =~ s/ //g;
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\?/ || $studentresponse =~ /\?$jidx$/) ? " CHECKED" : "";
$studentkey = join('',$studentkey," $txts[$indexs[0]]
\n");
}
if ($studentkey eq $answerkey) {
$credit = $correctanswertag;
$corsc++;
} else {
$credit = $incorrectanswertag;
$studentresponse =~ s/\?//g;
$studentresponse =~ s/ //g;
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");
if ( $studentresponse[$_] eq "xxx" ) {
$studentresponse[$_] = " ";
}
$studentkey = join('',$studentkey,"(",$studentresponse[$_],") $txts[$_]
\n");
}
@cansord = ();
$studentresponse="";
for (0 .. $#studentresponse) {
if ($studentresponse[$_] ne ' ') {
$studentresponse=join('', $studentresponse, $studentresponse[$_]);
}
}
if ($studentresponse eq $keyresponse) {
$credit = $correctanswertag;
$corsc++;
} else {
$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");
if ( $studentresponse[$_] eq "xxx" ) {
$studentresponse[$_] = " ";
}
$studentkey = join('',$studentkey,"(",$studentresponse[$_],") $txts[$ansopts[$_]]
\n");
}
if ($studentkey eq $answerkey) {
$credit = $correctanswertag;
$corsc++;
} else {
$credit = $incorrectanswertag;
#$studentresponse =~ s/ //g;
if ($studentresponse eq '') { $credit = $noanswertag;}
}
}
} else {
### Must be a svy or dmg
if ($qtype eq 'nrt') {
$studentkey = unmunge($studentresponse);
$studentkey = "$studentkey";
}
if ($qtype eq 'tf') {
$studentkey = $studentresponse;
$studentresponse =~ s/\?//g;
$studentresponse =~ s/xxx//g;
$studentresponse =~ s/ //g;
if ($studentresponse eq '') { $credit = $noanswertag;}
}
if ($qtype eq 'esa') {
$studentkey = $studentresponse;
$studentresponse =~ s/\?//g;
$studentresponse =~ s/xxx//g;
$studentresponse =~ s/ //g;
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]);
my $srstring = $studentresponse."?";
$checked = ($srstring =~ /\?$jidx\?/) ? "1" : "0";
if ($checked) {
$studentkey .= "$myalbls[$jidx]) $txts[$indexs[0]]";
}
}
$studentresponse =~ s/\?//g;
$studentresponse =~ s/ //g;
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, $numqrowhdr, $numqcolhdr, $qcolhdr) = split(/::/,$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] eq "xxx" || $studentresponse eq "")
{
$chmatrix[$row][$col]="0";
}
else
{
$chmatrix[$row][$col]="1";
}
$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 .. 10)
{
if ($irank eq $rank)
{
$chmatrix[$i][$irank]="SELECTED";
}
else
{
$chmatrix[$i][$irank]="";
}
}
$i++;
}
}
}
# Build matrix data
$i=0;
$mtxoutline = "";
foreach $row (0 .. $#qrowhdr) {
foreach $col (0 .. $#qcolhdr) {
$header .= ",\"$qrowhdr[$row]:$qcolhdr[$col]\"";
if ($qtype eq 'mtx') {
$mtxoutline .= ",\"$chmatrix[$row][$col]\"";
} else {
$studentkey .= " ";
}
$i++;
}
}
#$studentkey = $mtxoutline;
@qrowhdr = ();
@qcolhdr = ();
@chmatrix = ();
#$studentkey = join('',$studentkey,"($myalbls[$jidx]) $txts[$indexs[0]]
\n");
$studentresponse =~ s/xxx//g;
$studentresponse =~ s/\?//g;
$studentresponse =~ s/ //g;
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]);
my $srstring = $studentresponse."?";
$checked = ($srstring =~ /\?$jidx\?/) ? " CHECKED" : "";
$studentkey = join('',$studentkey,"($myalbls[$jidx]) $txts[$indexs[0]]
\n");
}
$studentresponse =~ s/\?//g;
$studentresponse =~ s/ //g;
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) {
### DED-04 changed
# $studentkey = join('',$studentkey,"(",substr($studentresponse,$_,1),") $txts[$_]
\n");
### to
$studentkey = join('',$studentkey,"(",$studentresponse[$_],") $txts[$_]
\n");
}
@cansord = ();
$studentresponse =~ s/xxx//g;
$studentresponse =~ s/\?//g;
$studentresponse =~ s/ //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++;
### DED-05 changed
# $studentkey = join('',$studentkey,"(",substr($studentresponse,$_,1),") $txts[$ansopts[$_]]
\n");
### to
$studentkey = join('',$studentkey,"(",$studentresponse[$_],") $txts[$ansopts[$_]]
\n");
}
$studentresponse =~ s/xxx//g;
$studentresponse =~ s/\?//g;
$studentresponse =~ s/ //g;
if ($studentresponse eq '') { $credit = $noanswertag;}
}
}
if ($TEST{'seq'} ne 'svy' && $TEST{'seq'} ne 'dmg') {
$outline .= "\n";
if ($scoreable) {
$outline .= "$credit \n";
} else {
if ($credit eq $noanswertag) {
$outline .= "$credit \n";
} else {
$checked = ($manuallyscored) ? " CHECKED" : "";
$outline .= "Credit \n";
$allowupdate = 1;
}
}
$outline .= "$questionindex. \n";
$outline .= "$QUESTION{'id'}
$qsubj
$skilllevel[$sklvl] \n";
$outline .= "$QUESTION{'qtx'} \n";
$outline .= " \n";
$outline .= "\n";
$outline .= "\
$qanswermatch \n";
$outline .= " \n";
$outline .= "\n";
if (($qtype eq 'nrt') && ($studentresponse ne '')) {
if ($keycomments eq '') {
$outline .= "Comments:
\n";
} else {
$outline .= "Comments:
\n";
}
} else {
$outline .= "$answerkey \n";
}
$outline .= "$studentkey \n";
$outline .= " \n";
if (($TEST{'remt'} ne '0') && ($TEST{'emlcndopt'} eq 'Y')
&& ($SESSION{'uac'} eq 'cnd')) {
$outline .= "\n";
$outline .= " \n";
$outline .= "$QUESTION{'qrm'} \n";
$outline .= " \n";
}
if ($QUESTION{'qcmtprmpt'} eq 'Y') {
$outline .= "\n";
$outline .= "
\n";
$outline .= "
\n";
$outline .= "
\n";
$outline .= "\
(Student Comments) $QUESTION{'qcprmpt'}
$studentcomments \n";
$outline .= " \n";
}
} else {
### Must be a svy or dmg
unless ($FORM{'remed'} == 2 && $credit eq $correctanswertag) {
$outline .= ",\"$questionindex. \"";
#if ($FORM{'remed'} == 0) {
#$outline .= ",\"$QUESTION{'id'}\",\"$qsubj\",\"$skilllevel[$sklvl]\"";
#}
#$outline .= ",\"$QUESTION{'qtx'}\"";
#$outline .= ",\"$qanswermatch\"";
if ($qtype eq "mtx") {
$outline .= $mtxoutline ;
} else {
$outline .= ",\"$studentkey\"";
}
#if (($TEST{'remt'} ne '0') && ($TEST{'emlcndopt'} eq 'Y')
#&& ($SESSION{'uac'} eq 'cnd')) {
#$outline .= ",\"$QUESTION{'qrm'}\"";
#}
if ($QUESTION{'qcmtprmpt'} eq 'Y') {
$header .= ",\"(Student Comments) $QUESTION{'qcprmpt'}\"";
$outline .= ",\"$studentcomments\"";
}
}
}
}
$header =~ s/\n/ /g;
$outline =~ s/\n/ /g;
$outline =~ s/
/ /g;
$outline =~ s// /g;
$outline =~ s/<\/p>/ /g;
print "$header\n";
print "$outline\n";
#print "
\n";
}