--- loncom/homework/default_homework.lcpm 2010/01/06 16:59:30 1.147 +++ loncom/homework/default_homework.lcpm 2010/10/14 19:54:56 1.149 @@ -1,7 +1,7 @@ # The LearningOnline Network with CAPA # used by lonxml::xmlparse() as input variable $safeinit to Apache::run::run() # -# $Id: default_homework.lcpm,v 1.147 2010/01/06 16:59:30 www Exp $ +# $Id: default_homework.lcpm,v 1.149 2010/10/14 19:54:56 raeburn Exp $ # # Copyright Michigan State University Board of Trustees # @@ -320,6 +320,7 @@ sub caparesponse_check_list { } &LONCAPA_INTERNAL_DEBUG("Final final response :$responses->[0][-1]:$unit:"); $unit=~s/\s//; + my $error; foreach my $response (@$responses) { foreach my $element (@$response) { if (($type eq 'float') || (($type eq '') && ($unit ne ''))) { @@ -343,7 +344,9 @@ sub caparesponse_check_list { if (($element==0) && ($unit!~/\w/) && ($answerunit=~/\w/)) { $appendunit=$answerunit; } - $element .= " $appendunit"; + if ($appendunit ne '') { + $element .= " $appendunit"; + } &LONCAPA_INTERNAL_DEBUG("Made response element :$element:"); } } @@ -366,6 +369,10 @@ sub caparesponse_check_list { for (my $j=0; $j[$j], $response->[$j]); + if ($type eq 'cs' || $type eq 'ci') { + $error = &verify_stringresponse($type,$award,$response->[$j], + $answer->[$j]); + } push(@awards,$award); push(@msgs, $msg); } @@ -392,6 +399,10 @@ sub caparesponse_check_list { for (my $j=0; $j[$j], $response->[$j]); + if ($type eq 'cs' || $type eq 'ci') { + $error = &verify_stringresponse($type,$award,$response->[$j], + $answer->[$j]); + } push(@awards,$award); push(@msgs, $msg); } @@ -438,7 +449,29 @@ sub caparesponse_check_list { &LONCAPA_INTERNAL_DEBUG(" all final_awards ".join(':',@final_awards)); my ($final_award,$final_msg) = &LONCAPA_INTERNAL_FINALIZEAWARDS(\@final_awards,\@final_msg,undef,1); - return ($final_award,$final_msg); + return ($final_award,$final_msg,$error); +} + +sub verify_stringresponse { + my ($type,$award,$resp,$ans) = @_; + return if ($award eq 'EXACT_ANS'); + my $error; + if ($resp =~ /^\s|\s$/) { + $resp =~ s{^\s+|\s+$}{}g; + } + if ($ans =~ /^\s|\s$/) { + $ans =~ s{^\s+|\s+$}{}g; + } + if ($type eq 'ci') { + $resp = lc($resp); + $ans = lc($ans); + } + if ($resp eq $ans) { + if ($award eq 'INCORRECT') { + $error = 'MISGRADED'; + } + } + return $error; } sub cas {