--- loncom/homework/inputtags.pm 2006/09/29 20:55:33 1.206 +++ loncom/homework/inputtags.pm 2006/09/29 23:04:37 1.207 @@ -1,7 +1,7 @@ # The LearningOnline Network with CAPA # input definitons # -# $Id: inputtags.pm,v 1.206 2006/09/29 20:55:33 albertel Exp $ +# $Id: inputtags.pm,v 1.207 2006/09/29 23:04:37 albertel Exp $ # # Copyright Michigan State University Board of Trustees # @@ -484,20 +484,6 @@ sub show_past_portfile_submission { } -sub checkstatus { - my ($value,$awardref,$msgref,$nameref)=@_; - for (my $i=0;$i<=$#$awardref;$i++) { - if ($$awardref[$i] eq $value) { - if (ref($nameref)) { - return ($$awardref[$i],$$msgref[$i],$$nameref[$i]); - } else { - return ($$awardref[$i],$$msgref[$i]); - } - } - } - return(undef,undef); -} - sub valid_award { my ($award) =@_; foreach my $possibleaward ('EXTRA_ANSWER','MISSING_ANSWER', 'ERROR', @@ -515,13 +501,29 @@ sub valid_award { return 0; } +{ + my @awards = ('EXTRA_ANSWER', 'MISSING_ANSWER', 'ERROR', 'NO_RESPONSE', + 'TOO_LONG', + 'UNIT_INVALID_INSTRUCTOR', 'UNIT_INVALID_STUDENT', + 'UNIT_IRRECONCIBLE', 'UNIT_FAIL', 'NO_UNIT', + 'UNIT_NOTNEEDED', 'WANTED_NUMERIC', 'BAD_FORMULA', + 'COMMA_FAIL', 'SIG_FAIL', 'INCORRECT', 'MISORDERED_RANK', + 'INVALID_FILETYPE', 'DRAFT', 'SUBMITTED', 'ASSIGNED_SCORE', + 'APPROX_ANS', 'EXACT_ANS'); + my $i=0; + my %fwd_awards = map { ($_,$i++) } @awards; + my $max=scalar(@awards); + @awards=reverse(@awards); + my $i=0; + my %rev_awards = map { ($_,$i++) } @awards; + sub finalizeawards { my ($awardref,$msgref,$nameref,$reverse)=@_; - my ($result,$award,$msg,$name); + my $result; if ($#$awardref == -1) { $result = "NO_RESPONSE"; } if ($result eq '' ) { my $blankcount; - foreach $award (@$awardref) { + foreach my $award (@$awardref) { if ($award eq '') { $result='MISSING_ANSWER'; $blankcount++; @@ -529,26 +531,31 @@ sub finalizeawards { } if ($blankcount == ($#$awardref + 1)) { $result = 'NO_RESPONSE'; } } - if (defined($result)) { return ($result,$msg); } + if (defined($result)) { return ($result); } # these awards are ordered from most important error through best correct - - my @awards = ('EXTRA_ANSWER', 'MISSING_ANSWER', 'ERROR', 'NO_RESPONSE', - 'TOO_LONG', - 'UNIT_INVALID_INSTRUCTOR', 'UNIT_INVALID_STUDENT', - 'UNIT_IRRECONCIBLE', 'UNIT_FAIL', 'NO_UNIT', - 'UNIT_NOTNEEDED', 'WANTED_NUMERIC', 'BAD_FORMULA', - 'COMMA_FAIL', 'SIG_FAIL', 'INCORRECT', 'MISORDERED_RANK', - 'INVALID_FILETYPE', 'DRAFT', 'SUBMITTED', 'ASSIGNED_SCORE', - 'APPROX_ANS', 'EXACT_ANS'); - if ($reverse) { @awards=reverse(@awards); } - foreach my $possibleaward (@awards) { - ($result,$msg,$name)=&checkstatus($possibleaward,$awardref,$msgref, - $nameref); - if (defined($result)) { return ($result,$msg,$name); } + my $awards = (!$reverse) ? \%fwd_awards : \%rev_awards ; + + my $best = $max; + my $j=0; + my $which; + foreach my $award (@$awardref) { + if ($awards->{$award} < $best) { + $best = $awards->{$award}; + $which = $j; + } + $j++; + } + if (defined($which)) { + if (ref($nameref)) { + return ($$awardref[$which],$$msgref[$which],$$nameref[$which]); + } else { + return ($$awardref[$which],$$msgref[$which]); + } } return ('ERROR',undef); } +} sub decideoutput { my ($award,$awarded,$awardmsg,$solved,$previous,$target)=@_;