Diff for /loncom/homework/inputtags.pm between versions 1.231 and 1.232

version 1.231, 2007/09/26 19:30:30 version 1.232, 2007/10/03 02:10:45
Line 539  sub valid_award { Line 539  sub valid_award {
     $i=0;      $i=0;
     my %rev_awards = map { ($_,$i++) } @awards;      my %rev_awards = map { ($_,$i++) } @awards;
   
   sub awarddetail_to_awarded {
       my ($awarddetail) = @_;
       if ($awarddetail eq 'EXACT_ANS'
    || $awarddetail eq 'APPROX_ANS') {
    return 1;
       }
       return 0;
   }
   
 sub finalizeawards {  sub finalizeawards {
     my ($awardref,$msgref,$nameref,$reverse)=@_;      my ($awardref,$msgref,$nameref,$reverse,$final_scantron)=@_;
     my $result;      my $result;
     if ($#$awardref == -1) { $result = "NO_RESPONSE"; }      if ($#$awardref == -1) { $result = "NO_RESPONSE"; }
     if ($result eq '' ) {      if ($result eq '' ) {
Line 551  sub finalizeawards { Line 560  sub finalizeawards {
  $blankcount++;   $blankcount++;
     }      }
  }   }
  if ($blankcount == ($#$awardref + 1)) { $result = 'NO_RESPONSE'; }   if ($blankcount == ($#$awardref + 1)) {
       return ('NO_RESPONSE');
    }
     }      }
     if (defined($result)) { return ($result); }      if (!$final_scantron && defined($result)) { return ($result); }
   
       # if in scantron mode, if the award for any response is 
       # assigned score, then the part gets an assigned score
       if ($final_scantron 
    && grep {$_ eq 'ASSIGNED_SCORE'} (@$awardref)) {
    return ('ASSIGNED_SCORE');
       }
   
       # if in scantron mode, if the award for any response is 
       # correct and there are non-correct responses,
       # then the part gets an assigned score
       if ($final_scantron 
    && (grep { $_ eq 'EXACT_ANS' ||
      $_ eq 'APPROX_ANS'  } (@$awardref))
    && (grep { $_ ne 'EXACT_ANS' &&
      $_ ne 'APPROX_ANS'  } (@$awardref))) {
    return ('ASSIGNED_SCORE');
       }
     # these awards are ordered from most important error through best correct      # these awards are ordered from most important error through best correct
     my $awards = (!$reverse) ? \%fwd_awards : \%rev_awards ;      my $awards = (!$reverse) ? \%fwd_awards : \%rev_awards ;
   
Line 568  sub finalizeawards { Line 596  sub finalizeawards {
  }   }
  $j++;   $j++;
     }      }
   
     if (defined($which)) {      if (defined($which)) {
  if (ref($nameref)) {   if (ref($nameref)) {
     return ($$awardref[$which],$$msgref[$which],$$nameref[$which]);      return ($$awardref[$which],$$msgref[$which],$$nameref[$which]);
Line 873  sub setgradedata { Line 902  sub setgradedata {
     my $numawards=scalar(@Apache::inputtags::response);      my $numawards=scalar(@Apache::inputtags::response);
     $Apache::lonhomework::results{"resource.$id.awarded"} = 0;      $Apache::lonhomework::results{"resource.$id.awarded"} = 0;
     foreach my $res (@Apache::inputtags::response) {      foreach my $res (@Apache::inputtags::response) {
  $Apache::lonhomework::results{"resource.$id.awarded"}+=   if (defined($Apache::lonhomework::results{"resource.$id.$res.awarded"})) {
     $Apache::lonhomework::results{"resource.$id.$res.awarded"};      $Apache::lonhomework::results{"resource.$id.awarded"}+=
    $Apache::lonhomework::results{"resource.$id.$res.awarded"};
    } else {
       $Apache::lonhomework::results{"resource.$id.awarded"}+=
    &awarddetail_to_awarded($Apache::lonhomework::results{"resource.$id.$res.awarddetail"});
    }
     }      }
     if ($numawards > 0) {      if ($numawards > 0) {
  $Apache::lonhomework::results{"resource.$id.awarded"}/=   $Apache::lonhomework::results{"resource.$id.awarded"}/=
Line 1006  sub grade { Line 1040  sub grade {
     &Apache::lonxml::debug("got message $value from $response for $id");      &Apache::lonxml::debug("got message $value from $response for $id");
     push (@msgs,$value);      push (@msgs,$value);
  }   }
  my ($finalaward,$msg) = &finalizeawards(\@awards,\@msgs);   my ($finalaward,$msg) = 
       &finalizeawards(\@awards,\@msgs,undef,undef,
       $Apache::lonhomework::scantronmode);
  my $previously_used;   my $previously_used;
  if ( $#Apache::inputtags::previous eq $#awards ) {   if ( $#Apache::inputtags::previous eq $#awards ) {
     my ($match) =      my ($match) =

Removed from v.1.231  
changed lines
  Added in v.1.232


FreeBSD-CVSweb <freebsd-cvsweb@FreeBSD.org>