[BACK]Return to grades.pm CVS log [TXT] [DIR] Up to [LON-CAPA] / loncom / homework

Diff for /loncom/homework/grades.pm between versions 1.522 and 1.536

version 1.522, 2008/05/24 00:34:12 version 1.536, 2008/12/15 20:55:38
Line 26 Line 26
 # http://www.lon-capa.org/  # http://www.lon-capa.org/
 #  #
   
   
   
 package Apache::grades;  package Apache::grades;
 use strict;  use strict;
 use Apache::style;  use Apache::style;
Line 58  my $ssi_error_resource; Line 60  my $ssi_error_resource;
 my $ssi_error_message;  my $ssi_error_message;
   
   
 #  Do an ssi with retries:  
 #  While I'd love to factor out this with the vesrion in lonprintout,  
 #  that would either require a data coupling between modules, which I refuse to perpetuate  
 #  (there's quite enough of that already), or would require the invention of another infrastructure  
 #  I'm not quite ready to invent (e.g. an ssi_with_retry object).  
 #  
 # At least the logic that drives this has been pulled out into loncommon.  
   
   
 #  
 #   ssi_with_retries - Does the server side include of a resource.  
 #                      if the ssi call returns an error we'll retry it up to  
 #                      the number of times requested by the caller.  
 #                      If we still have a proble, no text is appended to the  
 #                      output and we set some global variables.  
 #                      to indicate to the caller an SSI error occurred.    
 #                      All of this is supposed to deal with the issues described  
 #                      in LonCAPA BZ 5631 see:  
 #                      http://bugs.lon-capa.org/show_bug.cgi?id=5631  
 #                      by informing the user that this happened.  
 #  
 # Parameters:  
 #   resource   - The resource to include.  This is passed directly, without  
 #                interpretation to lonnet::ssi.  
 #   form       - The form hash parameters that guide the interpretation of the resource  
 #                  
 #   retries    - Number of retries allowed before giving up completely.  
 # Returns:  
 #   On success, returns the rendered resource identified by the resource parameter.  
 # Side Effects:  
 #   The following global variables can be set:  
 #    ssi_error                - If an unrecoverable error occurred this becomes true.  
 #                               It is up to the caller to initialize this to false  
 #                               if desired.  
 #    ssi_error_resource  - If an unrecoverable error occurred, this is the value  
 #                               of the resource that could not be rendered by the ssi  
 #                               call.  
 #    ssi_error_message   - The error string fetched from the ssi response  
 #                               in the event of an error.  
 #  
 sub ssi_with_retries {  sub ssi_with_retries {
     my ($resource, $retries, %form) = @_;      my ($resource, $retries, %form) = @_;
     my ($content, $response) = &Apache::loncommon::ssi_with_retries($resource, $retries, %form);      my ($content, $response) = &Apache::loncommon::ssi_with_retries($resource, $retries, %form);
Line 240  sub showResourceInfo { Line 202  sub showResourceInfo {
     my %resptype = ();      my %resptype = ();
     my $hdgrade='no';      my $hdgrade='no';
     my %partsseen;      my %partsseen;
     foreach my $partID (sort keys(%$responseType)) {      foreach my $partID (sort(keys(%$responseType))) {
  foreach my $resID (sort keys(%{ $responseType->{$partID} })) {   foreach my $resID (sort(keys(%{ $responseType->{$partID} }))) {
     my $handgrade=$$handgrade{$partID.'_'.$resID};      my $handgrade=$$handgrade{$partID.'_'.$resID};
     my $responsetype = $responseType->{$partID}->{$resID};      my $responsetype = $responseType->{$partID}->{$resID};
     $hdgrade = $handgrade if ($handgrade eq 'yes');      $hdgrade = $handgrade if ($handgrade eq 'yes');
Line 278  sub reset_caches { Line 240  sub reset_caches {
     }      }
   
     sub get_analyze {      sub get_analyze {
  my ($symb,$uname,$udom)=@_;   my ($symb,$uname,$udom,$no_increment)=@_;
  my $key = "$symb\0$uname\0$udom";   my $key = "$symb\0$uname\0$udom";
  return $analyze_cache{$key} if (exists($analyze_cache{$key}));   return $analyze_cache{$key} if (exists($analyze_cache{$key}));
   
Line 290  sub reset_caches { Line 252  sub reset_caches {
     'grade_symb' => $symb,      'grade_symb' => $symb,
     'grade_courseid' =>       'grade_courseid' => 
     $env{'request.course.id'},      $env{'request.course.id'},
     'grade_username' => $uname));      'grade_username' => $uname,
                                               'grade_noincrement' => $no_increment));
  (undef,$subresult)=split(/_HASH_REF__/,$subresult,2);   (undef,$subresult)=split(/_HASH_REF__/,$subresult,2);
  my %analyze=&Apache::lonnet::str2hash($subresult);   my %analyze=&Apache::lonnet::str2hash($subresult);
  return $analyze_cache{$key} = \%analyze;   return $analyze_cache{$key} = \%analyze;
     }      }
   
     sub get_order {      sub get_order {
  my ($partid,$respid,$symb,$uname,$udom)=@_;   my ($partid,$respid,$symb,$uname,$udom,$no_increment)=@_;
  my $analyze = &get_analyze($symb,$uname,$udom);   my $analyze = &get_analyze($symb,$uname,$udom,$no_increment);
  return $analyze->{"$partid.$respid.shown"};   return $analyze->{"$partid.$respid.shown"};
     }      }
   
Line 1030  LISTJAVASCRIPT Line 993  LISTJAVASCRIPT
        '&nbsp;'.$section.($group ne '' ?'/'.$group:'').'</td>'."\n";         '&nbsp;'.$section.($group ne '' ?'/'.$group:'').'</td>'."\n";
   
     if ($env{'form.showgrading'} eq 'yes' && $submitonly ne 'all') {      if ($env{'form.showgrading'} eq 'yes' && $submitonly ne 'all') {
  foreach (sort keys(%status)) {   foreach (sort(keys(%status))) {
     next if ($_ =~ /^resource.*?submitted_by$/);      next if ($_ =~ /^resource.*?submitted_by$/);
     $gradeTable.='<td align="center">&nbsp;'.&mt($status{$_}).'&nbsp;</td>'."\n";      $gradeTable.='<td align="center">&nbsp;'.&mt($status{$_}).'&nbsp;</td>'."\n";
  }   }
Line 1680  sub gradeBox { Line 1643  sub gradeBox {
   
     my $radio.='<table border="0"><tr>'."\n";  # display radio buttons in a nice table 10 across      my $radio.='<table border="0"><tr>'."\n";  # display radio buttons in a nice table 10 across
     while ($thisweight<=$wgt) {      while ($thisweight<=$wgt) {
  $radio.= '<td><span style="white-space: nowrap;"><label><input type="radio" name="RADVAL'.$counter.'_'.$partid.'" '.   $radio.= '<td><span class="LC_nobreak"><label><input type="radio" name="RADVAL'.$counter.'_'.$partid.'" '.
     'onclick="javascript:writeBox(this.form,\''.$counter.'_'.$partid.'\','.      'onclick="javascript:writeBox(this.form,\''.$counter.'_'.$partid.'\','.
     $thisweight.')" value="'.$thisweight.'" '.      $thisweight.')" value="'.$thisweight.'" '.
     ($score eq $thisweight ? 'checked="checked"':'').' /> '.$thisweight."</label></span></td>\n";      ($score eq $thisweight ? 'checked="checked"':'').' /> '.$thisweight."</label></span></td>\n";
Line 2225  KEYWORDS Line 2188  KEYWORDS
  $seen{$partid}++;   $seen{$partid}++;
  next if ($$handgrade{$part_resp} ne 'yes'    next if ($$handgrade{$part_resp} ne 'yes' 
  && $env{'form.lastSub'} eq 'hdgrade');   && $env{'form.lastSub'} eq 'hdgrade');
  push @partlist,$partid;   push(@partlist,$partid);
  push @gradePartRespid,$partid.'.'.$respid;   push(@gradePartRespid,$partid.'.'.$respid);
  $request->print(&gradeBox($request,$symb,$uname,$udom,$counter,$partid,\%record));   $request->print(&gradeBox($request,$symb,$uname,$udom,$counter,$partid,\%record));
     }      }
     $request->print('</div></div>');      $request->print('</div></div>');
Line 2553  sub processHandGrade { Line 2516  sub processHandGrade {
   
     my (@parsedlist,@nextlist);      my (@parsedlist,@nextlist);
     my ($nextflg) = 0;      my ($nextflg) = 0;
     foreach (sort       foreach my $item (sort 
      {       {
  if (lc($$fullname{$a}) ne lc($$fullname{$b})) {   if (lc($$fullname{$a}) ne lc($$fullname{$b})) {
      return (lc($$fullname{$a}) cmp lc($$fullname{$b}));       return (lc($$fullname{$a}) cmp lc($$fullname{$b}));
Line 2561  sub processHandGrade { Line 2524  sub processHandGrade {
  return $a cmp $b;   return $a cmp $b;
      } (keys(%$fullname))) {       } (keys(%$fullname))) {
  if ($nextflg == 1 && $button =~ /Next$/) {   if ($nextflg == 1 && $button =~ /Next$/) {
     push @parsedlist,$_;      push(@parsedlist,$item);
  }   }
  $nextflg = 1 if ($_ eq $laststu);   $nextflg = 1 if ($item eq $laststu);
  if ($button eq 'Previous') {   if ($button eq 'Previous') {
     last if ($_ eq $firststu);      last if ($item eq $firststu);
     push @parsedlist,$_;      push(@parsedlist,$item);
  }   }
     }      }
     $ctr = 0;      $ctr = 0;
Line 2589  sub processHandGrade { Line 2552  sub processHandGrade {
     my $submitted = 0;      my $submitted = 0;
     my $ungraded = 0;      my $ungraded = 0;
     my $incorrect = 0;      my $incorrect = 0;
     foreach (keys(%status)) {      foreach my $item (keys(%status)) {
  $submitted = 1 if ($status{$_} ne 'nothing');   $submitted = 1 if ($status{$item} ne 'nothing');
  $ungraded = 1 if ($status{$_} =~ /^ungraded/);   $ungraded = 1 if ($status{$item} =~ /^ungraded/);
  $incorrect = 1 if ($status{$_} =~ /^incorrect/);   $incorrect = 1 if ($status{$item} =~ /^incorrect/);
  my ($foo,$partid,$foo1) = split(/\./,$_);   my ($foo,$partid,$foo1) = split(/\./,$item);
  if ($status{'resource.'.$partid.'.submitted_by'} ne '') {   if ($status{'resource.'.$partid.'.submitted_by'} ne '') {
     $submitted = 0;      $submitted = 0;
  }   }
Line 2604  sub processHandGrade { Line 2567  sub processHandGrade {
     next if (!$ungraded && ($submitonly eq 'graded'));      next if (!$ungraded && ($submitonly eq 'graded'));
     next if (!$incorrect && $submitonly eq 'incorrect');      next if (!$incorrect && $submitonly eq 'incorrect');
  }   }
  push @nextlist,$student if ($ctr < $ntstu);   push(@nextlist,$student) if ($ctr < $ntstu);
  last if ($ctr == $ntstu);   last if ($ctr == $ntstu);
  $ctr++;   $ctr++;
     }      }
Line 2612  sub processHandGrade { Line 2575  sub processHandGrade {
     $ctr = 0;      $ctr = 0;
     my $total = scalar(@nextlist)-1;      my $total = scalar(@nextlist)-1;
   
     foreach (sort @nextlist) {      foreach (sort(@nextlist)) {
  my ($uname,$udom,$submitter) = split(/:/);   my ($uname,$udom,$submitter) = split(/:/);
  $env{'form.student'}  = $uname;   $env{'form.student'}  = $uname;
  $env{'form.userdom'}  = $udom;   $env{'form.userdom'}  = $udom;
Line 2658  sub saveHandGrade { Line 2621  sub saveHandGrade {
     }      }
  } elsif ($dropMenu eq 'reset status'   } elsif ($dropMenu eq 'reset status'
  && exists($record{'resource.'.$new_part.'.solved'})) { #don't bother if no old records -> no attempts   && exists($record{'resource.'.$new_part.'.solved'})) { #don't bother if no old records -> no attempts
     foreach my $key (keys (%record)) {      foreach my $key (keys(%record)) {
  if ($key=~/^resource\.\Q$new_part\E\./) { $newrecord{$key} = ''; }   if ($key=~/^resource\.\Q$new_part\E\./) { $newrecord{$key} = ''; }
     }      }
     $newrecord{'resource.'.$new_part.'.regrader'}=      $newrecord{'resource.'.$new_part.'.regrader'}=
Line 2693  sub saveHandGrade { Line 2656  sub saveHandGrade {
                 &handback_files($request,$symb,$stuname,$domain,$newflg,$new_part,\%newrecord);                  &handback_files($request,$symb,$stuname,$domain,$newflg,$new_part,\%newrecord);
  next;   next;
     } else {      } else {
         push @parts_graded, $new_part;          push(@parts_graded,$new_part);
     }      }
     if ($record{'resource.'.$new_part.'.awarded'} ne $partial) {      if ($record{'resource.'.$new_part.'.awarded'} ne $partial) {
  $newrecord{'resource.'.$new_part.'.awarded'}  = $partial;   $newrecord{'resource.'.$new_part.'.awarded'}  = $partial;
Line 2720  sub saveHandGrade { Line 2683  sub saveHandGrade {
         $record{'resource.'.$new_part.'.solved'} eq 'incorrect_by_override' ||          $record{'resource.'.$new_part.'.solved'} eq 'incorrect_by_override' ||
         $dropMenu eq 'reset status')          $dropMenu eq 'reset status')
    {     {
     push (@version_parts,$new_part);      push(@version_parts,$new_part);
  }   }
     }      }
     my $cdom = $env{'course.'.$env{'request.course.id'}.'.domain'};      my $cdom = $env{'course.'.$env{'request.course.id'}.'.domain'};
Line 2795  sub handback_files { Line 2758  sub handback_files {
                                            $newflg.'_'.$part_resp.'_returndoc'.$file_counter,                                             $newflg.'_'.$part_resp.'_returndoc'.$file_counter,
                                            $save_file_name);                                             $save_file_name);
                     if ($result !~ m|^/uploaded/|) {                      if ($result !~ m|^/uploaded/|) {
                         $request->print('<span class="LC_error">An error occurred ('.$result.                          $request->print('<br /><span class="LC_error">'.
                         ') while trying to upload '.$newflg.'_'.$part_resp.'_returndoc'.$file_counter.'</span><br />');                              &mt('An error occurred ([_1]) while trying to upload [_2].',
                                   $result,$newflg.'_'.$part_resp.'_returndoc'.$file_counter).
                                           '</span>');
                     } else {                      } else {
                         # mark the file as read only                          # mark the file as read only
                         my @files = ($save_file_name);                          my @files = ($save_file_name);
Line 2893  sub decrement_aggs { Line 2858  sub decrement_aggs {
     if ($aggtries == $totaltries) {      if ($aggtries == $totaltries) {
         $decrement{'users'} = 1;          $decrement{'users'} = 1;
     }      }
     foreach my $type (keys (%decrement)) {      foreach my $type (keys(%decrement)) {
         $$aggregate{$symb."\0".$part."\0".$type} = -$decrement{$type};          $$aggregate{$symb."\0".$part."\0".$type} = -$decrement{$type};
     }      }
     return;      return;
Line 3294  sub viewgrades { Line 3259  sub viewgrades {
  $display =~ s|^Number of Attempts|Tries<br />|; # makes the column narrower   $display =~ s|^Number of Attempts|Tries<br />|; # makes the column narrower
  if  (!$display) { $display = &Apache::lonnet::metadata($url,$part.'.name'); }   if  (!$display) { $display = &Apache::lonnet::metadata($url,$part.'.name'); }
  my ($partid) = &split_part_type($part);   my ($partid) = &split_part_type($part);
         push(@partids, $partid);          push(@partids,$partid);
  my $display_part=&get_display_part($partid,$symb);   my $display_part=&get_display_part($partid,$symb);
  if ($display =~ /^Partial Credit Factor/) {   if ($display =~ /^Partial Credit Factor/) {
     $result.='<th>'.      $result.='<th>'.
Line 3448  sub editgrades { Line 3413  sub editgrades {
     my $header;      my $header;
     while ($ctr < $env{'form.totalparts'}) {      while ($ctr < $env{'form.totalparts'}) {
  my $partid = $env{'form.partid_'.$ctr};   my $partid = $env{'form.partid_'.$ctr};
  push @partid,$partid;   push(@partid,$partid);
  $weight{$partid} = $env{'form.weight_'.$partid};   $weight{$partid} = $env{'form.weight_'.$partid};
  $ctr++;   $ctr++;
     }      }
Line 4410  sub displaySubByDates { Line 4375  sub displaySubByDates {
     }      }
   
     my $interaction;      my $interaction;
       my $no_increment = 1;
     for ($version=1;$version<=$$record{'version'};$version++) {      for ($version=1;$version<=$$record{'version'};$version++) {
  my $timestamp =    my $timestamp = 
     &Apache::lonlocal::locallocaltime($$record{$version.':timestamp'});      &Apache::lonlocal::locallocaltime($$record{$version.':timestamp'});
Line 4453  sub displaySubByDates { Line 4419  sub displaySubByDates {
     if (!exists($orders{$partid})) { $orders{$partid}={}; }      if (!exists($orders{$partid})) { $orders{$partid}={}; }
     if (!exists($orders{$partid}->{$responseId})) {      if (!exists($orders{$partid}->{$responseId})) {
  $orders{$partid}->{$responseId}=   $orders{$partid}->{$responseId}=
     &get_order($partid,$responseId,$symb,$uname,$udom);      &get_order($partid,$responseId,$symb,$uname,$udom,
                                          $no_increment);
     }      }
     $displaySub[0].='</b>&nbsp; '.      $displaySub[0].='</b>&nbsp; '.
  &cleanRecord($$record{$version.':'.$matchKey},$responseType,$symb,$partid,$responseId,$record,$orders{$partid}->{$responseId},"$version:",$uname,$udom).'<br />';   &cleanRecord($$record{$version.':'.$matchKey},$responseType,$symb,$partid,$responseId,$record,$orders{$partid}->{$responseId},"$version:",$uname,$udom).'<br />';
Line 4506  sub updateGradeByPage { Line 4473  sub updateGradeByPage {
     my ($uname,$udom) = split(/:/,$env{'form.student'});      my ($uname,$udom) = split(/:/,$env{'form.student'});
     my $usec=$classlist->{$env{'form.student'}}[5];      my $usec=$classlist->{$env{'form.student'}}[5];
     if (!&canmodify($usec)) {      if (!&canmodify($usec)) {
  $request->print('<span class="LC_warning">Unable to modify requested student.('.$env{'form.student'}.'</span>');   $request->print('<span class="LC_warning">'.&mt('Unable to modify requested student ([_1])',$env{'form.student'}).'</span>');
  $request->print(&show_grading_menu_form($env{'form.symb'}));   $request->print(&show_grading_menu_form($env{'form.symb'}));
  return;   return;
     }      }
     my $result='<h3><span class="LC_info">&nbsp;'.$env{'form.title'}.'</span></h3>';      my $result='<h3><span class="LC_info">&nbsp;'.$env{'form.title'}.'</span></h3>';
     $result.='<h3>&nbsp;Student: '.&nameUserString(undef,$env{'form.fullname'},$uname,$udom).      $result.='<h3>&nbsp;'.&mt('Student: ').&nameUserString(undef,$env{'form.fullname'},$uname,$udom).
  '</h3>'."\n";   '</h3>'."\n";
   
     $request->print($result);      $request->print($result);
Line 4520  sub updateGradeByPage { Line 4487  sub updateGradeByPage {
     my ($mapUrl, $id, $resUrl) = &Apache::lonnet::decode_symb( $env{'form.page'});      my ($mapUrl, $id, $resUrl) = &Apache::lonnet::decode_symb( $env{'form.page'});
     my $map = $navmap->getResourceByUrl($resUrl); # add to navmaps      my $map = $navmap->getResourceByUrl($resUrl); # add to navmaps
     if (!$map) {      if (!$map) {
  $request->print('<span class="LC_warning">Unable to grade requested sequence. ('.$resUrl.')</span>');   $request->print('<span class="LC_warning">'.&mt('Unable to grade requested sequence ([_1]).',$resUrl).'</span>');
  my ($symb)=&get_symb($request);   my ($symb)=&get_symb($request);
  $request->print(&show_grading_menu_form($symb));   $request->print(&show_grading_menu_form($symb));
  return;    return; 
Line 4552  sub updateGradeByPage { Line 4519  sub updateGradeByPage {
  &Apache::loncommon::start_data_table_row().   &Apache::loncommon::start_data_table_row().
  '<td align="center" valign="top" >'.$prob.   '<td align="center" valign="top" >'.$prob.
  (scalar(@{$parts}) == 1 ? ''    (scalar(@{$parts}) == 1 ? '' 
                                         : '<br />('.&mt('[quant,_1,&nbsp;parts]',scalar(@{$parts}))                                          : '<br />('.&mt('[quant,_1,&nbsp;part]',scalar(@{$parts}))
  ).')</td>';   .')').'</td>';
     $studentTable.='<td valign="top">&nbsp;<b>'.$title.'</b>&nbsp;</td>';      $studentTable.='<td valign="top">&nbsp;<b>'.$title.'</b>&nbsp;</td>';
   
     my %newrecord=();      my %newrecord=();
Line 4597  sub updateGradeByPage { Line 4564  sub updateGradeByPage {
  }   }
  my $display_part=&get_display_part($partid,$curRes->symb());   my $display_part=&get_display_part($partid,$curRes->symb());
  my $oldstatus = $env{'form.solved'.$question.'_'.$partid};   my $oldstatus = $env{'form.solved'.$question.'_'.$partid};
  $displayPts[0].='&nbsp;<b>Part:</b> '.$display_part.' = '.   $displayPts[0].='&nbsp;<b>'.&mt('Part').':</b> '.$display_part.' = '.
     (($oldstatus eq 'excused') ? 'excused' : $oldpts).      (($oldstatus eq 'excused') ? 'excused' : $oldpts).
     '&nbsp;<br />';      '&nbsp;<br />';
  $displayPts[1].='&nbsp;<b>Part:</b> '.$display_part.' = '.   $displayPts[1].='&nbsp;<b>'.&mt('Part').':</b> '.$display_part.' = '.
      (($score eq 'excused') ? 'excused' : $newpts).       (($score eq 'excused') ? 'excused' : $newpts).
     '&nbsp;<br />';      '&nbsp;<br />';
  $question++;   $question++;
Line 4649  sub updateGradeByPage { Line 4616  sub updateGradeByPage {
   
     $studentTable.=&Apache::loncommon::end_data_table();      $studentTable.=&Apache::loncommon::end_data_table();
     $studentTable.=&show_grading_menu_form($env{'form.symb'});      $studentTable.=&show_grading_menu_form($env{'form.symb'});
     my $grademsg=($changeflag == 0 ? 'No score was changed or updated.' :      my $grademsg=($changeflag == 0 ? &mt('No score was changed or updated.') :
   'The scores were changed for '.    &mt('The scores were changed for [quant,_1,problem].',
   $changeflag.' problem'.($changeflag == 1 ? '.' : 's.'));    $changeflag));
     $request->print($grademsg.$studentTable);      $request->print($grademsg.$studentTable);
   
     return '';      return '';
Line 4982  sub scantron_CODElist { Line 4949  sub scantron_CODElist {
 =cut  =cut
   
 sub scantron_CODEunique {  sub scantron_CODEunique {
     my $result='<span style="white-space: nowrap;">      my $result='<span class="LC_nobreak">
                  <label><input type="radio" name="scantron_CODEunique"                   <label><input type="radio" name="scantron_CODEunique"
                         value="yes" checked="checked" />'.&mt('Yes').' </label>                          value="yes" checked="checked" />'.&mt('Yes').' </label>
                 </span>                  </span>
                 <span style="white-space: nowrap;">                  <span class="LC_nobreak">
                  <label><input type="radio" name="scantron_CODEunique"                   <label><input type="radio" name="scantron_CODEunique"
                         value="no" />'.&mt('No').' </label>                          value="no" />'.&mt('No').' </label>
                 </span>';                  </span>';
Line 5145  sub scantron_selectphase { Line 5112  sub scantron_selectphase {
 ');  ');
   
     &Apache::lonpickcode::code_list($r,2);      &Apache::lonpickcode::code_list($r,2);
   
       $r->print('<br /><form method="post" name="checkscantron">'.
                $default_form_data."\n".
                &Apache::loncommon::start_data_table('LC_scantron_action')."\n".
                &Apache::loncommon::start_data_table_header_row()."\n".
                '<th colspan="2">
                 &nbsp;'.&mt('Review scantron data and submissions for a previously graded folder/sequence')."\n".
                '</th>'."\n".
                 &Apache::loncommon::end_data_table_header_row()."\n".
                 &Apache::loncommon::start_data_table_row()."\n".
                 '<td> '.&mt('Graded folder/sequence:').' </td>'."\n".
                 '<td> '.$sequence_selector.' </td>'.
                 &Apache::loncommon::end_data_table_row()."\n".
                 &Apache::loncommon::start_data_table_row()."\n".
                 '<td> '.&mt('Filename of scoring office file:').' </td>'."\n".
                 '<td> '.$file_selector.' </td>'."\n".
                 &Apache::loncommon::end_data_table_row()."\n".
                 &Apache::loncommon::start_data_table_row()."\n".
                 '<td> '.&mt('Format of data file:').' </td>'."\n".
                 '<td> '.$format_selector.' </td>'."\n".
                 &Apache::loncommon::end_data_table_row()."\n".
                 &Apache::loncommon::start_data_table_row()."\n".
                 '<td colspan="2">'."\n".
                 '<input type="hidden" name="command" value="checksubmissions" />'."\n".
                 '<input type="submit" value="'.&mt('Review Scantron Data and Submission Records').'" />'."\n".
                 '</td>'."\n".
                 &Apache::loncommon::end_data_table_row()."\n".
                 &Apache::loncommon::end_data_table()."\n".
                 '</form><br />');
     $r->print($grading_menu_button);      $r->print($grading_menu_button);
     return      return;
 }  }
   
 =pod  =pod
Line 6579  sub scantron_validate_sequence { Line 6575  sub scantron_validate_sequence {
     return (0,$currentphase+1);      return (0,$currentphase+1);
 }  }
   
 =pod  
   
 =item scantron_validate_ID  
   
    Validates all scanlines in the selected file to not have any  
    invalid or underspecified student IDs  
   
 =cut  
   
 sub scantron_validate_ID {  sub scantron_validate_ID {
     my ($r,$currentphase) = @_;      my ($r,$currentphase) = @_;
Line 6652  sub scantron_validate_ID { Line 6641  sub scantron_validate_ID {
     return (0,$currentphase+1);      return (0,$currentphase+1);
 }  }
   
 =pod  
   
 =item scantron_get_correction  
   
    Builds the interface screen to interact with the operator to fix a  
    specific error condition in a specific scanline  
   
  Arguments:  
     $r           - Apache request object  
     $i           - number of the current scanline  
     $scan_record - hash ref as returned from &scantron_parse_scanline()  
     $scan_config - hash ref as returned from &get_scantron_config()  
     $line        - full contents of the current scanline  
     $error       - error condition, valid values are  
                    'incorrectCODE', 'duplicateCODE',  
                    'doublebubble', 'missingbubble',  
                    'duplicateID', 'incorrectID'  
     $arg         - extra information needed  
        For errors:  
          - duplicateID   - paper number that this studentID was seen before on  
          - duplicateCODE - array ref of the paper numbers this CODE was  
                            seen on before  
          - incorrectCODE - current incorrect CODE   
          - doublebubble  - array ref of the bubble lines that have double  
                            bubble errors  
          - missingbubble - array ref of the bubble lines that have missing  
                            bubble errors  
   
 =cut  
   
 sub scantron_get_correction {  sub scantron_get_correction {
     my ($r,$i,$scan_record,$scan_config,$line,$error,$arg)=@_;      my ($r,$i,$scan_record,$scan_config,$line,$error,$arg)=@_;
Line 6818  ENDSCRIPT Line 6778  ENDSCRIPT
  foreach my $question (@{$arg}) {   foreach my $question (@{$arg}) {
     my @linenums = &prompt_for_corrections($r,$question,$scan_config,      my @linenums = &prompt_for_corrections($r,$question,$scan_config,
                                                    $scan_record, $error);                                                     $scan_record, $error);
             push (@lines_to_correct,@linenums);              push(@lines_to_correct,@linenums);
  }   }
         $r->print(&verify_bubbles_checked(@lines_to_correct));          $r->print(&verify_bubbles_checked(@lines_to_correct));
     } elsif ($error eq 'missingbubble') {      } elsif ($error eq 'missingbubble') {
Line 6838  ENDSCRIPT Line 6798  ENDSCRIPT
  foreach my $question (@{$arg}) {   foreach my $question (@{$arg}) {
     my @linenums = &prompt_for_corrections($r,$question,$scan_config,      my @linenums = &prompt_for_corrections($r,$question,$scan_config,
                                                    $scan_record, $error);                                                     $scan_record, $error);
             push (@lines_to_correct,@linenums);              push(@lines_to_correct,@linenums);
  }   }
         $r->print(&verify_bubbles_checked(@lines_to_correct));          $r->print(&verify_bubbles_checked(@lines_to_correct));
     } else {      } else {
Line 6996  sub prompt_for_corrections { Line 6956  sub prompt_for_corrections {
         my $selected = $$scan_record{"scantron.$current_line.answer"};          my $selected = $$scan_record{"scantron.$current_line.answer"};
  &scantron_bubble_selector($r,$scan_config,$current_line,    &scantron_bubble_selector($r,$scan_config,$current_line, 
           $questionnum,$error,split('', $selected));            $questionnum,$error,split('', $selected));
         push (@linenums,$current_line);          push(@linenums,$current_line);
  $current_line++;   $current_line++;
     }      }
     if ($lines > 1) {      if ($lines > 1) {
Line 7212  sub scantron_validate_CODE { Line 7172  sub scantron_validate_CODE {
      $line,'duplicateCODE',$usedCODEs{$CODE});       $line,'duplicateCODE',$usedCODEs{$CODE});
     return(1,$currentphase);      return(1,$currentphase);
  }   }
  push (@{$usedCODEs{$CODE}},$$scan_record{'scantron.PaperID'});   push(@{$usedCODEs{$CODE}},$$scan_record{'scantron.PaperID'});
     }      }
     return (0,$currentphase+1);      return (0,$currentphase+1);
 }  }
Line 7251  sub scantron_validate_doublebubble { Line 7211  sub scantron_validate_doublebubble {
     return (0,$currentphase+1);      return (0,$currentphase+1);
 }  }
   
 =pod  
   
 =item scantron_get_maxbubble  
   
    Returns the maximum number of bubble lines that are expected to  
    occur. Does this by walking the selected sequence rendering the  
    resource and then checking &Apache::lonxml::get_problem_counter()  
    for what the current value of the problem counter is.  
   
    Caches the results to $env{'form.scantron_maxbubble'},  
    $env{'form.scantron.bubble_lines.n'},   
    $env{'form.scantron.first_bubble_line.n'} and  
    $env{"form.scantron.sub_bubblelines.n"}  
    which are the total number of bubble, lines, the number of bubble  
    lines for response n and number of the first bubble line for response n,  
    and a comma separated list of numbers of bubble lines for sub-questions  
    (for optionresponse, matchresponse, and rankresponse items), for response n.    
   
 =cut  
   
 sub scantron_get_maxbubble {  sub scantron_get_maxbubble {
     if (defined($env{'form.scantron_maxbubble'}) &&      if (defined($env{'form.scantron_maxbubble'}) &&
Line 7300  sub scantron_get_maxbubble { Line 7241  sub scantron_get_maxbubble {
     my $bubble_line     = 0;      my $bubble_line     = 0;
     foreach my $resource (@resources) {      foreach my $resource (@resources) {
         my $symb = $resource->symb();          my $symb = $resource->symb();
   
           my (@parts,@allparts,@possible_parts);
   
         # Need to retrieve part IDs and response IDs because essayresponse,          # Need to retrieve part IDs and response IDs because essayresponse,
         # reactionresponse and organicresponse items are not included in           # reactionresponse and organicresponse items are not included in 
         # $analysis{'parts'} from lonnet::ssi.            # $analysis{'parts'} from lonnet::ssi.  
         my %possible_part_ids;           if (ref($resource->parts()) eq 'ARRAY') {
         if (ref($resource->parts()) eq 'ARRAY') {   
             foreach my $part (@{$resource->parts()}) {              foreach my $part (@{$resource->parts()}) {
                 if (!&Apache::loncommon::check_if_partid_hidden($part,$symb,$udom,$uname)) {                  if (!&Apache::loncommon::check_if_partid_hidden($part,$symb,$udom,$uname)) {
                     my @resp_ids = $resource->responseIds($part);                      my @resp_ids = $resource->responseIds($part);
                     foreach my $id (@resp_ids) {                      foreach my $id (@resp_ids) {
                         $possible_part_ids{$part.'.'.$id} = 1;                          my $part_id = $part.'.'.$id;
                           push(@possible_parts,$part_id);
                     }                      }
                 }                  }
             }              }
         }          }
  my $result=&ssi_with_retries($resource->src(), $ssi_retries,  
  ('symb' => $symb,  
  'grade_target' => 'analyze',  
  'grade_courseid' => $cid,  
  'grade_domain' => $udom,  
  'grade_username' => $uname));  
  my (undef, $an) =  
     split(/_HASH_REF__/,$result, 2);  
   
         my @parts;          my $result=&ssi_with_retries($resource->src(), $ssi_retries,
                                           ('symb' => $symb,
                                            'grade_target' => 'analyze',
                                            'grade_courseid' => $cid,
                                            'grade_domain' => $udom,
                                            'grade_username' => $uname));
           my (undef, $an) =
               split(/_HASH_REF__/,$result, 2);
   
  my %analysis = &Apache::lonnet::str2hash($an);   my %analysis = &Apache::lonnet::str2hash($an);
   
Line 7335  sub scantron_get_maxbubble { Line 7278  sub scantron_get_maxbubble {
                 }                  }
             }              }
         }          }
         # Add part_ids for any essayresponse items.           # Add part_ids for any essayresponse, reactionresponse or 
         foreach my $part_id (keys(%possible_part_ids)) {          # organicresponse items. 
             if (($analysis{$part_id.'.type'} eq 'essayresponse') ||          foreach my $part_id (@possible_parts) {
                 ($analysis{$part_id.'.type'} eq 'reactionresponse') ||              if (grep(/^\Q$part_id\E$/,@parts)) {
                 ($analysis{$part_id.'.type'} eq 'organicresponse')) {                  push(@allparts,$part_id);
                 if (!grep(/^\Q$part_id\E$/,@parts)) {              } else {
                     push (@parts,$part_id);                  if (($analysis{$part_id.'.type'} eq 'essayresponse') ||
                       ($analysis{$part_id.'.type'} eq 'reactionresponse') ||
                       ($analysis{$part_id.'.type'} eq 'organicresponse')) {
                       push(@allparts,$part_id);
                 }                  }
             }              }
         }          }
   
  foreach my $part_id (@parts) {   foreach my $part_id (@allparts) {
             my $lines = $analysis{"$part_id.bubble_lines"};              my $lines;
   
     # TODO - make this a persistent hash not an array.      # TODO - make this a persistent hash not an array.
   
Line 7374  sub scantron_get_maxbubble { Line 7320  sub scantron_get_maxbubble {
                     $numshown = scalar(@{$analysis{$part_id.'.shown'}});                      $numshown = scalar(@{$analysis{$part_id.'.shown'}});
                 }                  }
                 my $bubbles_per_line = 10;                  my $bubbles_per_line = 10;
                 my $inner_bubble_lines = int($numshown/$bubbles_per_line);                  my $inner_bubble_lines = int($numbub/$bubbles_per_line);
                 if (($numshown % $bubbles_per_line) != 0) {                  if (($numbub % $bubbles_per_line) != 0) {
                     $inner_bubble_lines++;                      $inner_bubble_lines++;
                 }                  }
                 for (my $i=0; $i<$numshown; $i++) {                  for (my $i=0; $i<$numshown; $i++) {
Line 7383  sub scantron_get_maxbubble { Line 7329  sub scantron_get_maxbubble {
                         $inner_bubble_lines.',';                          $inner_bubble_lines.',';
                 }                  }
                 $subdivided_bubble_lines{$response_number} =~ s/,$//;                  $subdivided_bubble_lines{$response_number} =~ s/,$//;
                   $lines = $numshown * $inner_bubble_lines;
               } else {
                   $lines = $analysis{"$part_id.bubble_lines"};
             }               } 
   
             $first_bubble_line{$response_number} = $bubble_line;              $first_bubble_line{$response_number} = $bubble_line;
Line 7404  sub scantron_get_maxbubble { Line 7353  sub scantron_get_maxbubble {
     return $env{'form.scantron_maxbubble'};      return $env{'form.scantron_maxbubble'};
 }  }
   
 =pod  
   
 =item scantron_validate_missingbubbles  
   
    Validates all scanlines in the selected file to not have any  
     answers that don't have bubbles that have not been verified  
     to be bubble free.  
   
 =cut  
   
 sub scantron_validate_missingbubbles {  sub scantron_validate_missingbubbles {
     my ($r,$currentphase) = @_;      my ($r,$currentphase) = @_;
Line 7467  sub scantron_validate_missingbubbles { Line 7407  sub scantron_validate_missingbubbles {
     return (0,$currentphase+1);      return (0,$currentphase+1);
 }  }
   
 =pod  
   
 =item scantron_process_students  
   
    Routine that does the actual grading of the bubble sheet information.  
   
    The parsed scanline hash is added to %env   
   
    Then foreach unskipped scanline it does an &Apache::lonnet::ssi()  
    foreach resource , with the form data of  
   
  'submitted'     =>'scantron'   
  'grade_target'  =>'grade',  
  'grade_username'=> username of student  
  'grade_domain'  => domain of student  
  'grade_courseid'=> of course  
  'grade_symb'    => symb of resource to grade  
   
     This triggers a grading pass. The problem grading code takes care  
     of converting the bubbled letter information (now in %env) into a  
     valid submission.  
   
 =cut  
   
 sub scantron_process_students {  sub scantron_process_students {
     my ($r) = @_;      my ($r) = @_;
Line 7620  SCANTRONFORM Line 7537  SCANTRONFORM
     return '';      return '';
 }  }
   
 =pod  
   
 =item scantron_upload_scantron_data  
   
     Creates the screen for adding a new bubble sheet data file to a course.  
   
 =cut  
   
 sub scantron_upload_scantron_data {  sub scantron_upload_scantron_data {
     my ($r)=@_;      my ($r)=@_;
     $r->print(&Apache::loncommon::coursebrowser_javascript($env{'request.role.domain'}));      $r->print(&Apache::loncommon::coursebrowser_javascript($env{'request.role.domain'}));
Line 7668  sub scantron_upload_scantron_data { Line 7577  sub scantron_upload_scantron_data {
     return '';      return '';
 }  }
   
 =pod  
   
 =item scantron_upload_scantron_data_save  
   
    Adds a provided bubble information data file to the course if user  
    has the correct privileges to do so.    
   
 =cut  
   
 sub scantron_upload_scantron_data_save {  sub scantron_upload_scantron_data_save {
     my($r)=@_;      my($r)=@_;
Line 7737  sub scantron_upload_scantron_data_save { Line 7638  sub scantron_upload_scantron_data_save {
     return '';      return '';
 }  }
   
 =pod  
   
 =item valid_file  
   
    Validates that the requested bubble data file exists in the course.  
   
 =cut  
   
 sub valid_file {  sub valid_file {
     my ($requested_file)=@_;      my ($requested_file)=@_;
     foreach my $filename (sort(&scantron_filenames())) {      foreach my $filename (sort(&scantron_filenames())) {
Line 7753  sub valid_file { Line 7646  sub valid_file {
     return 0;      return 0;
 }  }
   
 =pod  
   
 =item scantron_download_scantron_data  
   
    Shows a list of the three internal files (original, corrected,  
    skipped) for a specific bubble sheet data file that exists in the  
    course.  
   
 =cut  
   
 sub scantron_download_scantron_data {  sub scantron_download_scantron_data {
     my ($r)=@_;      my ($r)=@_;
     my $default_form_data=&defaultFormData(&get_symb($r,1));      my $default_form_data=&defaultFormData(&get_symb($r,1));
Line 7802  sub scantron_download_scantron_data { Line 7685  sub scantron_download_scantron_data {
     return '';      return '';
 }  }
   
 =pod  sub checkscantron_results {
       my ($r) = @_;
       my ($symb)=&get_symb($r);
       if (!$symb) {return '';}
       my $grading_menu_button=&show_grading_menu_form($symb);
       my $cid = $env{'request.course.id'};
       my %lettdig = (
                       A => 1,
                       B => 2,
                       C => 3,
                       D => 4,
                       E => 5,
                       F => 6,
                       G => 7,
                       H => 8,
                       I => 9,
                       J => 0,
                     );
       my $numletts = scalar(keys(%lettdig));
       my $cnum = $env{'course.'.$cid.'.num'};
       my $cdom = $env{'course.'.$cid.'.domain'};
       my (undef, undef, $sequence) = &Apache::lonnet::decode_symb($env{'form.selectpage'});
       my %record;
       my %scantron_config =
           &Apache::grades::get_scantron_config($env{'form.scantron_format'});
       my ($scanlines,$scan_data)=&Apache::grades::scantron_getfile();
       my $classlist=&Apache::loncoursedata::get_classlist();
       my %idmap=&Apache::grades::username_to_idmap($classlist);
       my $navmap=Apache::lonnavmaps::navmap->new();
       my $map=$navmap->getResourceByUrl($sequence);
       my @resources=$navmap->retrieveResources($map,undef,1,0);
       my (%scandata,%lastname,%bylast);
       $r->print('
   <form method="post" enctype="multipart/form-data" action="/adm/grades" name="checkscantron">'."\n");
   
 =back      my @delayqueue;
       my %completedstudents;
   
       my $count=&Apache::grades::get_todo_count($scanlines,$scan_data);
       my %prog_state=&Apache::lonhtmlcommon::Create_PrgWin($r,'Scantron/Submissions Comparison Status',
                                       'Progress of Scantron Data/Submission Records Comparison',$count,
                                       'inline',undef,'checkscantron');
       my ($username,$domain,$uname,$started);
   
       &Apache::grades::scantron_get_maxbubble();  # Need the bubble lines array to parse.
   
       &Apache::lonhtmlcommon::Update_PrgWin($r,\%prog_state,
                                             'Processing first student');
       my $start=&Time::HiRes::time();
       my $i=-1;
   
       while ($i<$scanlines->{'count'}) {
           ($username,$domain,$uname)=('','','');
           $i++;
           my $line=&Apache::grades::scantron_get_line($scanlines,$scan_data,$i);
           if ($line=~/^[\s\cz]*$/) { next; }
           if ($started) {
               &Apache::lonhtmlcommon::Increment_PrgWin($r,\%prog_state,
                                                        'last student');
           }
           $started=1;
           my $scan_record=
               &Apache::grades::scantron_parse_scanline($line,$i,\%scantron_config,
                                                        $scan_data);
           unless ($uname=&Apache::grades::scantron_find_student($scan_record,$scan_data,
                                                                 \%idmap,$i)) {
               &Apache::grades::scantron_add_delay(\@delayqueue,$line,
                                   'Unable to find a student that matches',1);
               next;
           }
           if (exists $completedstudents{$uname}) {
               &Apache::grades::scantron_add_delay(\@delayqueue,$line,
                                   'Student '.$uname.' has multiple sheets',2);
               next;
           }
           my $pid = $scan_record->{'scantron.ID'};
           $lastname{$pid} = $scan_record->{'scantron.LastName'};
           push(@{$bylast{$lastname{$pid}}},$pid);
           my $lastpos = $env{'form.scantron_maxbubble'}*$scantron_config{'Qlength'};
           $scandata{$pid} = substr($line,$scantron_config{'Qstart'}-1,$lastpos);
           chomp($scandata{$pid});
           $scandata{$pid} =~ s/\r$//;
           ($username,$domain)=split(/:/,$uname);
           my $counter = -1;
           my (%expected,%startpos);
           foreach my $resource (@resources) {
               next if (!$resource->is_problem());
               my $symb = $resource->symb();
               my $partsref = $resource->parts();
               my @parts;
               my @part_ids = ();
               if (ref($partsref) eq 'ARRAY') {
                  @parts = @{$partsref};
                  foreach my $part (@parts) {
                      my @resp_ids = $resource->responseIds($part);
                      foreach my $resp (@resp_ids) {
                          $counter ++;
                          my $part_id = $part.'.'.$resp;
                          $expected{$part_id} = 0;
                          push(@part_ids,$part_id);
                          if ($env{"form.scantron.sub_bubblelines.$counter"}) {
                              my @sub_lines = split(/,/,$env{"form.scantron.sub_bubblelines.$counter"});
                              foreach my $item (@sub_lines) {
                                  $expected{$part_id} += $item;
                              }
                          } else {
                              $expected{$part_id} = $env{"form.scantron.bubblelines.$counter"};
                          }
                          $startpos{$part_id} = $env{"form.scantron.first_bubble_line.$counter"};
                      }
                   }
               }
               if ($symb) {
                   my %recorded;
                   my (%returnhash) =
                       &Apache::lonnet::restore($symb,$cid,$domain,$username);
                   if ($returnhash{'version'}) {
                       my %lasthash=();
                       my $version;
                       for ($version=1;$version<=$returnhash{'version'};$version++) {
                           foreach my $key (sort(split(/\:/,$returnhash{$version.':keys'}))) {
                               $lasthash{$key}=$returnhash{$version.':'.$key};
                           }
                       }
                       foreach my $key (keys(%lasthash)) {
                           if ($key =~ /\.scantron$/) {
                               my $value = &unescape($lasthash{$key});
                               my ($part_id) = ($key =~ /^resource\.(.+)\.scantron$/);
                               if ($value eq '') {
                                   for (my $i=0; $i<$expected{$part_id}; $i++) {
                                       for (my $j=0; $j<$scantron_config{'length'}; $j++) {
                                           $recorded{$part_id} .= $;
                                       }
                                   }
                               } else {
                                   my @tocheck;
                                   my @items = split(//,$value);
                                   if (($scantron_config{'Qon'} eq 'letter') ||
                                       ($scantron_config{'Qon'} eq 'number')) {
                                       if (@items < $expected{$part_id}) {
                                           my $fragment = substr($scandata{$pid},$startpos{$part_id},$expected{$part_id});
                                           my @singles = split(//,$fragment);
                                           foreach my $pos (@singles) {
                                               if ($pos eq ' ') {
                                                   push(@tocheck,$pos);
                                               } else {
                                                   my $next = shift(@items);
                                                   push(@tocheck,$next);
                                               }
                                           }
                                       } else {
                                           @tocheck = @items;
                                       }
                                       foreach my $letter (@tocheck) {
                                           if ($scantron_config{'Qon'} eq 'letter') {
                                               if ($letter !~ /^[A-J]$/) {
                                                   $letter = $scantron_config{'Qoff'};
                                               }
                                               $recorded{$part_id} .= $letter;
                                           } elsif ($scantron_config{'Qon'} eq 'number') {
                                               my $digit;
                                               if ($letter !~ /^[A-J]$/) {
                                                   $digit = $scantron_config{'Qoff'};
                                               } else {
                                                   $digit = $lettdig{$letter};
                                               }
                                               $recorded{$part_id} .= $digit;
                                           }
                                       }
                                   } else {
                                       @tocheck = @items;
                                       for (my $i=0; $i<$expected{$part_id}; $i++) {
                                           my $curr_sub = shift(@tocheck);
                                           my $digit;
                                           if ($curr_sub =~ /^[A-J]$/) {
                                               $digit = $lettdig{$curr_sub}-1;
                                           }
                                           if ($curr_sub eq 'J') {
                                               $digit += scalar($numletts);
                                           }
                                           for (my $j=0; $j<$scantron_config{'Qlength'}; $j++) {
                                               if ($j == $digit) {
                                                   $recorded{$part_id} .= $scantron_config{'Qon'};
                                               } else {
                                                   $recorded{$part_id} .= $scantron_config{'Qoff'};
                                               }
                                           }
                                       }
                                   }
                               }
                           }
                       }
                   }
                   foreach my $part_id (@part_ids) {
                       if ($recorded{$part_id} eq '') {
                           for (my $i=0; $i<$expected{$part_id}; $i++) {
                               for (my $j=0; $j<$scantron_config{'Qlength'}; $j++) {
                                   $recorded{$part_id} .= $scantron_config{'Qoff'};
                               }
                           }
                       }
                       $record{$pid} .= $recorded{$part_id};
                   }
               }
           }
       }
       &Apache::lonhtmlcommon::Close_PrgWin($r,\%prog_state);
       $r->print('<br />');
       my ($okstudents,$badstudents,$numstudents,$passed,$failed);
       $passed = 0;
       $failed = 0;
       $numstudents = 0;
       foreach my $last (sort(keys(%bylast))) {
           if (ref($bylast{$last}) eq 'ARRAY') {
               foreach my $pid (sort(@{$bylast{$last}})) {
                   my $showscandata = $scandata{$pid};
                   my $showrecord = $record{$pid};
                   $showscandata =~ s/\s/&nbsp;/g;
                   $showrecord =~ s/\s/&nbsp;/g;
                   if ($scandata{$pid} eq $record{$pid}) {
                       my $css_class = ($passed % 2)?'LC_odd_row':'LC_even_row';
                       $okstudents .= '<tr class="'.$css_class.'">'.
   '<td>'.&mt('Scantron').'</td><td>'.$showscandata.'</td><td rowspan="2">'.$last.'</td><td rowspan="2">'.$pid.'</td>'."\n".
   '</tr>'."\n".
   '<tr class="'.$css_class.'">'."\n".
   '<td>Submissions</td><td>'.$showrecord.'</td></tr>'."\n";
                       $passed ++;
                   } else {
                       my $css_class = ($failed % 2)?'LC_odd_row':'LC_even_row';
                       $badstudents .= '<tr class="'.$css_class.'"><td>'.&mt('Scantron').'</td><td><span class="LC_nobreak">'.$scandata{$pid}.'</span></td><td rowspan="2">'.$last.'</td><td rowspan="2">'.$pid.'</td>'."\n".
   '</tr>'."\n".
   '<tr class="'.$css_class.'">'."\n".
   '<td>Submissions</td><td><span class="LC_nobreak">'.$record{$pid}.'</span></td>'."\n".
   '</tr>'."\n";
                       $failed ++;
                   }
                   $numstudents ++;
               }
           }
       }
       $r->print('<p>'.&mt('Comparison of scantron data (including corrections) with corresponding submission records (most recent submission) for <b>[quant,_1,student]</b>  ([_2] scantron lines/student).',$numstudents,$env{'form.scantron_maxbubble'}).'</p>');
       $r->print('<p>'.&mt('Exact matches for <b>[quant,_1,student]</b>.',$passed).'<br />'.&mt('Discrepancies detected for <b>[quant,_1,student]</b>.',$failed).'</p>');
       if ($passed) {
           $r->print(&mt('Students with exact correspondence between scantron data and submissions are as follows:').'<br /><br />');
           $r->print(&Apache::loncommon::start_data_table()."\n".
                    &Apache::loncommon::start_data_table_header_row()."\n".
                    '<th>'.&mt('Source').'</th><th>'.&mt('Bubble records').'</th><th>'.&mt('Name').'</th><th>'.&mt('ID').'</th>'.
                    &Apache::loncommon::end_data_table_header_row()."\n".
                    $okstudents."\n".
                    &Apache::loncommon::end_data_table().'<br />');
       }
       if ($failed) {
           $r->print(&mt('Students with differences between scantron data and submissions are as follows:').'<br /><br />');
           $r->print(&Apache::loncommon::start_data_table()."\n".
                    &Apache::loncommon::start_data_table_header_row()."\n".
                    '<th>'.&mt('Source').'</th><th>'.&mt('Bubble records').'</th><th>'.&mt('Name').'</th><th>'.&mt('ID').'</th>'.
                    &Apache::loncommon::end_data_table_header_row()."\n".
                    $badstudents."\n".
                    &Apache::loncommon::end_data_table()).'<br />'.
                    &mt('Differences can occur if submissions were modified using manual grading after a scantron grading pass.').'<br />'.&mt('If unexpected discrepancies were detected, it is recommended that you inspect the original scantron sheets.');  
       }
       $r->print('</form><br />'.$grading_menu_button);
       return;
   }
   
 =cut  
   
 #-------- end of section for handling grading scantron forms -------  #-------- end of section for handling grading scantron forms -------
 #  #
Line 7861  sub grading_menu { Line 8004  sub grading_menu {
                  });                   });
     $fields{'command'} = 'csvform';      $fields{'command'} = 'csvform';
     $url = &Apache::lonhtmlcommon::build_url('grades/',\%fields);      $url = &Apache::lonhtmlcommon::build_url('grades/',\%fields);
     push (@menu, { url => $url,      push(@menu, { url => $url,
                    name => &mt('Upload Scores'),                     name => &mt('Upload Scores'),
                    short_description =>                      short_description => 
             &mt('Specify a file containing the class scores for current resource.')});              &mt('Specify a file containing the class scores for current resource.')});
     $fields{'command'} = 'processclicker';      $fields{'command'} = 'processclicker';
     $url = &Apache::lonhtmlcommon::build_url('grades/',\%fields);      $url = &Apache::lonhtmlcommon::build_url('grades/',\%fields);
     push (@menu, { url => $url,      push(@menu, { url => $url,
                    name => &mt('Process Clicker'),                     name => &mt('Process Clicker'),
                    short_description =>                      short_description => 
             &mt('Specify a file containing the clicker information for this resource.')});              &mt('Specify a file containing the clicker information for this resource.')});
     $fields{'command'} = 'scantron_selectphase';      $fields{'command'} = 'scantron_selectphase';
     $url = &Apache::lonhtmlcommon::build_url('grades/',\%fields);      $url = &Apache::lonhtmlcommon::build_url('grades/',\%fields);
     push (@menu, { url => $url,      push(@menu, { url => $url,
                    name => &mt('Grade/Manage Scantron Forms'),                     name => &mt('Grade/Manage/Review Scantron Forms'),
                    short_description =>                      short_description => 
             &mt('')});              &mt('Grade scantron exams, upload/download scantron data files, and review previously graded scantron exams.')});
     $fields{'command'} = 'verify';      $fields{'command'} = 'verify';
     $url = &Apache::lonhtmlcommon::build_url('grades/',\%fields);      $url = &Apache::lonhtmlcommon::build_url('grades/',\%fields);
     push (@menu, { url => "",      push(@menu, { url => "",
                    name => &mt('Verify Receipt'),                     name => &mt('Verify Receipt'),
                    short_description =>                      short_description => 
             &mt('')});              &mt('')});
Line 8009  GRADINGMENUJS Line 8152  GRADINGMENUJS
     my $saveSub = ($$savedState{'saveSub'} eq '' ? 'all' : $$savedState{'saveSub'});      my $saveSub = ($$savedState{'saveSub'} eq '' ? 'all' : $$savedState{'saveSub'});
     my $saveStatus = ($$savedState{'saveStatus'} eq '' ? 'Active' : $$savedState{'saveStatus'});      my $saveStatus = ($$savedState{'saveStatus'} eq '' ? 'Active' : $$savedState{'saveStatus'});
   
       # Preselect sections
       my $selsec="";
       if (ref($sections)) {
           foreach my $section (sort(@$sections)) {
               $selsec.='<option value="'.$section.'" '.
                   ($saveSec eq $section ? 'selected="selected"':'').'>'.$section.'</option>'."\n";
           }
       }
   
     $result.='<form action="/adm/grades" method="post" name="gradingMenu">'."\n".      $result.='<form action="/adm/grades" method="post" name="gradingMenu">'."\n".
  '<input type="hidden" name="symb"        value="'.&Apache::lonenc::check_encrypt($symb).'" />'."\n".   '<input type="hidden" name="symb"        value="'.&Apache::lonenc::check_encrypt($symb).'" />'."\n".
  '<input type="hidden" name="handgrade"   value="'.$hdgrade.'" />'."\n".   '<input type="hidden" name="handgrade"   value="'.$hdgrade.'" />'."\n".
Line 8019  GRADINGMENUJS Line 8171  GRADINGMENUJS
  '<input type="hidden" name="showgrading" value="yes" />'."\n";   '<input type="hidden" name="showgrading" value="yes" />'."\n";
   
     $result.='      $result.='
     <div class="LC_grade_select_mode">  <h2>
       <div class="LC_grade_select_mode_current">    '.&mt('Grade Current Resource').'
         <h2>  </h2>
           '.&mt('Grade Current Resource').'  <div>
         </h2>    '.$table.'
         <div class="LC_grade_select_mode_body">  </div>
           <div class="LC_grades_resource_info">  
            '.$table.'  <div class="columnSection">
           </div>    <div>
           <div class="LC_grade_select_mode_selector">      <fieldset>
              <div class="LC_grade_select_mode_selector_header">        <legend>
                 '.&mt('Sections').'         '.&mt('Sections').'
              </div>        </legend>
              <div class="LC_grade_select_mode_selector_body">        <select name="section" multiple="multiple" size="5">'."\n";
        <select name="section" multiple="multiple" size="5">'."\n";      $result.= $selsec;
     if (ref($sections)) {  
  foreach my $section (sort (@$sections)) {  
     $result.='<option value="'.$section.'" '.  
  ($saveSec eq $section ? 'selected="selected"':'').'>'.$section.'</option>'."\n";  
  }  
     }  
     $result.= '<option value="all" '.($saveSec eq 'all' ? 'selected="selected"' : ''). '>all</option></select> &nbsp; ';      $result.= '<option value="all" '.($saveSec eq 'all' ? 'selected="selected"' : ''). '>all</option></select> &nbsp; ';
     $result.='      $result.='
              </div>      </fieldset>
           </div>    </div>
           <div class="LC_grade_select_mode_selector">  
              <div class="LC_grade_select_mode_selector_header">    <div>
                 '.&mt('Groups').'      <fieldset>
              </div>        <legend>
              <div class="LC_grade_select_mode_selector_body">          '.&mt('Groups').'
                 '.&Apache::lonstatistics::GroupSelect('group','multiple',5).'        </legend>
              </div>        '.&Apache::lonstatistics::GroupSelect('group','multiple',5).'
           </div>      </fieldset>
           <div class="LC_grade_select_mode_selector">    </div>
              <div class="LC_grade_select_mode_selector_header">  
                 '.&mt('Access Status').'    <div>
              </div>      <fieldset>
              <div class="LC_grade_select_mode_selector_body">        <legend>
                 '.&Apache::lonhtmlcommon::StatusOptions($saveStatus,undef,5,undef,'mult').'          '.&mt('Access Status').'
              </div>        </legend>
           </div>        '.&Apache::lonhtmlcommon::StatusOptions($saveStatus,undef,5,undef,'mult').'
           <div class="LC_grade_select_mode_selector">      </fieldset>
              <div class="LC_grade_select_mode_selector_header">    </div>
                 '.&mt('Submission Status').'  
              </div>    <div>
              <div class="LC_grade_select_mode_selector_body">      <fieldset>
                <select name="submitonly" size="5">        <legend>
           '.&mt('Submission Status').'
         </legend>
         <select name="submitonly" size="5">
          <option value="yes" '.      ($saveSub eq 'yes'       ? 'selected="selected"' : '').'>'.&mt('with submissions').'</option>           <option value="yes" '.      ($saveSub eq 'yes'       ? 'selected="selected"' : '').'>'.&mt('with submissions').'</option>
          <option value="queued" '.   ($saveSub eq 'queued'    ? 'selected="selected"' : '').'>'.&mt('in grading queue').'</option>           <option value="queued" '.   ($saveSub eq 'queued'    ? 'selected="selected"' : '').'>'.&mt('in grading queue').'</option>
          <option value="graded" '.   ($saveSub eq 'graded'    ? 'selected="selected"' : '').'>'.&mt('with ungraded submissions').'</option>           <option value="graded" '.   ($saveSub eq 'graded'    ? 'selected="selected"' : '').'>'.&mt('with ungraded submissions').'</option>
          <option value="incorrect" '.($saveSub eq 'incorrect' ? 'selected="selected"' : '').'>'.&mt('with incorrect submissions').'</option>           <option value="incorrect" '.($saveSub eq 'incorrect' ? 'selected="selected"' : '').'>'.&mt('with incorrect submissions').'</option>
                  <option value="all" '.      ($saveSub eq 'all'       ? 'selected="selected"' : '').'>'.&mt('with any status').'</option>                   <option value="all" '.      ($saveSub eq 'all'       ? 'selected="selected"' : '').'>'.&mt('with any status').'</option>
                </select>        </select>
              </div>      </fieldset>
           </div>    </div>
           <div class="LC_grade_select_mode_type_body">  </div>
             <div class="LC_grade_select_mode_type">  
   <br />
             <div>
               <div>
               <label>                <label>
                 <input type="radio" name="radioChoice" value="submission" '.                  <input type="radio" name="radioChoice" value="submission" '.
                   ($saveCmd eq 'submission' ? 'checked="checked"' : '').' /> '.                    ($saveCmd eq 'submission' ? 'checked="checked"' : '').' /> '.
              &mt('Select individual students to grade and view submissions.').'               &mt('Select individual students to grade and view submissions.').'
       </label>         </label> 
             </div>              </div>
             <div class="LC_grade_select_mode_type">              <div>
       <label>        <label>
                 <input type="radio" name="radioChoice" value="viewgrades" '.                  <input type="radio" name="radioChoice" value="viewgrades" '.
                   ($saveCmd eq 'viewgrades' ? 'checked="checked"' : '').' /> '.                    ($saveCmd eq 'viewgrades' ? 'checked="checked"' : '').' /> '.
                     &mt('Grade all selected students in a grading table.').'                      &mt('Grade all selected students in a grading table.').'
               </label>                </label>
             </div>              </div>
             <div class="LC_grade_select_mode_type">              <div>
       <input type="button" onClick="javascript:checkChoice(this.form,\'2\');" value="'.&mt('Next-&gt;').'" />        <input type="button" onClick="javascript:checkChoice(this.form,\'2\');" value="'.&mt('Next-&gt;').'" />
             </div>              </div>
           </div>            </div>
         </div>  
       </div>  
       <div class="LC_grade_select_mode_page">  
         <h2>          <h2>
          '.&mt('Grade Complete Folder for One Student').'           '.&mt('Grade Complete Folder for One Student').'
         </h2>          </h2>
         <div class="LC_grades_select_mode_body">          <div>
           <div class="LC_grade_select_mode_type_body">              <div>
             <div class="LC_grade_select_mode_type">  
               <label>                <label>
                 <input type="radio" name="radioChoice" value="pickStudentPage" '.                  <input type="radio" name="radioChoice" value="pickStudentPage" '.
   ($saveCmd eq 'pickStudentPage' ? 'checked="checked"' : '').' /> '.    ($saveCmd eq 'pickStudentPage' ? 'checked="checked"' : '').' /> '.
   &mt('The <b>complete</b> page/sequence/folder: For one student').'    &mt('The <b>complete</b> page/sequence/folder: For one student').'
               </label>                </label>
             </div>              </div>
             <div class="LC_grade_select_mode_type">              <div>
       <input type="button" onClick="javascript:checkChoice(this.form,\'2\');" value="'.&mt('Next-&gt;').'" />        <input type="button" onClick="javascript:checkChoice(this.form,\'2\');" value="'.&mt('Next-&gt;').'" />
             </div>              </div>
           </div>  
         </div>          </div>
       </div>  
     </div>  
   </form>';    </form>';
     $result .= &show_grading_menu_form($symb);      $result .= &show_grading_menu_form($symb);
     return $result;      return $result;
Line 8539  sub interwrite_eval { Line 8686  sub interwrite_eval {
         $id=~s/[\-\:]//g;          $id=~s/[\-\:]//g;
         $idresponses{$id}[$number]=$entries[6];          $idresponses{$id}[$number]=$entries[6];
     }      }
     foreach my $id (keys %idresponses) {      foreach my $id (keys(%idresponses)) {
        $$responses{$id}=join(',',@{$idresponses{$id}});         $$responses{$id}=join(',',@{$idresponses{$id}});
        $$responses{$id}=~s/^\s*\,//;         $$responses{$id}=~s/^\s*\,//;
     }      }
Line 8675  sub handler { Line 8822  sub handler {
     }      }
   
     $ssi_error = 0;      $ssi_error = 0;
     $request->print(&Apache::loncommon::start_page('Grading'));      my $brcrum = [{href=>"/adm/grades",text=>"Grading"}];
       $request->print(&Apache::loncommon::start_page('Grading',undef,
                                             {'bread_crumbs' => $brcrum}));
     if ($symb eq '' && $command eq '') {      if ($symb eq '' && $command eq '') {
  if ($env{'user.adv'}) {   if ($env{'user.adv'}) {
     if (($env{'form.codeone'}) && ($env{'form.codetwo'}) &&      if (($env{'form.codeone'}) && ($env{'form.codetwo'}) &&
Line 8770  sub handler { Line 8919  sub handler {
   } elsif ($command eq 'scantron_download' &&    } elsif ($command eq 'scantron_download' &&
  &Apache::lonnet::allowed('usc',$env{'request.course.id'})) {   &Apache::lonnet::allowed('usc',$env{'request.course.id'})) {
      $request->print(&scantron_download_scantron_data($request));       $request->print(&scantron_download_scantron_data($request));
           } elsif ($command eq 'checksubmissions' && $perm{'vgr'}) {
               $request->print(&checkscantron_results($request));     
  } elsif ($command) {   } elsif ($command) {
     $request->print("Access Denied ($command)");      $request->print("Access Denied ($command)");
  }   }
Line 8785  sub handler { Line 8936  sub handler {
 1;  1;
   
 __END__;  __END__;
   
   
   =head1 NAME
   
   Apache::grades
   
   =head1 SYNOPSIS
   
   Handles the viewing of grades.
   
   This is part of the LearningOnline Network with CAPA project
   described at http://www.lon-capa.org.
   
   =head1 OVERVIEW
   
   Do an ssi with retries:
   While I'd love to factor out this with the vesrion in lonprintout,
   that would either require a data coupling between modules, which I refuse to perpetuate (there's quite enough of that already), or would require the invention of another infrastructure
   I'm not quite ready to invent (e.g. an ssi_with_retry object).
   
   At least the logic that drives this has been pulled out into loncommon.
   
   
   
   ssi_with_retries - Does the server side include of a resource.
                        if the ssi call returns an error we'll retry it up to
                        the number of times requested by the caller.
                        If we still have a proble, no text is appended to the
                        output and we set some global variables.
                        to indicate to the caller an SSI error occurred.  
                        All of this is supposed to deal with the issues described
                        in LonCAPA BZ 5631 see:
                        http://bugs.lon-capa.org/show_bug.cgi?id=5631
                        by informing the user that this happened.
   
   Parameters:
     resource   - The resource to include.  This is passed directly, without
                  interpretation to lonnet::ssi.
     form       - The form hash parameters that guide the interpretation of the resource
                  
     retries    - Number of retries allowed before giving up completely.
   Returns:
     On success, returns the rendered resource identified by the resource parameter.
   Side Effects:
     The following global variables can be set:
      ssi_error                - If an unrecoverable error occurred this becomes true.
                                 It is up to the caller to initialize this to false
                                 if desired.
      ssi_error_resource  - If an unrecoverable error occurred, this is the value
                                 of the resource that could not be rendered by the ssi
                                 call.
      ssi_error_message   - The error string fetched from the ssi response
                                 in the event of an error.
   
   
   =head1 HANDLER SUBROUTINE
   
   ssi_with_retries()
   
   =head1 SUBROUTINES
   
   =over
   
   =item scantron_get_correction() : 
   
      Builds the interface screen to interact with the operator to fix a
      specific error condition in a specific scanline
   
    Arguments:
       $r           - Apache request object
       $i           - number of the current scanline
       $scan_record - hash ref as returned from &scantron_parse_scanline()
       $scan_config - hash ref as returned from &get_scantron_config()
       $line        - full contents of the current scanline
       $error       - error condition, valid values are
                      'incorrectCODE', 'duplicateCODE',
                      'doublebubble', 'missingbubble',
                      'duplicateID', 'incorrectID'
       $arg         - extra information needed
          For errors:
            - duplicateID   - paper number that this studentID was seen before on
            - duplicateCODE - array ref of the paper numbers this CODE was
                              seen on before
            - incorrectCODE - current incorrect CODE 
            - doublebubble  - array ref of the bubble lines that have double
                              bubble errors
            - missingbubble - array ref of the bubble lines that have missing
                              bubble errors
   
   =item  scantron_get_maxbubble() : 
   
      Returns the maximum number of bubble lines that are expected to
      occur. Does this by walking the selected sequence rendering the
      resource and then checking &Apache::lonxml::get_problem_counter()
      for what the current value of the problem counter is.
   
      Caches the results to $env{'form.scantron_maxbubble'},
      $env{'form.scantron.bubble_lines.n'}, 
      $env{'form.scantron.first_bubble_line.n'} and
      $env{"form.scantron.sub_bubblelines.n"}
      which are the total number of bubble, lines, the number of bubble
      lines for response n and number of the first bubble line for response n,
      and a comma separated list of numbers of bubble lines for sub-questions
      (for optionresponse, matchresponse, and rankresponse items), for response n.  
   
   
   =item  scantron_validate_missingbubbles() : 
   
      Validates all scanlines in the selected file to not have any
       answers that don't have bubbles that have not been verified
       to be bubble free.
   
   =item  scantron_process_students() : 
   
      Routine that does the actual grading of the bubble sheet information.
   
      The parsed scanline hash is added to %env 
   
      Then foreach unskipped scanline it does an &Apache::lonnet::ssi()
      foreach resource , with the form data of
   
    'submitted'     =>'scantron' 
    'grade_target'  =>'grade',
    'grade_username'=> username of student
    'grade_domain'  => domain of student
    'grade_courseid'=> of course
    'grade_symb'    => symb of resource to grade
   
       This triggers a grading pass. The problem grading code takes care
       of converting the bubbled letter information (now in %env) into a
       valid submission.
   
   =item  scantron_upload_scantron_data() :
   
       Creates the screen for adding a new bubble sheet data file to a course.
   
   =item  scantron_upload_scantron_data_save() : 
   
      Adds a provided bubble information data file to the course if user
      has the correct privileges to do so. 
   
   =item  valid_file() :
   
      Validates that the requested bubble data file exists in the course.
   
   =item  scantron_download_scantron_data() : 
   
      Shows a list of the three internal files (original, corrected,
      skipped) for a specific bubble sheet data file that exists in the
      course.
   
   =item  scantron_validate_ID() : 
   
      Validates all scanlines in the selected file to not have any
      invalid or underspecified student IDs
   
   =back
   
   =cut
Removed from v.1.522  
changed lines
  Added in v.1.536

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