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

Diff for /loncom/homework/grades.pm between versions 1.539 and 1.559

version 1.539, 2008/12/21 22:01:35 version 1.559, 2009/03/19 19:09:47
Line 234  sub reset_caches { Line 234  sub reset_caches {
   
 {  {
     my %analyze_cache;      my %analyze_cache;
       my %analyze_cache_formkeys;
   
     sub reset_analyze_cache {      sub reset_analyze_cache {
  undef(%analyze_cache);   undef(%analyze_cache);
           undef(%analyze_cache_formkeys);
     }      }
   
     sub get_analyze {      sub get_analyze {
  my ($symb,$uname,$udom,$no_increment)=@_;   my ($symb,$uname,$udom,$no_increment,$add_to_hash)=@_;
  my $key = "$symb\0$uname\0$udom";   my $key = "$symb\0$uname\0$udom";
  return $analyze_cache{$key} if (exists($analyze_cache{$key}));   if (exists($analyze_cache{$key})) {
               my $getupdate = 0;
               if (ref($add_to_hash) eq 'HASH') {
                   foreach my $item (keys(%{$add_to_hash})) {
                       if (ref($analyze_cache_formkeys{$key}) eq 'HASH') {
                           if (!exists($analyze_cache_formkeys{$key}{$item})) {
                               $getupdate = 1;
                               last;
                           }
                       } else {
                           $getupdate = 1;
                       }
                   }
               }
               if (!$getupdate) {
                   return $analyze_cache{$key};
               }
           }
   
  my (undef,undef,$url)=&Apache::lonnet::decode_symb($symb);   my (undef,undef,$url)=&Apache::lonnet::decode_symb($symb);
  $url=&Apache::lonnet::clutter($url);   $url=&Apache::lonnet::clutter($url);
  my $subresult=&ssi_with_retries($url, $ssi_retries,          my %form = ('grade_target'      => 'analyze',
    ('grade_target' => 'analyze',                      'grade_domain'      => $udom,
     'grade_domain' => $udom,                      'grade_symb'        => $symb,
     'grade_symb' => $symb,                      'grade_courseid'    =>  $env{'request.course.id'},
     'grade_courseid' =>                       'grade_username'    => $uname,
     $env{'request.course.id'},                      'grade_noincrement' => $no_increment);
     'grade_username' => $uname,          if (ref($add_to_hash)) {
                                             'grade_noincrement' => $no_increment));              %form = (%form,%{$add_to_hash});
           } 
    my $subresult=&ssi_with_retries($url, $ssi_retries,%form);
  (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);
           if (ref($add_to_hash) eq 'HASH') {
               $analyze_cache_formkeys{$key} = $add_to_hash;
           } else {
               $analyze_cache_formkeys{$key} = {};
           }
  return $analyze_cache{$key} = \%analyze;   return $analyze_cache{$key} = \%analyze;
     }      }
   
Line 268  sub reset_caches { Line 294  sub reset_caches {
     sub get_radiobutton_correct_foil {      sub get_radiobutton_correct_foil {
  my ($partid,$respid,$symb,$uname,$udom)=@_;   my ($partid,$respid,$symb,$uname,$udom)=@_;
  my $analyze = &get_analyze($symb,$uname,$udom);   my $analyze = &get_analyze($symb,$uname,$udom);
  foreach my $foil (@{&get_order($partid,$respid,$symb,$uname,$udom)}) {          my $foils = &get_order($partid,$respid,$symb,$uname,$udom);
     if ($analyze->{"$partid.$respid.foil.value.$foil"} eq 'true') {          if (ref($foils) eq 'ARRAY') {
  return $foil;      foreach my $foil (@{$foils}) {
           if ($analyze->{"$partid.$respid.foil.value.$foil"} eq 'true') {
       return $foil;
           }
     }      }
  }   }
     }      }
   
       sub scantron_partids_tograde {
           my ($resource,$cid,$uname,$udom,$check_for_randomlist) = @_;
           my (%analysis,@parts);
           if (ref($resource)) {
               my $symb = $resource->symb();
               my $add_to_form;
               if ($check_for_randomlist) {
                   $add_to_form = { 'check_parts_withrandomlist' => 1,};
               }
               my $analyze = &get_analyze($symb,$uname,$udom,undef,$add_to_form);
               if (ref($analyze) eq 'HASH') {
                   %analysis = %{$analyze};
               }
               if (ref($analysis{'parts'}) eq 'ARRAY') {
                   foreach my $part (@{$analysis{'parts'}}) {
                       my ($id,$respid) = split(/\./,$part);
                       if (!&Apache::loncommon::check_if_partid_hidden($id,$symb,$udom,$uname)) {
                           push(@parts,$part);
                       }
                   }
               }
           }
           return (\%analysis,\@parts);
       }
   
 }  }
   
 #--- Clean response type for display  #--- Clean response type for display
Line 699  sub verifyreceipt { Line 754  sub verifyreceipt {
   
     my $title.=      my $title.=
  '<h3><span class="LC_info">'.   '<h3><span class="LC_info">'.
  &mt('Verifying Submission Receipt [_1]',$receipt).   &mt('Verifying  Receipt No. [_1]',$receipt).
  '</span></h3>'."\n".   '</span></h3>'."\n".
  '<h4>'.&mt('<b>Resource: </b>[_1]',$env{'form.probTitle'}).   '<h4>'.&mt('<b>Resource: </b>[_1]',$env{'form.probTitle'}).
  '</h4>'."\n";   '</h4>'."\n";
Line 779  sub listStudents { Line 834  sub listStudents {
     my $getsec    = $env{'form.section'} eq '' ? 'all' : $env{'form.section'};      my $getsec    = $env{'form.section'} eq '' ? 'all' : $env{'form.section'};
     my $getgroup  = $env{'form.group'} eq '' ? 'all' : $env{'form.group'};      my $getgroup  = $env{'form.group'} eq '' ? 'all' : $env{'form.group'};
     my $submitonly= $env{'form.submitonly'} eq '' ? 'all' : $env{'form.submitonly'};      my $submitonly= $env{'form.submitonly'} eq '' ? 'all' : $env{'form.submitonly'};
     my $viewgrade = $env{'form.showgrading'} eq 'yes' ? &mt('View/Grade/Regrade') : &mt('View');      my $viewgrade = $env{'form.showgrading'} eq 'yes' ? 'View/Grade/Regrade' : 'View';
     $env{'form.probTitle'} = $env{'form.probTitle'} eq '' ?       $env{'form.probTitle'} = $env{'form.probTitle'} eq '' ? 
  &Apache::lonnet::gettitle($symb) : $env{'form.probTitle'};   &Apache::lonnet::gettitle($symb) : $env{'form.probTitle'};
   
     my $result='<h3><span class="LC_info">&nbsp;'.$viewgrade.      my $result='<h3><span class="LC_info">&nbsp;'
  &mt(' Submissions for a Student or a Group of Students')   .&mt("$viewgrade Submissions for a Student or a Group of Students")
  .'</span></h3>';   .'</span></h3>';
   
     my ($table,undef,$hdgrade,$partlist,$handgrade) = &showResourceInfo($symb,$env{'form.probTitle'},($env{'form.showgrading'} eq 'yes'));      my ($table,undef,$hdgrade,$partlist,$handgrade) = &showResourceInfo($symb,$env{'form.probTitle'},($env{'form.showgrading'} eq 'yes'));
   
     my %lt = ( 'multiple' =>      my %lt = &Apache::lonlocal::texthash (
        &mt("Please select a student or group of students before clicking on the Next button."),   'multiple' => 'Please select a student or group of students before clicking on the Next button.',
        'single'   =>   'single'   => 'Please select the student before clicking on the Next button.',
        &mt("Please select the student before clicking on the Next button."),       );
        );  
     %lt = &Apache::lonlocal::texthash(%lt);  
     $request->print(<<LISTJAVASCRIPT);      $request->print(<<LISTJAVASCRIPT);
 <script type="text/javascript" language="javascript">  <script type="text/javascript" language="javascript">
     function checkSelect(checkBox) {      function checkSelect(checkBox) {
Line 889  LISTJAVASCRIPT Line 942  LISTJAVASCRIPT
  &Apache::lonhtmlcommon::StatusOptions($saveStatus,undef,1,'javascript:reLoadList(this.form);')).'<br />';   &Apache::lonhtmlcommon::StatusOptions($saveStatus,undef,1,'javascript:reLoadList(this.form);')).'<br />';
     }      }
   
     $gradeTable.=&mt('To [_1] a submission or a group of submissions, click on the check box(es) next to the student\'s name(s). Then click on the Next button.',lc($viewgrade)).'<br />'."\n".      $gradeTable.=&mt('To '.lc($viewgrade)." a submission or a group of submissions, click on the check box(es) next to the student's name(s). Then click on the Next button.").'<br />'."\n".
  '<input type="hidden" name="command" value="processGroup" />'."\n";   '<input type="hidden" name="command" value="processGroup" />'."\n";
   
 # checkall buttons  # checkall buttons
Line 1656  sub gradeBox { Line 1709  sub gradeBox {
  $wgt.')" /></td>'."\n";   $wgt.')" /></td>'."\n";
     $line.='<td>/'.$wgt.' '.$wgtmsg.      $line.='<td>/'.$wgt.' '.$wgtmsg.
  ($$record{'resource.'.$partid.'.solved'} eq 'correct_by_student' ? '&nbsp;'.$checkIcon : '').   ($$record{'resource.'.$partid.'.solved'} eq 'correct_by_student' ? '&nbsp;'.$checkIcon : '').
  ' </td><td>'."\n";   ' </td><td><b>'.&mt('Grade Status').':</b>'."\n";
     $line.='<select name="GD_SEL'.$counter.'_'.$partid.'" '.      $line.='<select name="GD_SEL'.$counter.'_'.$partid.'" '.
  'onChange="javascript:clearRadBox(this.form,\''.$counter.'_'.$partid.'\')" >'."\n";   'onChange="javascript:clearRadBox(this.form,\''.$counter.'_'.$partid.'\')" >'."\n";
     if ($$record{'resource.'.$partid.'.solved'} eq 'excused') {      if ($$record{'resource.'.$partid.'.solved'} eq 'excused') {
Line 1669  sub gradeBox { Line 1722  sub gradeBox {
     $line.='<option value="reset status">'.&mt('reset status').'</option></select>'."\n";      $line.='<option value="reset status">'.&mt('reset status').'</option></select>'."\n";
   
   
    #&mt('<td><b>Part:</b></td><td>[_1]</td><td><b>Points:</b></td><td>[_2]</td><td>or</td><td>[_3]</td>',$display_part,$radio,$line);
     $result .=       $result .= 
  &mt('<td><b>Part:</b></td><td>[_1]</td><td><b>Points:</b></td><td>[_2]</td><td>or</td><td>[_3]</td>',$display_part,$radio,$line);      '<td><b>'.&mt('Part').':</b></td><td>'.$display_part.'</td><td><b>'.&mt('Points').':</b></td><td>'.$radio.'</td><td>'.&mt('or').'</td><td>'.$line.'</td>'.
   
           
     $result.='</tr></table>'."\n";      $result.='</tr></table>'."\n";
     $result.='<input type="hidden" name="stores'.$counter.'_'.$partid.'" value="" />'."\n".      $result.='<input type="hidden" name="stores'.$counter.'_'.$partid.'" value="" />'."\n".
Line 2094  KEYWORDS Line 2147  KEYWORDS
     ' )</span>&nbsp; &nbsp;';      ' )</span>&nbsp; &nbsp;';
  my $files=&get_submitted_files($udom,$uname,$partid,$respid,\%record);   my $files=&get_submitted_files($udom,$uname,$partid,$respid,\%record);
  if (@$files) {   if (@$files) {
     $lastsubonly.='<br /><span class="LC_warning">'.&mt('Like all files provided by users, this file may contain virusses').'</span><br />';      $lastsubonly.='<br /><span class="LC_warning">'.&mt('Like all files provided by users, this file may contain viruses').'</span><br />';
     my $file_counter = 0;      my $file_counter = 0;
     foreach my $file (@$files) {      foreach my $file (@$files) {
         $file_counter++;          $file_counter++;
Line 2105  KEYWORDS Line 2158  KEYWORDS
  }   }
  $lastsubonly.='<b>'.&mt('Submitted Answer:').' </b>'.   $lastsubonly.='<b>'.&mt('Submitted Answer:').' </b>'.
     &cleanRecord($subval,$responsetype,$symb,$partid,      &cleanRecord($subval,$responsetype,$symb,$partid,
  $respid,\%record,$order);   $respid,\%record,$order,undef,$uname,$udom);
  if ($similar) {$lastsubonly.="<br /><br />$similar\n";}   if ($similar) {$lastsubonly.="<br /><br />$similar\n";}
  $lastsubonly.='</div>';   $lastsubonly.='</div>';
     }      }
Line 2234  KEYWORDS Line 2287  KEYWORDS
     '<option>7</option><option>10</option></select>'."\n";      '<option>7</option><option>10</option></select>'."\n";
  my $nsel = ($env{'form.NTSTU'} ne '' ? $env{'form.NTSTU'} : '1');   my $nsel = ($env{'form.NTSTU'} ne '' ? $env{'form.NTSTU'} : '1');
  $ntstu =~ s/<option>$nsel</<option selected="selected">$nsel</;   $ntstu =~ s/<option>$nsel</<option selected="selected">$nsel</;
  $endform.=&mt('[_1]student(s)',$ntstu);   $endform.=&mt('[quant,_1,student]',$ntstu);
  $endform.='&nbsp;&nbsp;<input type="button" value="'.&mt('Previous').'" '.   $endform.='&nbsp;&nbsp;<input type="button" value="'.&mt('Previous').'" '.
     'onClick="javascript:checksubmit(this.form,\'Previous\');" target="_self" /> &nbsp;'."\n".      'onClick="javascript:checksubmit(this.form,\'Previous\');" target="_self" /> &nbsp;'."\n".
     '<input type="button" value="'.&mt('Next').'" '.      '<input type="button" value="'.&mt('Next').'" '.
Line 2317  sub get_last_submission { Line 2370  sub get_last_submission {
  $$returnhash{$version.':keys'}))) {   $$returnhash{$version.':keys'}))) {
  $lasthash{$key}=$$returnhash{$version.':'.$key};   $lasthash{$key}=$$returnhash{$version.':'.$key};
  $timestamp =    $timestamp = 
     scalar(localtime($$returnhash{$version.':timestamp'}));      &Apache::lonlocal::locallocaltime($$returnhash{$version.':timestamp'});
     }      }
  }   }
  foreach my $key (keys(%lasthash)) {   foreach my $key (keys(%lasthash)) {
Line 3230  sub viewgrades { Line 3283  sub viewgrades {
  $line.='<input type="hidden" name="weight_'.   $line.='<input type="hidden" name="weight_'.
     $partid.'" value="'.$weight{$partid}.'" />'."\n";      $partid.'" value="'.$weight{$partid}.'" />'."\n";
   
     #&mt('<td><b>Part:</b></td><td>[_1]</td><td><b>Points:</b></td><td>[_2]</td><td>or</td><td>[_3]</td>',$display_part,$radio,$line).  
  $result.=   $result.=
     &Apache::loncommon::start_data_table_row()."\n".      &Apache::loncommon::start_data_table_row()."\n".
     '<td><b>'.&mt('Part').':</b></td><td>'.$display_part.'</td><td><b>'.&mt('Points').':</b></td><td>'.$radio.'</td><td>'.&mt('or').'</td><td>'.$line.'</td>'.      '<td><b>'.&mt('Part').':</b></td><td>'.$display_part.'</td><td><b>'.&mt('Points').':</b></td><td>'.$radio.'</td><td>'.&mt('or').'</td><td>'.$line.'</td>'.
Line 3427  sub editgrades { Line 3479  sub editgrades {
     if ($part !~ m/^\Q$partid\E/) { next;}      if ($part !~ m/^\Q$partid\E/) { next;}
     if ($type eq 'awarded' || $type eq 'solved') { next; }      if ($type eq 'awarded' || $type eq 'solved') { next; }
     my $display=&Apache::lonnet::metadata($url,$stores.'.display');      my $display=&Apache::lonnet::metadata($url,$stores.'.display');
     $display =~ s/\[Part: (\w)+\]//;      $display =~ s/\[Part: \Q$part\E\]//;
             my $narrowtext = &mt('Tries');              my $narrowtext = &mt('Tries');
     $display =~ s/Number of Attempts/$narrowtext/;      $display =~ s/Number of Attempts/$narrowtext/;
     $header .= '<th align="center">'.&mt('Old').' '.$display.'</th>'.      $header .= '<th align="center">'.&mt('Old').' '.$display.'</th>'.
Line 3743  ENDPICK Line 3795  ENDPICK
 sub csvupload_fields {  sub csvupload_fields {
     my ($symb) = @_;      my ($symb) = @_;
     my (@parts) = &getpartlist($symb);      my (@parts) = &getpartlist($symb);
     my @fields=(['ID','Student ID'],      my @fields=(['ID','Student/Employee ID'],
  ['username','Student Username'],   ['username','Student Username'],
  ['domain','Student Domain']);   ['domain','Student Domain']);
     my (undef,undef,$url) = &Apache::lonnet::decode_symb($symb);      my (undef,undef,$url) = &Apache::lonnet::decode_symb($symb);
Line 4656  Next each scanline is checked for any er Line 4708  Next each scanline is checked for any er
 bubbles' (it's an error because it may have been mis-scanned  bubbles' (it's an error because it may have been mis-scanned
 because too light bubbling), 'double bubble' (each bubble line should  because too light bubbling), 'double bubble' (each bubble line should
 have no more that one letter picked), invalid or duplicated CODE,  have no more that one letter picked), invalid or duplicated CODE,
 invalid student ID  invalid student/employee ID
   
 If the CODE option is used that determines the randomization of the  If the CODE option is used that determines the randomization of the
 homework problems, either way the student ID is looked up into a  homework problems, either way the student/employee ID is looked up into a
 username:domain.  username:domain.
   
 During the validation phase the instructor can choose to skip scanlines.   During the validation phase the instructor can choose to skip scanlines. 
Line 4729  sub getSequenceDropDown { Line 4781  sub getSequenceDropDown {
 }  }
   
 my %bubble_lines_per_response;     # no. bubble lines for each response.  my %bubble_lines_per_response;     # no. bubble lines for each response.
                                    # index is "symb.part_id"                                     # key is zero-based index - 0, 1, 2 ...
   
 my %first_bubble_line;             # First bubble line no. for each bubble.  my %first_bubble_line;             # First bubble line no. for each bubble.
   
Line 4770  sub restore_bubble_lines { Line 4822  sub restore_bubble_lines {
             $env{"form.scantron.responsetype.$line"};              $env{"form.scantron.responsetype.$line"};
  $line++;   $line++;
     }      }
   
 }  }
   
 #  Given the parsed scanline, get the response for   #  Given the parsed scanline, get the response for 
Line 4779  sub restore_bubble_lines { Line 4830  sub restore_bubble_lines {
 sub get_response_bubbles {  sub get_response_bubbles {
     my ($parsed_line, $response)  = @_;      my ($parsed_line, $response)  = @_;
   
   
     my $bubble_line = $first_bubble_line{$response-1} +1;      my $bubble_line = $first_bubble_line{$response-1} +1;
     my $bubble_lines= $bubble_lines_per_response{$response-1};      my $bubble_lines= $bubble_lines_per_response{$response-1};
           
Line 5135  sub scantron_selectphase { Line 5185  sub scantron_selectphase {
               '<td> '.$format_selector.' </td>'."\n".                '<td> '.$format_selector.' </td>'."\n".
               &Apache::loncommon::end_data_table_row()."\n".                &Apache::loncommon::end_data_table_row()."\n".
               &Apache::loncommon::start_data_table_row()."\n".                &Apache::loncommon::start_data_table_row()."\n".
                 '<td> '.&mt('Options').' </td>'."\n".
                 '<td> <label><input type="checkbox" name="scantron_options_hidden" value="ignore_hidden"/> '.&mt('Skip hidden resources').'</label></td>'.
                 &Apache::loncommon::end_data_table_row()."\n".
                 &Apache::loncommon::start_data_table_row()."\n".
               '<td colspan="2">'."\n".                '<td colspan="2">'."\n".
               '<input type="hidden" name="command" value="checksubmissions" />'."\n".                '<input type="hidden" name="command" value="checksubmissions" />'."\n".
               '<input type="submit" value="'.&mt('Review Scantron Data and Submission Records').'" />'."\n".                '<input type="submit" value="'.&mt('Review Scantron Data and Submission Records').'" />'."\n".
Line 5178  sub scantron_selectphase { Line 5232  sub scantron_selectphase {
       CODEstart   - (only matter if a CODE exists) column in the line where        CODEstart   - (only matter if a CODE exists) column in the line where
                      the CODE starts                       the CODE starts
       CODElength  - length of the CODE        CODElength  - length of the CODE
       IDstart     - column where the student ID number starts        IDstart     - column where the student/employee ID number starts
       IDlength    - length of the student ID info        IDlength    - length of the student/employee ID info
       Qstart      - column where the information from the bubbled        Qstart      - column where the information from the bubbled
                     'questions' start                      'questions' start
       Qlength     - number of columns comprising a single bubble line from        Qlength     - number of columns comprising a single bubble line from
Line 5239  sub get_scantron_config { Line 5293  sub get_scantron_config {
   
 =item username_to_idmap  =item username_to_idmap
   
     creates a hash keyed by student id with values of the corresponding      creates a hash keyed by student/employee ID with values of the corresponding
     student username:domain.      student username:domain.
   
   Arguments:    Arguments:
Line 5278  sub username_to_idmap { Line 5332  sub username_to_idmap {
     $whichline         - line number of the passed in scanline      $whichline         - line number of the passed in scanline
     $field             - type of change to process       $field             - type of change to process 
                          (either                            (either 
                           'ID'     -> correct the student ID number                            'ID'     -> correct the student/employee ID number
                           'CODE'   -> correct the CODE                            'CODE'   -> correct the CODE
                           'answer' -> fixup the submitted answers)                            'answer' -> fixup the submitted answers)
           
Line 5452  sub digits_to_letters { Line 5506  sub digits_to_letters {
        CODE_ignore_dup - 1 if the CODE is a duplicated use when unique         CODE_ignore_dup - 1 if the CODE is a duplicated use when unique
                             CODEs were selected, but the usage has been                              CODEs were selected, but the usage has been
                             forced by the operator                              forced by the operator
        ID  - student ID         ID  - student/employee ID
        PaperID - if used, the ID number printed on the sheet when the          PaperID - if used, the ID number printed on the sheet when the 
                  paper was scanned                   paper was scanned
        FirstName - first name from the sheet         FirstName - first name from the sheet
Line 5488  sub scantron_parse_scanline { Line 5542  sub scantron_parse_scanline {
     my ($line,$whichline,$scantron_config,$scan_data,$just_header)=@_;      my ($line,$whichline,$scantron_config,$scan_data,$just_header)=@_;
   
     my %record;      my %record;
     my $questions=substr($line,$$scantron_config{'Qstart'}-1);  # Answers      my $lastpos = $env{'form.scantron_maxbubble'}*$$scantron_config{'Qlength'};
       my $questions=substr($line,$$scantron_config{'Qstart'}-1,$lastpos);  # Answers
     my $data=substr($line,0,$$scantron_config{'Qstart'}-1);     # earlier stuff      my $data=substr($line,0,$$scantron_config{'Qstart'}-1);     # earlier stuff
     if (!($$scantron_config{'CODElocation'} eq 0 ||      if (!($$scantron_config{'CODElocation'} eq 0 ||
   $$scantron_config{'CODElocation'} eq 'none')) {    $$scantron_config{'CODElocation'} eq 'none')) {
Line 6178  sub scantron_validate_file { Line 6233  sub scantron_validate_file {
     }      }
     if (!$stop) {      if (!$stop) {
  my $warning=&scantron_warning_screen('Start Grading');   my $warning=&scantron_warning_screen('Start Grading');
  $r->print(&mt('Validation process complete.').'<br />   $r->print(&mt('Validation process complete.').'<br />'.
 '.$warning.'                    $warning.
 <input type="submit" name="submit" value="'.&mt('Start Grading').'" />                    &mt('Perform verification for each student after storage of submissions?').
 <input type="hidden" name="command" value="scantron_process" />                    '&nbsp;<span class="LC_nobreak"><label>'.
 ');                    '<input type="radio" name="verifyrecord" value="1" />'.&mt('Yes').'</label>'.
                     ('&nbsp;'x3).'<label>'.
                     '<input type="radio" name="verifyrecord" value="0" checked="checked" />'.&mt('No').
                     '</label></span><br />'.
                     &mt('Grading will take longer if you use verification.').'<br />'.
                     &mt("Alternatively, the 'Review scantron data' utility (see grading menu) can be used for all students after grading is complete.").'<br /><br />'.
                     '<input type="submit" name="submit" value="'.&mt('Start Grading').'" />'.
                     '<input type="hidden" name="command" value="scantron_process" />'."\n");
     } else {      } else {
  $r->print('<input type="hidden" name="command" value="scantron_validate" />');   $r->print('<input type="hidden" name="command" value="scantron_validate" />');
  $r->print("<input type='hidden' name='validatepass' value='".$currentphase."' />");   $r->print("<input type='hidden' name='validatepass' value='".$currentphase."' />");
Line 6755  ENDSCRIPT Line 6816  ENDSCRIPT
        ".&mt("[_1]Select[_2] a CODE from the list of all CODEs and use it.",         ".&mt("[_1]Select[_2] a CODE from the list of all CODEs and use it.",
      "<a target='_blank' href='$href'>","</a>")."       "<a target='_blank' href='$href'>","</a>")."
     </label>       </label> 
     ".&mt("Selected CODE is [_1]","<input readonly='true' type='text' size='8' name='scantron_CODE_selectedvalue' onfocus=\"javascript:change_radio('use_found')\" onchange=\"javascript:change_radio('use_found')\" />"));      ".&mt("Selected CODE is [_1]",'<input readonly="readonly" type="text" size="8" name="scantron_CODE_selectedvalue" onfocus="javascript:change_radio(\'use_found\')" onchange="javascript:change_radio(\'use_found\')" />'));
     $r->print("\n<br />");      $r->print("\n<br />");
  }   }
  $r->print("   $r->print("
Line 7229  sub scantron_get_maxbubble { Line 7290  sub scantron_get_maxbubble {
   
     &Apache::lonxml::clear_problem_counter();      &Apache::lonxml::clear_problem_counter();
   
     my $uname       = $env{'form.student'};      my $uname       = $env{'user.name'};
     my $udom        = $env{'form.userdom'};      my $udom        = $env{'user.domain'};
     my $cid         = $env{'request.course.id'};      my $cid         = $env{'request.course.id'};
     my $total_lines = 0;      my $total_lines = 0;
     %bubble_lines_per_response = ();      %bubble_lines_per_response = ();
     %first_bubble_line         = ();      %first_bubble_line         = ();
     %subdivided_bubble_lines   = ();      %subdivided_bubble_lines   = ();
     %responsetype_per_response = ();      %responsetype_per_response = ();
     
     my $response_number = 0;      my $response_number = 0;
     my $bubble_line     = 0;      my $bubble_line     = 0;
     foreach my $resource (@resources) {      foreach my $resource (@resources) {
         my $symb = $resource->symb();          my ($analysis,$parts) = &scantron_partids_tograde($resource,$cid,$uname,$udom);
           if ((ref($analysis) eq 'HASH') && (ref($parts) eq 'ARRAY')) {
         my (@parts,@allparts,@possible_parts);      foreach my $part_id (@{$parts}) {
                   my $lines;
         # Need to retrieve part IDs and response IDs because essayresponse,  
         # reactionresponse and organicresponse items are not included in           # TODO - make this a persistent hash not an array.
         # $analysis{'parts'} from lonnet::ssi.    
         if (ref($resource->parts()) eq 'ARRAY') {                  # optionresponse, matchresponse and rankresponse type items 
             foreach my $part (@{$resource->parts()}) {                  # render as separate sub-questions in exam mode.
                 if (!&Apache::loncommon::check_if_partid_hidden($part,$symb,$udom,$uname)) {                  if (($analysis->{$part_id.'.type'} eq 'optionresponse') ||
                     my @resp_ids = $resource->responseIds($part);                      ($analysis->{$part_id.'.type'} eq 'matchresponse') ||
                     foreach my $id (@resp_ids) {                      ($analysis->{$part_id.'.type'} eq 'rankresponse')) {
                         my $part_id = $part.'.'.$id;                      my ($numbub,$numshown);
                         push(@possible_parts,$part_id);                      if ($analysis->{$part_id.'.type'} eq 'optionresponse') {
                           if (ref($analysis->{$part_id.'.options'}) eq 'ARRAY') {
                               $numbub = scalar(@{$analysis->{$part_id.'.options'}});
                           }
                       } elsif ($analysis->{$part_id.'.type'} eq 'matchresponse') {
                           if (ref($analysis->{$part_id.'.items'}) eq 'ARRAY') {
                               $numbub = scalar(@{$analysis->{$part_id.'.items'}});
                           }
                       } elsif ($analysis->{$part_id.'.type'} eq 'rankresponse') {
                           if (ref($analysis->{$part_id.'.foils'}) eq 'ARRAY') {
                               $numbub = scalar(@{$analysis->{$part_id.'.foils'}});
                           }
                     }                      }
                 }                      if (ref($analysis->{$part_id.'.shown'}) eq 'ARRAY') {
             }                          $numshown = scalar(@{$analysis->{$part_id.'.shown'}});
         }  
   
         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);  
   
         if (ref($analysis{'parts'}) eq 'ARRAY') {  
             foreach my $part (@{$analysis{'parts'}}) {  
                 my ($id,$respid) = split(/\./,$part);  
                 if (!&Apache::loncommon::check_if_partid_hidden($id,$symb,$udom,$uname)) {  
                     push(@parts,$part);  
                 }  
             }  
         }  
         # Add part_ids for any essayresponse, reactionresponse or   
         # organicresponse items.   
         foreach my $part_id (@possible_parts) {  
             if (grep(/^\Q$part_id\E$/,@parts)) {  
                 push(@allparts,$part_id);  
             } else {  
                 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 (@allparts) {  
             my $lines;  
   
     # TODO - make this a persistent hash not an array.  
   
             # optionresponse, matchresponse and rankresponse type items   
             # render as separate sub-questions in exam mode.  
             if (($analysis{$part_id.'.type'} eq 'optionresponse') ||  
                 ($analysis{$part_id.'.type'} eq 'matchresponse') ||  
                 ($analysis{$part_id.'.type'} eq 'rankresponse')) {  
                 my ($numbub,$numshown);  
                 if ($analysis{$part_id.'.type'} eq 'optionresponse') {  
                     if (ref($analysis{$part_id.'.options'}) eq 'ARRAY') {  
                         $numbub = scalar(@{$analysis{$part_id.'.options'}});  
                     }                      }
                 } elsif ($analysis{$part_id.'.type'} eq 'matchresponse') {                      my $bubbles_per_line = 10;
                     if (ref($analysis{$part_id.'.items'}) eq 'ARRAY') {                      my $inner_bubble_lines = int($numbub/$bubbles_per_line);
                         $numbub = scalar(@{$analysis{$part_id.'.items'}});                      if (($numbub % $bubbles_per_line) != 0) {
                           $inner_bubble_lines++;
                     }                      }
                 } elsif ($analysis{$part_id.'.type'} eq 'rankresponse') {                      for (my $i=0; $i<$numshown; $i++) {
                     if (ref($analysis{$part_id.'.foils'}) eq 'ARRAY') {                          $subdivided_bubble_lines{$response_number} .= 
                         $numbub = scalar(@{$analysis{$part_id.'.foils'}});                              $inner_bubble_lines.',';
                     }                      }
                 }                      $subdivided_bubble_lines{$response_number} =~ s/,$//;
                 if (ref($analysis{$part_id.'.shown'}) eq 'ARRAY') {                      $lines = $numshown * $inner_bubble_lines;
                     $numshown = scalar(@{$analysis{$part_id.'.shown'}});                  } else {
                 }                      $lines = $analysis->{"$part_id.bubble_lines"};
                 my $bubbles_per_line = 10;                  } 
                 my $inner_bubble_lines = int($numbub/$bubbles_per_line);  
                 if (($numbub % $bubbles_per_line) != 0) {  
                     $inner_bubble_lines++;  
                 }  
                 for (my $i=0; $i<$numshown; $i++) {  
                     $subdivided_bubble_lines{$response_number} .=   
                         $inner_bubble_lines.',';  
                 }  
                 $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;  
     $bubble_lines_per_response{$response_number} = $lines;  
             $responsetype_per_response{$response_number} =   
                 $analysis{$part_id.'.type'};  
     $response_number++;  
   
     $bubble_line +=  $lines;                  $first_bubble_line{$response_number} = $bubble_line;
     $total_lines +=  $lines;          $bubble_lines_per_response{$response_number} = $lines;
  }                  $responsetype_per_response{$response_number} = 
                       $analysis->{$part_id.'.type'};
           $response_number++;
   
           $bubble_line +=  $lines;
           $total_lines +=  $lines;
       }
           }
     }      }
     &Apache::lonnet::delenv('scantron\.');      &Apache::lonnet::delenv('scantron.');
   
     &save_bubble_lines();      &save_bubble_lines();
     $env{'form.scantron_maxbubble'} =      $env{'form.scantron_maxbubble'} =
Line 7354  sub scantron_get_maxbubble { Line 7365  sub scantron_get_maxbubble {
     return $env{'form.scantron_maxbubble'};      return $env{'form.scantron_maxbubble'};
 }  }
   
   
 sub scantron_validate_missingbubbles {  sub scantron_validate_missingbubbles {
     my ($r,$currentphase) = @_;      my ($r,$currentphase) = @_;
     #get student info      #get student info
Line 7426  sub scantron_process_students { Line 7436  sub scantron_process_students {
     my $navmap=Apache::lonnavmaps::navmap->new();      my $navmap=Apache::lonnavmaps::navmap->new();
     my $map=$navmap->getResourceByUrl($sequence);      my $map=$navmap->getResourceByUrl($sequence);
     my @resources=$navmap->retrieveResources($map,\&scantron_filter,1,0);      my @resources=$navmap->retrieveResources($map,\&scantron_filter,1,0);
 #    $r->print("geto ".scalar(@resources)."<br />");      my (%grader_partids_by_symb,%grader_randomlists_by_symb);
       &graders_resources_pass(\@resources,\%grader_partids_by_symb,
                               \%grader_randomlists_by_symb);
       foreach my $resource (@resources) {
           my $ressymb = $resource->symb();
           my ($analysis,$parts) =
               &scantron_partids_tograde($resource,$env{'request.course.id'},
                                         $env{'user.name'},$env{'user.domain'},1);
           $grader_partids_by_symb{$ressymb} = $parts;
           if (ref($analysis) eq 'HASH') {
               if (ref($analysis->{'parts_withrandomlist'}) eq 'ARRAY') {
                   $grader_randomlists_by_symb{$ressymb} = 
                       $analysis->{'parts_withrandomlist'};
               }
           }
       }
   
       my ($uname,$udom);
     my $result= <<SCANTRONFORM;      my $result= <<SCANTRONFORM;
 <form method="post" enctype="multipart/form-data" action="/adm/grades" name="scantronupload">  <form method="post" enctype="multipart/form-data" action="/adm/grades" name="scantronupload">
   <input type="hidden" name="command" value="scantron_configphase" />    <input type="hidden" name="command" value="scantron_configphase" />
Line 7435  SCANTRONFORM Line 7462  SCANTRONFORM
     $r->print($result);      $r->print($result);
   
     my @delayqueue;      my @delayqueue;
     my %completedstudents;      my (%completedstudents,%scandata);
           
     my $lock=&Apache::lonnet::set_lock(&mt('Grading bubblesheet exam'));      my $lock=&Apache::lonnet::set_lock(&mt('Grading bubblesheet exam'));
     my $count=&get_todo_count($scanlines,$scan_data);      my $count=&get_todo_count($scanlines,$scan_data);
Line 7444  SCANTRONFORM Line 7471  SCANTRONFORM
     'inline',undef,'scantronupload');      'inline',undef,'scantronupload');
     &Apache::lonhtmlcommon::Update_PrgWin($r,\%prog_state,      &Apache::lonhtmlcommon::Update_PrgWin($r,\%prog_state,
   'Processing first student');    'Processing first student');
       $r->print('<br />');
     my $start=&Time::HiRes::time();      my $start=&Time::HiRes::time();
     my $i=-1;      my $i=-1;
     my ($uname,$udom,$started);      my $started;
   
     &scantron_get_maxbubble(); # Need the bubble lines array to parse.      &scantron_get_maxbubble(); # Need the bubble lines array to parse.
       
   
     # If an ssi failed in scantron_get_maxbubble, put an error message out to      # If an ssi failed in scantron_get_maxbubble, put an error message out to
     # the user and return.      # the user and return.
Line 7462  SCANTRONFORM Line 7489  SCANTRONFORM
  return ''; # Dunno why the other returns return '' rather than just returning.   return ''; # Dunno why the other returns return '' rather than just returning.
     }      }
   
       my %lettdig = &letter_to_digits();
       my $numletts = scalar(keys(%lettdig));
   
     while ($i<$scanlines->{'count'}) {      while ($i<$scanlines->{'count'}) {
   ($uname,$udom)=('','');    ($uname,$udom)=('','');
   $i++;    $i++;
Line 7487  SCANTRONFORM Line 7517  SCANTRONFORM
   }    }
   ($uname,$udom)=split(/:/,$uname);    ($uname,$udom)=split(/:/,$uname);
   
           my %partids_by_symb;
           foreach my $resource (@resources) {
               my $ressymb = $resource->symb();
               if ((exists($grader_randomlists_by_symb{$ressymb})) ||
                   (ref($grader_partids_by_symb{$ressymb}) ne 'ARRAY')) {
                   my ($analysis,$parts) =
                       &scantron_partids_tograde($resource,$env{'request.course.id'},$uname,$udom);
                   $partids_by_symb{$ressymb} = $parts;
               } else {
                   $partids_by_symb{$ressymb} = $grader_partids_by_symb{$ressymb};
               }
           }
   
  &Apache::lonxml::clear_problem_counter();   &Apache::lonxml::clear_problem_counter();
   &Apache::lonnet::appenv($scan_record);    &Apache::lonnet::appenv($scan_record);
   
Line 7494  SCANTRONFORM Line 7537  SCANTRONFORM
     &scantron_putfile($scanlines,$scan_data);      &scantron_putfile($scanlines,$scan_data);
  }   }
   
  my $i=0;          my $scancode;
  foreach my $resource (@resources) {          if ((exists($scan_record->{'scantron.CODE'})) &&
     $i++;              (&Apache::lonnet::validCODE($scan_record->{'scantron.CODE'}))) {
     my %form=('submitted'     =>'scantron',              $scancode = $scan_record->{'scantron.CODE'};
       'grade_target'  =>'grade',          } else {
       'grade_username'=>$uname,              $scancode = '';
       'grade_domain'  =>$udom,          }
       'grade_courseid'=>$env{'request.course.id'},  
       'grade_symb'    =>$resource->symb());          if (&grade_student_bubbles($r,$uname,$udom,$scan_record,$scancode,
     if (exists($scan_record->{'scantron.CODE'})                                     \@resources,\%partids_by_symb) eq 'ssi_error') {
  &&               $ssi_error = 0; # So end of handler error message does not trigger.
  &Apache::lonnet::validCODE($scan_record->{'scantron.CODE'})) {              $r->print("</form>");
  $form{'CODE'}=$scan_record->{'scantron.CODE'};              &ssi_print_error($r);
     } else {              $r->print(&show_grading_menu_form($symb));
  $form{'CODE'}='';              &Apache::lonnet::remove_lock($lock);
     }               return '';      # Why return ''?  Beats me.
     my $result=&ssi_with_retries($resource->src(), $ssi_retries, %form);          }
     if ($ssi_error) {  
  $ssi_error = 0; # So end of handler error message does not trigger.  
  $r->print("</form>");  
  &ssi_print_error($r);  
  $r->print(&show_grading_menu_form($symb));  
                 &Apache::lonnet::remove_lock($lock);  
  return ''; # Why return ''?  Beats me.  
     }  
   
     if (&Apache::loncommon::connection_aborted($r)) { last; }  
  }  
  $completedstudents{$uname}={'line'=>$line};   $completedstudents{$uname}={'line'=>$line};
  if (&Apache::loncommon::connection_aborted($r)) { last; }          if ($env{'form.verifyrecord'}) {
               my $lastpos = $env{'form.scantron_maxbubble'}*$scantron_config{'Qlength'};
               my $studentdata = substr($line,$scantron_config{'Qstart'}-1,$lastpos);
               chomp($studentdata);
               $studentdata =~ s/\r$//;
               my $studentrecord = '';
               my $counter = -1;
               foreach my $resource (@resources) {
                   my $ressymb = $resource->symb();
                   ($counter,my $recording) =
                       &verify_scantron_grading($resource,$udom,$uname,$env{'request.course.id'},
                                                $counter,$studentdata,$partids_by_symb{$ressymb},
                                                \%scantron_config,\%lettdig,$numletts);
                   $studentrecord .= $recording;
               }
               if ($studentrecord ne $studentdata) {
                   &Apache::lonxml::clear_problem_counter();
                   if (&grade_student_bubbles($r,$uname,$udom,$scan_record,$scancode,
                                              \@resources,\%partids_by_symb) eq 'ssi_error') {
                       $ssi_error = 0; # So end of handler error message does not trigger.
                       $r->print("</form>");
                       &ssi_print_error($r);
                       $r->print(&show_grading_menu_form($symb));
                       &Apache::lonnet::remove_lock($lock);
                       delete($completedstudents{$uname});
                       return '';
                   }
                   $counter = -1;
                   $studentrecord = '';
                   foreach my $resource (@resources) {
                       my $ressymb = $resource->symb();
                       ($counter,my $recording) =
                           &verify_scantron_grading($resource,$udom,$uname,$env{'request.course.id'},
                                                    $counter,$studentdata,$partids_by_symb{$ressymb},
                                                    \%scantron_config,\%lettdig,$numletts);
                       $studentrecord .= $recording;
                   }
                   if ($studentrecord ne $studentdata) {
                       $r->print('<p><span class="LC_error">');
                       if ($scancode eq '') {
                           $r->print(&mt('Mismatch grading bubble sheet for user: [_1] with ID: [_2].',
                                     $uname.':'.$udom,$scan_record->{'scantron.ID'}));
                       } else {
                           $r->print(&mt('Mismatch grading bubble sheet for user: [_1] with ID: [_2] and CODE: [_3].',
                                     $uname.':'.$udom,$scan_record->{'scantron.ID'},$scancode));
                       }
                       $r->print('</span><br />'.&Apache::loncommon::start_data_table()."\n".
                                 &Apache::loncommon::start_data_table_header_row()."\n".
                                 '<th>'.&mt('Source').'</th><th>'.&mt('Bubbled responses').'</th>'.
                                 &Apache::loncommon::end_data_table_header_row()."\n".
                                 &Apache::loncommon::start_data_table_row().
                                 '<td>'.&mt('Bubble Sheet').'</td>'.
                                 '<td><span class="LC_nobreak">'.$studentdata.'</span></td>'.
                                 &Apache::loncommon::end_data_table_row().
                                 &Apache::loncommon::start_data_table_row().
                                 '<td>Stored submissions</td>'.
                                 '<td><span class="LC_nobreak">'.$studentrecord.'</span></td>'."\n".
                                 &Apache::loncommon::end_data_table_row().
                                 &Apache::loncommon::end_data_table().'</p>');
                   } else {
                       $r->print('<br /><span class="LC_warning">'.
                                &mt('A second grading pass was needed for user: [_1] with ID: [_2], because a mismatch was seen on the first pass.',$uname.':'.$udom,$scan_record->{'scantron.ID'}).'<br />'.
                                &mt("As a consequence, this user's submission history records two tries.").
                                    '</span><br />');
                   }
               }
           }
           if (&Apache::loncommon::connection_aborted($r)) { last; }
     } continue {      } continue {
  &Apache::lonxml::clear_problem_counter();   &Apache::lonxml::clear_problem_counter();
  &Apache::lonnet::delenv('scantron\.');   &Apache::lonnet::delenv('scantron.');
     }      }
     &Apache::lonhtmlcommon::Close_PrgWin($r,\%prog_state);      &Apache::lonhtmlcommon::Close_PrgWin($r,\%prog_state);
     &Apache::lonnet::remove_lock($lock);      &Apache::lonnet::remove_lock($lock);
Line 7538  SCANTRONFORM Line 7638  SCANTRONFORM
     return '';      return '';
 }  }
   
   sub graders_resources_pass {
       my ($resources,$grader_partids_by_symb,$grader_randomlists_by_symb) = @_;
       if ((ref($resources) eq 'ARRAY') && (ref($grader_partids_by_symb)) && 
           (ref($grader_randomlists_by_symb) eq 'HASH')) {
           foreach my $resource (@{$resources}) {
               my $ressymb = $resource->symb();
               my ($analysis,$parts) =
                   &scantron_partids_tograde($resource,$env{'request.course.id'},
                                             $env{'user.name'},$env{'user.domain'},1);
               $grader_partids_by_symb->{$ressymb} = $parts;
               if (ref($analysis) eq 'HASH') {
                   if (ref($analysis->{'parts_withrandomlist'}) eq 'ARRAY') {
                       $grader_randomlists_by_symb->{$ressymb} =
                           $analysis->{'parts_withrandomlist'};
                   }
               }
           }
       }
       return;
   }
   
   sub grade_student_bubbles {
       my ($r,$uname,$udom,$scan_record,$scancode,$resources,$parts) = @_;
       if (ref($resources) eq 'ARRAY') {
           my $count = 0;
           foreach my $resource (@{$resources}) {
               my $ressymb = $resource->symb();
               my %form = ('submitted'      => 'scantron',
                           'grade_target'   => 'grade',
                           'grade_username' => $uname,
                           'grade_domain'   => $udom,
                           'grade_courseid' => $env{'request.course.id'},
                           'grade_symb'     => $ressymb,
                           'CODE'           => $scancode
                          );
               if (ref($parts) eq 'HASH') {
                   if (ref($parts->{$ressymb}) eq 'ARRAY') {
                       foreach my $part (@{$parts->{$ressymb}}) {
                           $form{'scantron_questnum_start.'.$part} =
                               1+$env{'form.scantron.first_bubble_line.'.$count};
                           $count++;
                       }
                   }
               }
               my $result=&ssi_with_retries($resource->src(),$ssi_retries,%form);
               return 'ssi_error' if ($ssi_error);
               last if (&Apache::loncommon::connection_aborted($r));
           }
       }
       return;
   }
   
 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 7692  sub checkscantron_results { Line 7844  sub checkscantron_results {
     if (!$symb) {return '';}      if (!$symb) {return '';}
     my $grading_menu_button=&show_grading_menu_form($symb);      my $grading_menu_button=&show_grading_menu_form($symb);
     my $cid = $env{'request.course.id'};      my $cid = $env{'request.course.id'};
     my %lettdig = (      my %lettdig = &letter_to_digits();
                     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 $numletts = scalar(keys(%lettdig));
     my $cnum = $env{'course.'.$cid.'.num'};      my $cnum = $env{'course.'.$cid.'.num'};
     my $cdom = $env{'course.'.$cid.'.domain'};      my $cdom = $env{'course.'.$cid.'.domain'};
Line 7716  sub checkscantron_results { Line 7857  sub checkscantron_results {
     my %idmap=&Apache::grades::username_to_idmap($classlist);      my %idmap=&Apache::grades::username_to_idmap($classlist);
     my $navmap=Apache::lonnavmaps::navmap->new();      my $navmap=Apache::lonnavmaps::navmap->new();
     my $map=$navmap->getResourceByUrl($sequence);      my $map=$navmap->getResourceByUrl($sequence);
     my @resources=$navmap->retrieveResources($map,undef,1,0);      my @resources=$navmap->retrieveResources($map,\&scantron_filter,1,0);
       my (%grader_partids_by_symb,%grader_randomlists_by_symb);
       &graders_resources_pass(\@resources,\%grader_partids_by_symb,                             \%grader_randomlists_by_symb);
   
       my ($uname,$udom);
     my (%scandata,%lastname,%bylast);      my (%scandata,%lastname,%bylast);
     $r->print('      $r->print('
 <form method="post" enctype="multipart/form-data" action="/adm/grades" name="checkscantron">'."\n");  <form method="post" enctype="multipart/form-data" action="/adm/grades" name="checkscantron">'."\n");
Line 7728  sub checkscantron_results { Line 7873  sub checkscantron_results {
     my %prog_state=&Apache::lonhtmlcommon::Create_PrgWin($r,'Scantron/Submissions Comparison Status',      my %prog_state=&Apache::lonhtmlcommon::Create_PrgWin($r,'Scantron/Submissions Comparison Status',
                                     'Progress of Scantron Data/Submission Records Comparison',$count,                                      'Progress of Scantron Data/Submission Records Comparison',$count,
                                     'inline',undef,'checkscantron');                                      'inline',undef,'checkscantron');
     my ($username,$domain,$uname,$started);      my ($username,$domain,$started);
   
     &Apache::grades::scantron_get_maxbubble();  # Need the bubble lines array to parse.      &scantron_get_maxbubble();  # Need the bubble lines array to parse.
   
     &Apache::lonhtmlcommon::Update_PrgWin($r,\%prog_state,      &Apache::lonhtmlcommon::Update_PrgWin($r,\%prog_state,
                                           'Processing first student');                                            'Processing first student');
Line 7770  sub checkscantron_results { Line 7915  sub checkscantron_results {
         $scandata{$pid} =~ s/\r$//;          $scandata{$pid} =~ s/\r$//;
         ($username,$domain)=split(/:/,$uname);          ($username,$domain)=split(/:/,$uname);
         my $counter = -1;          my $counter = -1;
         my (%expected,%startpos);  
         foreach my $resource (@resources) {          foreach my $resource (@resources) {
             next if (!$resource->is_problem());              my $parts;
             my $symb = $resource->symb();              my $ressymb = $resource->symb();
             my $partsref = $resource->parts();              if ((exists($grader_randomlists_by_symb{$ressymb})) ||
             my @parts;                  (ref($grader_partids_by_symb{$ressymb}) ne 'ARRAY')) {
             my @part_ids = ();                  (my $analysis,$parts) =
             if (ref($partsref) eq 'ARRAY') {                      &scantron_partids_tograde($resource,$env{'request.course.id'},$username,$domain);
                @parts = @{$partsref};              } else {
                foreach my $part (@parts) {                  $parts = $grader_partids_by_symb{$ressymb};
                    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};  
                 }  
             }              }
               ($counter,my $recording) =
                   &verify_scantron_grading($resource,$domain,$username,$cid,$counter,
                                            $scandata{$pid},$parts,
                                            \%scantron_config,\%lettdig,$numletts);
               $record{$pid} .= $recording;
         }          }
     }      }
     &Apache::lonhtmlcommon::Close_PrgWin($r,\%prog_state);      &Apache::lonhtmlcommon::Close_PrgWin($r,\%prog_state);
Line 7951  sub checkscantron_results { Line 7991  sub checkscantron_results {
     return;      return;
 }  }
   
   sub verify_scantron_grading {
       my ($resource,$domain,$username,$cid,$counter,$scandata,$partids,
           $scantron_config,$lettdig,$numletts) = @_;
       my ($record,%expected,%startpos);
       return ($counter,$record) if (!ref($resource));
       return ($counter,$record) if (!$resource->is_problem());
       my $symb = $resource->symb();
       return ($counter,$record) if (ref($partids) ne 'ARRAY');
       foreach my $part_id (@{$partids}) {
           $counter ++;
           $expected{$part_id} = 0;
           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} .= $scantron_config->{'Qoff'};
                               }
                           }
                       } 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,$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 (@{$partids}) {
               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 .= $recorded{$part_id};
           }
       }
       return ($counter,$record);
   }
   
   sub letter_to_digits { 
       my %lettdig = (
                       A => 1,
                       B => 2,
                       C => 3,
                       D => 4,
                       E => 5,
                       F => 6,
                       G => 7,
                       H => 8,
                       I => 9,
                       J => 0,
                     );
       return %lettdig;
   }
   
   
 #-------- end of section for handling grading scantron forms -------  #-------- end of section for handling grading scantron forms -------
 #  #
Line 8796  ENDHEADER Line 8967  ENDHEADER
        }         }
     }      }
 # We are done  # We are done
     $result.='<br />'.&mt('Successfully stored grades for [_1] student(s).',$storecount).      $result.='<br />'.&mt('Successfully stored grades for [quant,_1,student].',$storecount).
              '</td></tr></table>'."\n".               '</td></tr></table>'."\n".
              '</td></tr></table><br /><br />'."\n";               '</td></tr></table><br /><br />'."\n";
     return $result.&show_grading_menu_form($symb);      return $result.&show_grading_menu_form($symb);
Line 9090  ssi_with_retries() Line 9261  ssi_with_retries()
 =item  scantron_validate_ID() :   =item  scantron_validate_ID() : 
   
    Validates all scanlines in the selected file to not have any     Validates all scanlines in the selected file to not have any
    invalid or underspecified student IDs     invalid or underspecified student/employee IDs
   
 =back  =back
   
Removed from v.1.539  
changed lines
  Added in v.1.559

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