Diff for /loncom/homework/grades.pm between versions 1.655 and 1.696

version 1.655, 2011/10/09 15:31:12 version 1.696, 2013/07/19 18:24:20
Line 45  use Apache::lonlocal; Line 45  use Apache::lonlocal;
 use Apache::lonenc;  use Apache::lonenc;
 use Apache::lonstathelpers;  use Apache::lonstathelpers;
 use Apache::lonquickgrades;  use Apache::lonquickgrades;
   use Apache::bridgetask();
 use String::Similarity;  use String::Similarity;
 use LONCAPA;  use LONCAPA;
   
Line 53  use POSIX qw(floor); Line 54  use POSIX qw(floor);
   
   
 my %perm=();  my %perm=();
   my %old_essays=();
   
 #  These variables are used to recover from ssi errors  #  These variables are used to recover from ssi errors
   
Line 201  sub get_display_part { Line 203  sub get_display_part {
 sub reset_caches {  sub reset_caches {
     &reset_analyze_cache();      &reset_analyze_cache();
     &reset_perm();      &reset_perm();
       &reset_old_essays();
 }  }
   
 {  {
Line 340  sub cleanRecord { Line 343  sub cleanRecord {
  return '<blockquote><table border="1">'.   return '<blockquote><table border="1">'.
     '<tr valign="top"><td>'.&mt('Answer').'</td>'.$toprow.'</tr>'.      '<tr valign="top"><td>'.&mt('Answer').'</td>'.$toprow.'</tr>'.
     '<tr valign="top"><td>'.$grayFont.&mt('Option ID').'</span></td>'.      '<tr valign="top"><td>'.$grayFont.&mt('Option ID').'</span></td>'.
     $grayFont.$bottomrow.'</tr>'.'</table></blockquote>';      $bottomrow.'</tr></table></blockquote>';
     } elsif ($response eq 'match') {      } elsif ($response eq 'match') {
  my %answer=&Apache::lonnet::str2hash($answer);   my %answer=&Apache::lonnet::str2hash($answer);
  my %grading=&Apache::lonnet::str2hash($record->{$version."resource.$partid.$respid.submissiongrading"});   my %grading=&Apache::lonnet::str2hash($record->{$version."resource.$partid.$respid.submissiongrading"});
Line 362  sub cleanRecord { Line 365  sub cleanRecord {
     '<tr valign="top"><td>'.$grayFont.&mt('Item ID').'</span></td>'.      '<tr valign="top"><td>'.$grayFont.&mt('Item ID').'</span></td>'.
     $middlerow.'</tr>'.      $middlerow.'</tr>'.
     '<tr valign="top"><td>'.$grayFont.&mt('Option ID').'</span></td>'.      '<tr valign="top"><td>'.$grayFont.&mt('Option ID').'</span></td>'.
     $bottomrow.'</tr>'.'</table></blockquote>';      $bottomrow.'</tr></table></blockquote>';
     } elsif ($response eq 'radiobutton') {      } elsif ($response eq 'radiobutton') {
  my %answer=&Apache::lonnet::str2hash($answer);   my %answer=&Apache::lonnet::str2hash($answer);
  my ($toprow,$bottomrow);   my ($toprow,$bottomrow);
Line 383  sub cleanRecord { Line 386  sub cleanRecord {
  return '<blockquote><table border="1">'.   return '<blockquote><table border="1">'.
     '<tr valign="top"><td>'.&mt('Answer').'</td>'.$toprow.'</tr>'.      '<tr valign="top"><td>'.&mt('Answer').'</td>'.$toprow.'</tr>'.
     '<tr valign="top"><td>'.$grayFont.&mt('Option ID').'</span></td>'.      '<tr valign="top"><td>'.$grayFont.&mt('Option ID').'</span></td>'.
     $bottomrow.'</tr>'.'</table></blockquote>';      $bottomrow.'</tr></table></blockquote>';
     } elsif ($response eq 'essay') {      } elsif ($response eq 'essay') {
  if (! exists ($env{'form.'.$symb})) {   if (! exists ($env{'form.'.$symb})) {
     my (%keyhash) = &Apache::lonnet::dump('nohist_handgrade',      my (%keyhash) = &Apache::lonnet::dump('nohist_handgrade',
Line 680  sub compute_points { Line 683  sub compute_points {
 #  #
   
 sub most_similar {  sub most_similar {
     my ($uname,$udom,$uessay,$old_essays)=@_;      my ($uname,$udom,$symb,$uessay)=@_;
   
       unless ($symb) { return ''; }
   
       unless (ref($old_essays{$symb}) eq 'HASH') { return ''; }
   
 # ignore spaces and punctuation  # ignore spaces and punctuation
   
Line 697  sub most_similar { Line 704  sub most_similar {
     my $scrsid='';      my $scrsid='';
     my $sessay='';      my $sessay='';
 # go through all essays ...  # go through all essays ...
     foreach my $tkey (keys(%$old_essays)) {      foreach my $tkey (keys(%{$old_essays{$symb}})) {
  my ($tname,$tdom,$tcrsid)=map {&unescape($_)} (split(/\./,$tkey));   my ($tname,$tdom,$tcrsid)=map {&unescape($_)} (split(/\./,$tkey));
 # ... except the same student  # ... except the same student
         next if (($tname eq $uname) && ($tdom eq $udom));          next if (($tname eq $uname) && ($tdom eq $udom));
  my $tessay=$old_essays->{$tkey};   my $tessay=$old_essays{$symb}{$tkey};
  $tessay=~s/\W+/ /gs;   $tessay=~s/\W+/ /gs;
 # String similarity gives up if not even limit  # String similarity gives up if not even limit
  my $tsimilar=&String::Similarity::similarity($uessay,$tessay,$limit);   my $tsimilar=&String::Similarity::similarity($uessay,$tessay,$limit);
Line 711  sub most_similar { Line 718  sub most_similar {
     $sname=$tname;      $sname=$tname;
     $sdom=$tdom;      $sdom=$tdom;
     $scrsid=$tcrsid;      $scrsid=$tcrsid;
     $sessay=$old_essays->{$tkey};      $sessay=$old_essays{$symb}{$tkey};
  }   }
     }      }
     if ($limit>0.6) {      if ($limit>0.6) {
Line 729  sub most_similar { Line 736  sub most_similar {
 sub initialverifyreceipt {  sub initialverifyreceipt {
    my ($request,$symb) = @_;     my ($request,$symb) = @_;
    &commonJSfunctions($request);     &commonJSfunctions($request);
    return '<form name="gradingMenu"><input type="submit" value="'.&mt('Verify Receipt Number.').'" />'.     return '<form name="gradingMenu" action=""><input type="submit" value="'.&mt('Verify Receipt Number.').'" />'.
         &Apache::lonnet::recprefix($env{'request.course.id'}).          &Apache::lonnet::recprefix($env{'request.course.id'}).
         '-<input type="text" name="receipt" size="4" />'.          '-<input type="text" name="receipt" size="4" />'.
         '<input type="hidden" name="symb" value="'.&Apache::lonenc::check_encrypt($symb).'" />'."\n".          '<input type="hidden" name="symb" value="'.&Apache::lonenc::check_encrypt($symb).'" />'."\n".
Line 1414  INNERJS Line 1421  INNERJS
                 adds => 'Add selection to keyword list? Edit if desired.',                  adds => 'Add selection to keyword list? Edit if desired.',
                 comp => 'Compose Message for: ',                  comp => 'Compose Message for: ',
                 incl => 'Include',                  incl => 'Include',
                   type => 'Type',
                 subj => 'Subject',                  subj => 'Subject',
                 mesa => 'Message',                  mesa => 'Message',
                 new  => 'New',                  new  => 'New',
Line 1422  INNERJS Line 1430  INNERJS
                 kehi => 'Keyword Highlight Options',                  kehi => 'Keyword Highlight Options',
                 txtc => 'Text Color',                  txtc => 'Text Color',
                 font => 'Font Size',                  font => 'Font Size',
                   fnst => 'Font Style',
              );               );
     $request->print(&Apache::lonhtmlcommon::scripttag(<<SUBJAVASCRIPT));      $request->print(&Apache::lonhtmlcommon::scripttag(<<SUBJAVASCRIPT));
   
Line 1521  INNERJS Line 1530  INNERJS
   
   function savedMsgHeader(Nmsg,usrctr,fullname) {    function savedMsgHeader(Nmsg,usrctr,fullname) {
     var height = 70*Nmsg+250;      var height = 70*Nmsg+250;
     var scrollbar = "no";  
     if (height > 600) {      if (height > 600) {
  height = 600;   height = 600;
  scrollbar = "yes";  
     }      }
     var xpos = (screen.width-600)/2;      var xpos = (screen.width-600)/2;
     xpos = (xpos < 0) ? '0' : xpos;      xpos = (xpos < 0) ? '0' : xpos;
     var ypos = (screen.height-height)/2-30;      var ypos = (screen.height-height)/2-30;
     ypos = (ypos < 0) ? '0' : ypos;      ypos = (ypos < 0) ? '0' : ypos;
   
     pWin = window.open('', 'MessageCenter', 'resizable=yes,toolbar=no,location=no,scrollbars='+scrollbar+',screenx='+xpos+',screeny='+ypos+',width=700,height='+height);      pWin = window.open('', 'MessageCenter', 'resizable=yes,toolbar=no,location=no,scrollbars=yes,screenx='+xpos+',screeny='+ypos+',width=700,height='+height);
     pWin.focus();      pWin.focus();
     pDoc = pWin.document;      pDoc = pWin.document;
     pDoc.$docopen;      pDoc.$docopen;
Line 1539  INNERJS Line 1546  INNERJS
   
     pDoc.write("<form action=\\"inactive\\" name=\\"msgcenter\\">");      pDoc.write("<form action=\\"inactive\\" name=\\"msgcenter\\">");
     pDoc.write("<input value=\\""+usrctr+"\\" name=\\"usrctr\\" type=\\"hidden\\">");      pDoc.write("<input value=\\""+usrctr+"\\" name=\\"usrctr\\" type=\\"hidden\\">");
     pDoc.write("<h3><span class=\\"LC_info\\">&nbsp;$lt{'comp'}\"+fullname+\"<\\/span><\\/h3><br /><br />");      pDoc.write("<h1>&nbsp;$lt{'comp'}\"+fullname+\"<\\/h1>");
   
     pDoc.write('<table border="0" width="100%"><tr><td bgcolor="#777777">');      pDoc.write('<table style="border:1px solid black;"><tr>');
     pDoc.write('<table border="0" width="100%"><tr bgcolor="#DDFFFF">');      pDoc.write("<td><b>$lt{'incl'}<\\/b><\\/td><td><b>$lt{'type'}<\\/b><\\/td><td><b>$lt{'mesa'}<\\/td><\\/tr>");
     pDoc.write("<td><b>Type<\\/b><\\/td><td><b>$lt{'incl'}<\\/b><\\/td><td><b>$lt{'mesa'}<\\/td><\\/tr>");  
 }  }
     function displaySubject(msg,shwsel) {      function displaySubject(msg,shwsel) {
     pDoc = pWin.document;      pDoc = pWin.document;
     pDoc.write("<tr bgcolor=\\"#ffffdd\\">");      pDoc.write("<tr>");
     pDoc.write("<td>$lt{'subj'}<\\/td>");  
     pDoc.write("<td align=\\"center\\"><input name=\\"subchk\\" type=\\"checkbox\\"" +shwsel+"><\\/td>");      pDoc.write("<td align=\\"center\\"><input name=\\"subchk\\" type=\\"checkbox\\"" +shwsel+"><\\/td>");
     pDoc.write("<td><input name=\\"msgsub\\" type=\\"text\\" value=\\""+msg+"\\"size=\\"60\\" maxlength=\\"80\\"><\\/td><\\/tr>");      pDoc.write("<td>$lt{'subj'}<\\/td>");
       pDoc.write("<td><input name=\\"msgsub\\" type=\\"text\\" value=\\""+msg+"\\"size=\\"40\\" maxlength=\\"80\\"><\\/td><\\/tr>");
 }  }
   
   function displaySavedMsg(ctr,msg,shwsel) {    function displaySavedMsg(ctr,msg,shwsel) {
     pDoc = pWin.document;      pDoc = pWin.document;
     pDoc.write("<tr bgcolor=\\"#ffffdd\\">");      pDoc.write("<tr>");
     pDoc.write("<td align=\\"center\\">"+ctr+"<\\/td>");  
     pDoc.write("<td align=\\"center\\"><input name=\\"msgn"+ctr+"\\" type=\\"checkbox\\"" +shwsel+"><\\/td>");      pDoc.write("<td align=\\"center\\"><input name=\\"msgn"+ctr+"\\" type=\\"checkbox\\"" +shwsel+"><\\/td>");
       pDoc.write("<td align=\\"center\\">"+ctr+"<\\/td>");
     pDoc.write("<td><textarea name=\\"msg"+ctr+"\\" cols=\\"60\\" rows=\\"3\\">"+msg+"<\\/textarea><\\/td><\\/tr>");      pDoc.write("<td><textarea name=\\"msg"+ctr+"\\" cols=\\"60\\" rows=\\"3\\">"+msg+"<\\/textarea><\\/td><\\/tr>");
 }  }
   
   function newMsg(newmsg,shwsel) {    function newMsg(newmsg,shwsel) {
     pDoc = pWin.document;      pDoc = pWin.document;
     pDoc.write("<tr bgcolor=\\"#ffffdd\\">");      pDoc.write("<tr>");
     pDoc.write("<td align=\\"center\\">$lt{'new'}<\\/td>");  
     pDoc.write("<td align=\\"center\\"><input name=\\"newmsgchk\\" type=\\"checkbox\\"" +shwsel+"><\\/td>");      pDoc.write("<td align=\\"center\\"><input name=\\"newmsgchk\\" type=\\"checkbox\\"" +shwsel+"><\\/td>");
       pDoc.write("<td align=\\"center\\">$lt{'new'}<\\/td>");
     pDoc.write("<td><textarea name=\\"newmsg\\" cols=\\"60\\" rows=\\"3\\" onchange=\\"javascript:this.form.newmsgchk.checked=true\\" >"+newmsg+"<\\/textarea><\\/td><\\/tr>");      pDoc.write("<td><textarea name=\\"newmsg\\" cols=\\"60\\" rows=\\"3\\" onchange=\\"javascript:this.form.newmsgchk.checked=true\\" >"+newmsg+"<\\/textarea><\\/td><\\/tr>");
 }  }
   
   function msgTail() {    function msgTail() {
     pDoc = pWin.document;      pDoc = pWin.document;
     pDoc.write("<\\/table>");      //pDoc.write("<\\/table>");
     pDoc.write("<\\/td><\\/tr><\\/table>&nbsp;");      pDoc.write("<\\/td><\\/tr><\\/table>&nbsp;");
     pDoc.write("<input type=\\"button\\" value=\\"$lt{'save'}\\" onclick=\\"javascript:checkInput()\\">&nbsp;&nbsp;");      pDoc.write("<input type=\\"button\\" value=\\"$lt{'save'}\\" onclick=\\"javascript:checkInput()\\">&nbsp;&nbsp;");
     pDoc.write("<input type=\\"button\\" value=\\"$lt{'canc'}\\" onclick=\\"self.close()\\"><br /><br />");      pDoc.write("<input type=\\"button\\" value=\\"$lt{'canc'}\\" onclick=\\"self.close()\\"><br /><br />");
Line 1628  INNERJS Line 1634  INNERJS
   
     hDoc.write('<table border="0" width="100%"><tr><td bgcolor="#777777">');      hDoc.write('<table border="0" width="100%"><tr><td bgcolor="#777777">');
     hDoc.write('<table border="0" width="100%"><tr bgcolor="#DDFFFF">');      hDoc.write('<table border="0" width="100%"><tr bgcolor="#DDFFFF">');
     hDoc.write("<td><b>$lt{'txtc'}<\\/b><\\/td><td><b>$lt{'font'}<\\/b><\\/td><td><b>Font Style<\\/td><\\/tr>");      hDoc.write("<td><b>$lt{'txtc'}<\\/b><\\/td><td><b>$lt{'font'}<\\/b><\\/td><td><b>$lt{'fnst'}<\\/td><\\/tr>");
   }    }
   
   function highlightbody(clrval,clrtxt,clrsel,szval,sztxt,szsel,syval,sytxt,sysel) {     function highlightbody(clrval,clrtxt,clrsel,szval,sztxt,szsel,syval,sytxt,sysel) { 
Line 1696  sub gradeBox { Line 1702  sub gradeBox {
     $wgt       = ($wgt > 0 ? $wgt : '1');      $wgt       = ($wgt > 0 ? $wgt : '1');
     my $score  = ($$record{'resource.'.$partid.'.awarded'} eq '' ?      my $score  = ($$record{'resource.'.$partid.'.awarded'} eq '' ?
   '' : &compute_points($$record{'resource.'.$partid.'.awarded'},$wgt));    '' : &compute_points($$record{'resource.'.$partid.'.awarded'},$wgt));
     my $result='<input type="hidden" name="WGT'.$counter.'_'.$partid.'" value="'.$wgt.'" />'."\n";      my $data_WGT='<input type="hidden" name="WGT'.$counter.'_'.$partid.'" value="'.$wgt.'" />'."\n";
     my $display_part= &get_display_part($partid,$symb);      my $display_part= &get_display_part($partid,$symb);
     my %last_resets = &get_last_resets($symb,$env{'request.course.id'},      my %last_resets = &get_last_resets($symb,$env{'request.course.id'},
        [$partid]);         [$partid]);
Line 1704  sub gradeBox { Line 1710  sub gradeBox {
     if ($last_resets{$partid}) {      if ($last_resets{$partid}) {
         $aggtries = &get_num_tries($record,$last_resets{$partid},$partid);          $aggtries = &get_num_tries($record,$last_resets{$partid},$partid);
     }      }
     $result.=&Apache::loncommon::start_data_table_row();      my $result=&Apache::loncommon::start_data_table_row();
     my $ctr = 0;      my $ctr = 0;
     my $thisweight = 0;      my $thisweight = 0;
     my $increment = &get_increment();      my $increment = &get_increment();
Line 1741  sub gradeBox { Line 1747  sub gradeBox {
   
   
     $result .=       $result .= 
     '<td>'.$display_part.'</td><td>'.$radio.'</td><td>'.&mt('or').'</td><td>'.$line.'</td>';      '<td>'.$data_WGT.$display_part.'</td><td>'.$radio.'</td><td>'.&mt('or').'</td><td>'.$line.'</td>';
     $result.=&Apache::loncommon::end_data_table_row();      $result.=&Apache::loncommon::end_data_table_row();
       $result.=&Apache::loncommon::start_data_table_row().'<td colspan="6">';
     $result.='<input type="hidden" name="stores'.$counter.'_'.$partid.'" value="" />'."\n".      $result.='<input type="hidden" name="stores'.$counter.'_'.$partid.'" value="" />'."\n".
  '<input type="hidden" name="oldpts'.$counter.'_'.$partid.'" value="'.$score.'" />'."\n".   '<input type="hidden" name="oldpts'.$counter.'_'.$partid.'" value="'.$score.'" />'."\n".
  '<input type="hidden" name="solved'.$counter.'_'.$partid.'" value="'.   '<input type="hidden" name="solved'.$counter.'_'.$partid.'" value="'.
Line 1753  sub gradeBox { Line 1760  sub gradeBox {
         $aggtries.'" />'."\n";          $aggtries.'" />'."\n";
     my $res_error;      my $res_error;
     $result.=&handback_box($symb,$uname,$udom,$counter,$partid,$record,\$res_error);      $result.=&handback_box($symb,$uname,$udom,$counter,$partid,$record,\$res_error);
       $result.='</td>'.&Apache::loncommon::end_data_table_row();
     if ($res_error) {      if ($res_error) {
         return &navmap_errormsg();          return &navmap_errormsg();
     }      }
Line 1826  sub show_problem { Line 1834  sub show_problem {
  $companswer=~s|</form>||g;   $companswer=~s|</form>||g;
  $companswer=~s|name="submit"|name="would_have_been_submit"|g;   $companswer=~s|name="submit"|name="would_have_been_submit"|g;
     }      }
       my $renderheading = &mt('View of the problem');
       my $answerheading = &mt('Correct answer');
       if (($uname ne $env{'user.name'}) || ($udom ne $env{'user.domain'})) {
           my $stu_fullname = $env{'form.fullname'};
           if ($stu_fullname eq '') {
               $stu_fullname = &Apache::loncommon::plainname($uname,$udom,'lastname');
           }
           my $forwhom = &nameUserString(undef,$stu_fullname,$uname,$udom);
           if ($forwhom ne '') {
               $renderheading = &mt('View of the problem for[_1]',$forwhom);
               $answerheading = &mt('Correct answer for[_1]',$forwhom);
           }
       }
     $rendered=      $rendered=
         '<div class="LC_Box">'          '<div class="LC_Box">'
        .'<h3 class="LC_hcell">'.&mt('View of the problem').'</h3>'         .'<h3 class="LC_hcell">'.$renderheading.'</h3>'
        .$rendered         .$rendered
        .'</div>';         .'</div>';
     $companswer=      $companswer=
         '<div class="LC_Box">'          '<div class="LC_Box">'
        .'<h3 class="LC_hcell">'.&mt('Correct answer').'</h3>'         .'<h3 class="LC_hcell">'.$answerheading.'</h3>'
        .$companswer         .$companswer
        .'</div>';         .'</div>';
     my $result;      my $result;
Line 1935  sub submission { Line 1956  sub submission {
  '" src="'.$request->dir_config('lonIconsURL').   '" src="'.$request->dir_config('lonIconsURL').
  '/check.gif" height="16" border="0" />';   '/check.gif" height="16" border="0" />';
   
     my %old_essays;  
     # header info      # header info
     if ($counter == 0) {      if ($counter == 0) {
  &sub_page_js($request);   &sub_page_js($request);
Line 2024  sub submission { Line 2044  sub submission {
                           keyw => 'Keyword Options',                            keyw => 'Keyword Options',
                           list => 'List',                            list => 'List',
                           past => 'Paste Selection to List',                            past => 'Paste Selection to List',
                           high => 'Hightlight Attribute',                            high => 'Highlight Attribute',
                      );                           );    
 #  #
 # Print out the keyword options line  # Print out the keyword options line
Line 2033  sub submission { Line 2053  sub submission {
 <br /><b>$lt{'keyw'}:</b>&nbsp;  <br /><b>$lt{'keyw'}:</b>&nbsp;
 <a href="javascript:keywords(document.SCORE);" target="_self">$lt{'list'}</a>&nbsp; &nbsp;  <a href="javascript:keywords(document.SCORE);" target="_self">$lt{'list'}</a>&nbsp; &nbsp;
 <a href="#" onmousedown="javascript:getSel(); return false"  <a href="#" onmousedown="javascript:getSel(); return false"
  CLASS="page">$lt{'past'}</a>&nbsp; &nbsp;   class="page">$lt{'past'}</a>&nbsp; &nbsp;
 <a href="javascript:kwhighlight();" target="_self">$lt{'high'}</a><br /><br />  <a href="javascript:kwhighlight();" target="_self">$lt{'high'}</a><br /><br />
 KEYWORDS  KEYWORDS
 #  #
Line 2043  KEYWORDS Line 2063  KEYWORDS
     my ($adom,$aname,$apath)=($essayurl=~/^($LONCAPA::domain_re)\/($LONCAPA::username_re)\/(.*)$/);      my ($adom,$aname,$apath)=($essayurl=~/^($LONCAPA::domain_re)\/($LONCAPA::username_re)\/(.*)$/);
     $apath=&escape($apath);      $apath=&escape($apath);
     $apath=~s/\W/\_/gs;      $apath=~s/\W/\_/gs;
     %old_essays=&Apache::lonnet::dump('nohist_essay_'.$apath,$adom,$aname);              &init_old_essays($symb,$apath,$adom,$aname);
         }          }
     }      }
   
Line 2149  KEYWORDS Line 2169  KEYWORDS
  if ($env{"form.$uname:$udom:$partid:submitted_by"}) {   if ($env{"form.$uname:$udom:$partid:submitted_by"}) {
     if (exists($seenparts{$partid})) { next; }      if (exists($seenparts{$partid})) { next; }
     $seenparts{$partid}=1;      $seenparts{$partid}=1;
     my $submitby='<b>Part:</b> '.$display_part.                      $request->print(
  ' <b>Collaborative submission by:</b> '.                          '<b>'.&mt('Part: [_1]',$display_part).'</b>'.
  '<a href="javascript:viewSubmitter(\''.                          ' <b>'.&mt('Collaborative submission by: [_1]',
  $env{"form.$uname:$udom:$partid:submitted_by"}.                                     '<a href="javascript:viewSubmitter(\''.
  '\');" target="_self">'.                                     $env{"form.$uname:$udom:$partid:submitted_by"}.
  $$fullname{$env{"form.$uname:$udom:$partid:submitted_by"}}.'</a><br />';                                     '\');" target="_self">'.
     $request->print($submitby);                                     $$fullname{$env{"form.$uname:$udom:$partid:submitted_by"}}.'</a>').
                           '<br />');
     next;      next;
  }   }
  my $responsetype = $responseType->{$partid}->{$respid};   my $responsetype = $responseType->{$partid}->{$respid};
Line 2182  KEYWORDS Line 2203  KEYWORDS
                     }                      }
     if($env{'form.checkPlag'}){      if($env{'form.checkPlag'}){
  my ($oname,$odom,$ocrsid,$oessay,$osim)=   my ($oname,$odom,$ocrsid,$oessay,$osim)=
     &most_similar($uname,$udom,$subval,\%old_essays);      &most_similar($uname,$udom,$symb,$subval);
  if ($osim) {   if ($osim) {
     $osim=int($osim*100.0);      $osim=int($osim*100.0);
     my %old_course_desc =       my %old_course_desc = 
Line 2225  KEYWORDS Line 2246  KEYWORDS
                                 $lastsubonly.='<br /><span class="LC_warning">'.&mt('Like all files provided by users, this file may contain viruses').'</span><br />';                                  $lastsubonly.='<br /><span class="LC_warning">'.&mt('Like all files provided by users, this file may contain viruses').'</span><br />';
                                 foreach my $file (@$files) {                                  foreach my $file (@$files) {
                                     &Apache::lonnet::allowuploaded('/adm/grades',$file);                                      &Apache::lonnet::allowuploaded('/adm/grades',$file);
                                     $lastsubonly.='<br /><a href="'.$file.'?rawmode=1" target="lonGRDs"><img src="'.&Apache::loncommon::icon($file).'" border="0" /> '.$file.'</a>';                                      $lastsubonly.='<br /><a href="'.$file.'?rawmode=1" target="lonGRDs"><img src="'.&Apache::loncommon::icon($file).'" border="0" alt="" /> '.$file.'</a>';
                                 }                                  }
                             }                              }
     $lastsubonly.='<br />';      $lastsubonly.='<br />';
Line 2282  KEYWORDS Line 2303  KEYWORDS
     '<input type="hidden" name="newmsg'.$counter.'" value="" />'."\n";      '<input type="hidden" name="newmsg'.$counter.'" value="" />'."\n";
  $result.='&nbsp;<a href="javascript:msgCenter(document.SCORE,'.$counter.   $result.='&nbsp;<a href="javascript:msgCenter(document.SCORE,'.$counter.
     ',\''.$msgfor.'\');" target="_self">'.      ',\''.$msgfor.'\');" target="_self">'.
     &mt('Compose message to student').(scalar(@$col_fullnames) >= 1 ? 's' : '').'</a><label> ('.      &mt('Compose message to student'.(scalar(@$col_fullnames) >= 1 ? 's' : '')).'</a><label> ('.
     &mt('incl. grades').' <input type="checkbox" name="withgrades'.$counter.'" /></label>)'.      &mt('incl. grades').' <input type="checkbox" name="withgrades'.$counter.'" /></label>)'.
     '<img src="'.$request->dir_config('lonIconsURL').      ' <img src="'.$request->dir_config('lonIconsURL').
     '/mailbkgrd.gif" width="14" height="10" name="mailicon'.$counter.'" />'."\n".      '/mailbkgrd.gif" width="14" height="10" alt="" name="mailicon'.$counter.'" />'."\n".
     '<br />&nbsp;('.      '<br />&nbsp;('.
     &mt('Message will be sent when you click on Save &amp; Next below.').")\n";      &mt('Message will be sent when you click on Save &amp; Next below.').")\n";
  $result.='</div></div>';   $result.='</div></div>';
Line 2505  sub keywords_highlight { Line 2526  sub keywords_highlight {
     return $string;      return $string;
 }  }
   
   # For Tasks provide a mechanism to display previous version for one specific student
   
   sub show_previous_task_version {
       my ($request,$symb) = @_;
       if ($symb eq '') {
           $request->print("Unable to handle ambiguous references.");
   
           return '';
       }
       my ($uname,$udom) = ($env{'form.student'},$env{'form.userdom'});
       my $usec = &Apache::lonnet::getsection($udom,$uname,$env{'request.course.id'});
       if (!&canview($usec)) {
           $request->print('<span class="LC_warning">Unable to view previous version for requested student.('.
                           $uname.':'.$udom.' in section '.$usec.' in course id '.
                           $env{'request.course.id'}.')</span>');
           return;
       }
       my $mode = 'both';
       my $isTask = ($symb =~/\.task$/);
       if ($isTask) {
           if ($env{'form.previousversion'} =~ /^\d+$/) {
               if ($env{'form.fullname'} eq '') {
                   $env{'form.fullname'} =
                       &Apache::loncommon::plainname($uname,$udom,'lastname');
               }
               my $probtitle=&Apache::lonnet::gettitle($symb);
               $request->print("\n\n".
                               '<div class="LC_grade_show_user">'.
                               '<h2>'.&nameUserString(undef,$env{'form.fullname'},$uname,$udom).
                               '</h2>'."\n");
               &Apache::lonxml::clear_problem_counter();
               $request->print(&show_problem($request,$symb,$uname,$udom,1,1,$mode,
                               {'previousversion' => $env{'form.previousversion'} }));
               $request->print("\n</div>");
           }
       }
       return;
   }
   
   sub choose_task_version_form {
       my ($symb,$uname,$udom,$nomenu) = @_;
       my $isTask = ($symb =~/\.task$/);
       my ($current,$version,$result,$js,$displayed,$rowtitle);
       if ($isTask) {
           my %record = &Apache::lonnet::restore($symb,$env{'request.course.id'},
                                                 $udom,$uname);
           if (($record{'resource.0.version'} eq '') ||
               ($record{'resource.0.version'} < 2)) {
               return ($record{'resource.0.version'},
                       $record{'resource.0.version'},$result,$js);
           } else {
               $current = $record{'resource.0.version'};
           }
           if ($env{'form.previousversion'}) {
               $displayed = $env{'form.previousversion'};
               $rowtitle = &mt('Choose another version:')
           } else {
               $displayed = $current;
               $rowtitle = &mt('Show earlier version:');
           }
           $result = '<div class="LC_left_float">';
           my $list;
           my $numversions = 0;
           for (my $i=1; $i<=$record{'resource.0.version'}; $i++) {
               if ($i == $current) {
                   if (!$env{'form.previousversion'} || $nomenu) {
                       next;
                   } else {
                       $list .= '<option value="'.$i.'">'.&mt('Current').'</option>'."\n";
                       $numversions ++;
                   }
               } elsif (defined($record{'resource.'.$i.'.0.status'})) {
                   unless ($i == $env{'form.previousversion'}) {
                       $numversions ++;
                   }
                   $list .= '<option value="'.$i.'">'.$i.'</option>'."\n";
               }
           }
           if ($numversions) {
               $symb = &HTML::Entities::encode($symb,'<>"&');
               $result .=
                   '<form name="getprev" method="post" action=""'.
                   ' onsubmit="return previousVersion('."'$uname','$udom','$symb','$displayed'".');">'.
                   &Apache::loncommon::start_data_table().
                   &Apache::loncommon::start_data_table_row().
                   '<th align="left">'.$rowtitle.'</th>'.
                   '<td><select name="version">'.
                   '<option>'.&mt('Select').'</option>'.
                   $list.
                   '</select></td>'.
                   &Apache::loncommon::end_data_table_row();
               unless ($nomenu) {
                   $result .= &Apache::loncommon::start_data_table_row().
                   '<th align="left">'.&mt('Open in new window').'</th>'.
                   '<td><span class="LC_nobreak">'.
                   '<label><input type="radio" name="prevwin" value="1" />'.
                   &mt('Yes').'</label>'.
                   '<label><input type="radio" name="prevwin" value="0" checked="checked" />'.&mt('No').'</label>'.
                   '</span></td>'.
                   &Apache::loncommon::end_data_table_row();
               }
               $result .=
                   &Apache::loncommon::start_data_table_row().
                   '<th align="left">&nbsp;</th>'.
                   '<td>'.
                   '<input type="submit" name="prevsub" value="'.&mt('Display').'" />'.
                   '</td>'.
                   &Apache::loncommon::end_data_table_row().
                   &Apache::loncommon::end_data_table().
                   '</form>';
               $js = &previous_display_javascript($nomenu,$current);
           } elsif ($displayed && $nomenu) {
               $result .= '<a href="javascript:window.close()">'.&mt('Close window').'</a>';
           } else {
               $result .= &mt('No previous versions to show for this student');
           }
           $result .= '</div>';
       }
       return ($current,$displayed,$result,$js);
   }
   
   sub previous_display_javascript {
       my ($nomenu,$current) = @_;
       my $js = <<"JSONE";
   <script type="text/javascript">
   // <![CDATA[
   function previousVersion(uname,udom,symb) {
       var current = '$current';
       var version = document.getprev.version.options[document.getprev.version.selectedIndex].value;
       var prevstr = new RegExp("^\\\\d+\$");
       if (!prevstr.test(version)) {
           return false;
       }
       var url = '';
       if (version == current) {
           url = '/adm/grades?student='+uname+'&userdom='+udom+'&symb='+symb+'&command=submission';
       } else {
           url = '/adm/grades?student='+uname+'&userdom='+udom+'&symb='+symb+'&command=versionsub&previousversion='+version;
       }
   JSONE
       if ($nomenu) {
           $js .= <<"JSTWO";
       document.location.href = url;
   JSTWO
       } else {
           $js .= <<"JSTHREE";
       var newwin = 0;
       for (var i=0; i<document.getprev.prevwin.length; i++) {
           if (document.getprev.prevwin[i].checked == true) {
               newwin = document.getprev.prevwin[i].value;
           }
       }
       if (newwin == 1) {
           var options = 'height=600,width=800,resizable=yes,scrollbars=yes,location=no,menubar=no,toolbar=no';
           url = url+'&inhibitmenu=yes';
           if (typeof(previousWin) == 'undefined' || previousWin.closed) {
               previousWin = window.open(url,'',options,1);
           } else {
               previousWin.location.href = url;
           }
           previousWin.focus();
           return false;
       } else {
           document.location.href = url;
           return false;
       }
   JSTHREE
       }
       $js .= <<"ENDJS";
       return false;
   }
   // ]]>
   </script>
   ENDJS
   
   }
   
 #--- Called from submission routine  #--- Called from submission routine
 sub processHandGrade {  sub processHandGrade {
     my ($request,$symb) = @_;      my ($request,$symb) = @_;
Line 2902  sub handback_files { Line 3100  sub handback_files {
         &file_name_version_ext($answer_file);          &file_name_version_ext($answer_file);
     my ($portfolio_path) = ($directory =~ /^.+$stuname\/portfolio(.*)/);      my ($portfolio_path) = ($directory =~ /^.+$stuname\/portfolio(.*)/);
                     my $getpropath = 1;                      my $getpropath = 1;
     my @dir_list = &Apache::lonnet::dirlist($portfolio_root.$portfolio_path,$domain,$stuname,$getpropath);                      my ($dir_list,$listerror) = 
     my $version = &get_next_version($answer_name, $answer_ext, \@dir_list);                          &Apache::lonnet::dirlist($portfolio_root.$portfolio_path,
                     # fix file name                                                   $domain,$stuname,$getpropath);
       my $version = &get_next_version($answer_name,$answer_ext,$dir_list);
                       # fix filename
                     my ($save_file_name) = (($directory.$answer_name.".$version.".$answer_ext) =~ /^.+\/${stuname}\/(.*)/);                      my ($save_file_name) = (($directory.$answer_name.".$version.".$answer_ext) =~ /^.+\/${stuname}\/(.*)/);
                     my $result=&Apache::lonnet::finishuserfileupload($stuname,$domain,                      my $result=&Apache::lonnet::finishuserfileupload($stuname,$domain,
                                            $newflg.'_'.$part_resp.'_returndoc'.$counter,                                             $newflg.'_'.$part_resp.'_returndoc'.$counter,
Line 2923  sub handback_files { Line 3123  sub handback_files {
                         $$newrecord{"resource.$new_part.$resp_id.handback"} .= $save_file_name;                          $$newrecord{"resource.$new_part.$resp_id.handback"} .= $save_file_name;
  $file_msg.= '<span class="LC_filename"><a href="/uploaded/'."$domain/$stuname/".$save_file_name.'">'.$save_file_name."</a></span> <br />";   $file_msg.= '<span class="LC_filename"><a href="/uploaded/'."$domain/$stuname/".$save_file_name.'">'.$save_file_name."</a></span> <br />";
                     }                      }
                     $request->print('<br />'.&mt('[_1] will be the uploaded file name [_2]','<span class="LC_info">'.$fname.'</span>','<span class="LC_filename">'.$env{'form.'.$newflg.'_'.$part_resp.'_origdoc'.$counter}.'</span>'));                      $request->print('<br />'.&mt('[_1] will be the uploaded filename [_2]','<span class="LC_info">'.$fname.'</span>','<span class="LC_filename">'.$env{'form.'.$newflg.'_'.$part_resp.'_origdoc'.$counter}.'</span>'));
                 }                  }
             }              }
         }          }
Line 3064  sub version_portfiles { Line 3264  sub version_portfiles {
  my ($answer_name,$answer_ver,$answer_ext) =   my ($answer_name,$answer_ver,$answer_ext) =
     &file_name_version_ext($answer_file);      &file_name_version_ext($answer_file);
                 my $getpropath = 1;                      my $getpropath = 1;    
                 my @dir_list = &Apache::lonnet::dirlist($portfolio_root.$directory,$domain,$stu_name,$getpropath);                  my ($dir_list,$listerror) = 
                 my $version = &get_next_version($answer_name, $answer_ext, \@dir_list);                      &Apache::lonnet::dirlist($portfolio_root.$directory,$domain,
                                                $stu_name,$getpropath);
                   my $version = &get_next_version($answer_name,$answer_ext,$dir_list);
                 my $new_answer = &version_selected_portfile($domain, $stu_name, $directory, $answer_file, $version);                  my $new_answer = &version_selected_portfile($domain, $stu_name, $directory, $answer_file, $version);
                 if ($new_answer ne 'problem getting file') {                  if ($new_answer ne 'problem getting file') {
                     push(@versioned_portfiles, $directory.$new_answer);                      push(@versioned_portfiles, $directory.$new_answer);
Line 3084  sub version_portfiles { Line 3286  sub version_portfiles {
 sub get_next_version {  sub get_next_version {
     my ($answer_name, $answer_ext, $dir_list) = @_;      my ($answer_name, $answer_ext, $dir_list) = @_;
     my $version;      my $version;
     foreach my $row (@$dir_list) {      if (ref($dir_list) eq 'ARRAY') {
         my ($file) = split(/\&/,$row,2);          foreach my $row (@{$dir_list}) {
         my ($file_name,$file_version,$file_ext) =              my ($file) = split(/\&/,$row,2);
     &file_name_version_ext($file);              my ($file_name,$file_version,$file_ext) =
         if (($file_name eq $answer_name) &&           &file_name_version_ext($file);
     ($file_ext eq $answer_ext)) {              if (($file_name eq $answer_name) && 
                 # gets here if filename and extension match, regardless of version          ($file_ext eq $answer_ext)) {
                        # gets here if filename and extension match, 
                        # regardless of version
                 if ($file_version ne '') {                  if ($file_version ne '') {
                 # a versioned file is found  so save it for later                      # a versioned file is found  so save it for later
                 if ($file_version > $version) {                      if ($file_version > $version) {
     $version = $file_version;          $version = $file_version;
         }              }
                   }
             }              }
         }          }
     }       }
     $version ++;      $version ++;
     return($version);      return($version);
 }  }
Line 4087  sub csvuploadassign { Line 4292  sub csvuploadassign {
     my ($classlist) = &getclasslist('all',0);      my ($classlist) = &getclasslist('all',0);
     my @notallowed;      my @notallowed;
     my @skipped;      my @skipped;
       my @warnings;
     my $countdone=0;      my $countdone=0;
     foreach my $grade (@gradedata) {      foreach my $grade (@gradedata) {
  my %entries=&Apache::loncommon::record_sep($grade);   my %entries=&Apache::loncommon::record_sep($grade);
Line 4136  sub csvuploadassign { Line 4342  sub csvuploadassign {
                     my $award=($pcr == 0) ? 'incorrect_by_override'                      my $award=($pcr == 0) ? 'incorrect_by_override'
                                           : 'correct_by_override';                                            : 'correct_by_override';
                     if ($pcr>1) {                      if ($pcr>1) {
                        push(@skipped,&mt("[_1]: point value larger than weight","$username:$domain"));                         push(@warnings,&mt("[_1]: point value larger than weight","$username:$domain"));
                     }                      }
                     $grades{"resource.$part.awarded"}=$pcr;                      $grades{"resource.$part.awarded"}=$pcr;
                     $grades{"resource.$part.solved"}=$award;                      $grades{"resource.$part.solved"}=$award;
Line 4182  sub csvuploadassign { Line 4388  sub csvuploadassign {
         }          }
     }      }
     $request->print('<br />'.&Apache::lonhtmlcommon::confirm_success(&mt("Saved scores for [quant,_1,student]",$countdone),$countdone==0));      $request->print('<br />'.&Apache::lonhtmlcommon::confirm_success(&mt("Saved scores for [quant,_1,student]",$countdone),$countdone==0));
       if (@warnings) {
           $request->print('<br />'.&Apache::lonhtmlcommon::confirm_success(&mt('Warnings generated for the following saved scores:'),1).'<br />');
           $request->print(join(', ',@warnings));
       }
     if (@skipped) {      if (@skipped) {
  $request->print('<br />'.&Apache::lonhtmlcommon::confirm_success(&mt('No scores stored for the following username(s):'),1).'<br />');   $request->print('<br />'.&Apache::lonhtmlcommon::confirm_success(&mt('No scores stored for the following username(s):'),1).'<br />');
         $request->print(join(', ',@skipped));          $request->print(join(', ',@skipped));
Line 4443  sub displayPage { Line 4653  sub displayPage {
  &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('[_1]parts)',                          : '<br />('.&mt('[_1]parts',
  scalar(@{$parts}).'&nbsp;')   scalar(@{$parts}).'&nbsp;').')'
  ).   ).
  '</td>';   '</td>';
     $studentTable.='<td valign="top">';      $studentTable.='<td valign="top">';
Line 4525  sub displaySubByDates { Line 4735  sub displaySubByDates {
  &Apache::loncommon::start_data_table_header_row().   &Apache::loncommon::start_data_table_header_row().
  '<th>'.&mt('Date/Time').'</th>'.   '<th>'.&mt('Date/Time').'</th>'.
  ($isCODE?'<th>'.&mt('CODE').'</th>':'').   ($isCODE?'<th>'.&mt('CODE').'</th>':'').
           ($isTask?'<th>'.&mt('Version').'</th>':'').
  '<th>'.&mt('Submission').'</th>'.   '<th>'.&mt('Submission').'</th>'.
  '<th>'.&mt('Status').'</th>'.   '<th>'.&mt('Status').'</th>'.
  &Apache::loncommon::end_data_table_header_row();   &Apache::loncommon::end_data_table_header_row();
Line 4545  sub displaySubByDates { Line 4756  sub displaySubByDates {
  if (exists($$record{$version.':resource.0.version'})) {   if (exists($$record{$version.':resource.0.version'})) {
     $interaction = $$record{$version.':resource.0.version'};      $interaction = $$record{$version.':resource.0.version'};
  }   }
           if ($isTask && $env{'form.previousversion'}) {
               next unless ($interaction == $env{'form.previousversion'});
           }
  my $where = ($isTask ? "$version:resource.$interaction"   my $where = ($isTask ? "$version:resource.$interaction"
              : "$version:resource");               : "$version:resource");
  $studentTable.=&Apache::loncommon::start_data_table_row().   $studentTable.=&Apache::loncommon::start_data_table_row().
Line 4553  sub displaySubByDates { Line 4766  sub displaySubByDates {
  if ($isCODE) {   if ($isCODE) {
     $studentTable.='<td>'.$record->{$version.':resource.CODE'}.'</td>';      $studentTable.='<td>'.$record->{$version.':resource.CODE'}.'</td>';
  }   }
           if ($isTask) {
               $studentTable.='<td>'.$interaction.'</td>';
           }
  my @versionKeys = split(/\:/,$$record{$version.':keys'});   my @versionKeys = split(/\:/,$$record{$version.':keys'});
  my @displaySub = ();   my @displaySub = ();
  foreach my $partid (@{$parts}) {   foreach my $partid (@{$parts}) {
Line 4572  sub displaySubByDates { Line 4788  sub displaySubByDates {
                                           
     my ($responseId)= ($isTask ? ($matchKey=~ /^resource\.(.*?)\.\Q$partid\E\.award$/)      my ($responseId)= ($isTask ? ($matchKey=~ /^resource\.(.*?)\.\Q$partid\E\.award$/)
                : ($matchKey=~ /^resource\.\Q$partid\E\.(.*?)\.submission$/));                 : ($matchKey=~ /^resource\.\Q$partid\E\.(.*?)\.submission$/));
                     $displaySub[0].='<span class="LC_nobreak"';                      $displaySub[0].='<span class="LC_nobreak">';
                     $displaySub[0].='<b>'.&mt('Part: [_1]',$display_part).'</b>'                      $displaySub[0].='<b>'.&mt('Part: [_1]',$display_part).'</b>'
                                    .' <span class="LC_internal_info">'                                     .' <span class="LC_internal_info">'
                                    .'('.&mt('Response ID: [_1]',$responseId).')'                                     .'('.&mt('Response ID: [_1]',$responseId).')'
Line 4829  sub updateGradeByPage { Line 5045  sub updateGradeByPage {
    from the file that we are parsing that represents one entire sheet     from the file that we are parsing that represents one entire sheet
   
    'bubble line' refers to the data     'bubble line' refers to the data
    representing the line of bubbles that are on the physical bubble sheet     representing the line of bubbles that are on the physical bubblesheet
   
   
 The overall process is that a scanned in bubble sheet data is uploaded  The overall process is that a scanned in bubblesheet data is uploaded
 into a course. When a user wants to grade, they select a  into a course. When a user wants to grade, they select a
 sequence/folder of resources, a file of bubble sheet info, and pick  sequence/folder of resources, a file of bubblesheet info, and pick
 one of the predefined configurations for what each scanline looks  one of the predefined configurations for what each scanline looks
 like.  like.
   
Line 4850  username:domain. Line 5066  username:domain.
   
 During the validation phase the instructor can choose to skip scanlines.   During the validation phase the instructor can choose to skip scanlines. 
   
 After the validation phase, there are now 3 bubble sheet files  After the validation phase, there are now 3 bubblesheet files
   
   scantron_original_filename (unmodified original file)    scantron_original_filename (unmodified original file)
   scantron_corrected_filename (file where the corrected information has replaced the original information)    scantron_corrected_filename (file where the corrected information has replaced the original information)
   scantron_skipped_filename (contains the exact text of scanlines that where skipped)    scantron_skipped_filename (contains the exact text of scanlines that where skipped)
   
 Also there is a separate hash nohist_scantrondata that contains extra  Also there is a separate hash nohist_scantrondata that contains extra
 correction information that isn't representable in the bubble sheet  correction information that isn't representable in the bubblesheet
 file (see &scantron_getfile() for more information)  file (see &scantron_getfile() for more information)
   
 After all scanlines are either valid, marked as valid or skipped, then  After all scanlines are either valid, marked as valid or skipped, then
Line 4929  my %subdivided_bubble_lines;       # no. Line 5145  my %subdivided_bubble_lines;       # no.
   
 my %responsetype_per_response;     # responsetype for each response  my %responsetype_per_response;     # responsetype for each response
   
   my %masterseq_id_responsenum;      # src_id (e.g., 12.3_0.11 etc.) for each
                                      # numbered response. Needed when randomorder
                                      # or randompick are in use. Key is ID, value 
                                      # is response number.
   
 # Save and restore the bubble lines array to the form env.  # Save and restore the bubble lines array to the form env.
   
   
Line 4942  sub save_bubble_lines { Line 5163  sub save_bubble_lines {
         $env{"form.scantron.responsetype.$line"} =          $env{"form.scantron.responsetype.$line"} =
             $responsetype_per_response{$line};              $responsetype_per_response{$line};
     }      }
       foreach my $resid (keys(%masterseq_id_responsenum)) {
           my $line = $masterseq_id_responsenum{$resid};
           $env{"form.scantron.residpart.$line"} = $resid;
       }
 }  }
   
   
 sub restore_bubble_lines {  sub restore_bubble_lines {
     my $line = 0;      my $line = 0;
     %bubble_lines_per_response = ();      %bubble_lines_per_response = ();
       %masterseq_id_responsenum = ();
     while ($env{"form.scantron.bubblelines.$line"}) {      while ($env{"form.scantron.bubblelines.$line"}) {
  my $value = $env{"form.scantron.bubblelines.$line"};   my $value = $env{"form.scantron.bubblelines.$line"};
  $bubble_lines_per_response{$line} = $value;   $bubble_lines_per_response{$line} = $value;
Line 4957  sub restore_bubble_lines { Line 5183  sub restore_bubble_lines {
             $env{"form.scantron.sub_bubblelines.$line"};              $env{"form.scantron.sub_bubblelines.$line"};
         $responsetype_per_response{$line} =          $responsetype_per_response{$line} =
             $env{"form.scantron.responsetype.$line"};              $env{"form.scantron.responsetype.$line"};
           my $id = $env{"form.scantron.residpart.$line"};
           $masterseq_id_responsenum{$id} = $line;
  $line++;   $line++;
     }      }
 }  }
   
 #  Given the parsed scanline, get the response for   
 #  'answer' number n:  
   
 sub get_response_bubbles {  
     my ($parsed_line, $response)  = @_;  
   
     my $bubble_line = $first_bubble_line{$response-1} +1;  
     my $bubble_lines= $bubble_lines_per_response{$response-1};  
       
     my $selected = "";  
   
     for (my $bline = 0; $bline < $bubble_lines; $bline++) {  
  $selected .= $$parsed_line{"scantron.$bubble_line.answer"}.":";  
  $bubble_line++;  
     }  
     return $selected;  
 }  
   
 =pod   =pod 
   
 =item scantron_filenames  =item scantron_filenames
Line 4991  sub scantron_filenames { Line 5201  sub scantron_filenames {
     my $cdom=$env{'course.'.$env{'request.course.id'}.'.domain'};      my $cdom=$env{'course.'.$env{'request.course.id'}.'.domain'};
     my $cname=$env{'course.'.$env{'request.course.id'}.'.num'};      my $cname=$env{'course.'.$env{'request.course.id'}.'.num'};
     my $getpropath = 1;      my $getpropath = 1;
     my @files=&Apache::lonnet::dirlist('userfiles',$cdom,$cname,      my ($dirlist,$listerror) = &Apache::lonnet::dirlist('userfiles',$cdom,
                                        $getpropath);                                                          $cname,$getpropath);
     my @possiblenames;      my @possiblenames;
     foreach my $filename (sort(@files)) {      if (ref($dirlist) eq 'ARRAY') {
  ($filename)=split(/&/,$filename);          foreach my $filename (sort(@{$dirlist})) {
  if ($filename!~/^scantron_orig_/) { next ; }      ($filename)=split(/&/,$filename);
  $filename=~s/^scantron_orig_//;      if ($filename!~/^scantron_orig_/) { next ; }
  push(@possiblenames,$filename);      $filename=~s/^scantron_orig_//;
       push(@possiblenames,$filename);
           }
     }      }
     return @possiblenames;      return @possiblenames;
 }  }
Line 5152  sub scantron_CODEunique { Line 5364  sub scantron_CODEunique {
   
 =item scantron_selectphase  =item scantron_selectphase
   
   Generates the initial screen to start the bubble sheet process.    Generates the initial screen to start the bubblesheet process.
   Allows for - starting a grading run.    Allows for - starting a grading run.
              - downloading existing scan data (original, corrected               - downloading existing scan data (original, corrected
                                                 or skipped info)                                                  or skipped info)
Line 5304  sub scantron_selectphase { Line 5516  sub scantron_selectphase {
   
     &Apache::lonpickcode::code_list($r,2);      &Apache::lonpickcode::code_list($r,2);
   
     $r->print('<br /><form method="post" name="checkscantron">'.      $r->print('<br /><form method="post" name="checkscantron" action="">'.
              $default_form_data."\n".               $default_form_data."\n".
              &Apache::loncommon::start_data_table('LC_scantron_action')."\n".               &Apache::loncommon::start_data_table('LC_scantron_action')."\n".
              &Apache::loncommon::start_data_table_header_row()."\n".               &Apache::loncommon::start_data_table_header_row()."\n".
Line 5395  sub scantron_selectphase { Line 5607  sub scantron_selectphase {
       LastNameLength - number of columns that the last name spans        LastNameLength - number of columns that the last name spans
       BubblesPerRow - number of bubbles available in each row used to         BubblesPerRow - number of bubbles available in each row used to 
                       bubble an answer. (If not specified, 10 assumed).                        bubble an answer. (If not specified, 10 assumed).
   
 =cut  =cut
   
 sub get_scantron_config {  sub get_scantron_config {
Line 5636  sub digits_to_letters { Line 5849  sub digits_to_letters {
                        (see scantron_getfile for more information)                         (see scantron_getfile for more information)
     just_header      - True if should not process question answers but only      just_header      - True if should not process question answers but only
                        the stuff to the left of the answers.                         the stuff to the left of the answers.
       randomorder      - True if randomorder in use
       randompick       - True if randompick in use
       sequence         - Exam folder URL
       master_seq       - Ref to array containing symbs in exam folder
       symb_to_resource - Ref to hash of symbs for resources in exam folder
                          (corresponding values are resource objects)
       partids_by_symb  - Ref to hash of symb -> array ref of partIDs
       orderedforcode   - Ref to hash of arrays. keys are CODEs and values
                          are refs to an array of resource objects, ordered
                          according to order used for CODE, when randomorder
                          and or randompick are in use.
       respnumlookup    - Ref to hash mapping question numbers in bubble lines
                          for current line to question number used for same question
                           in "Master Sequence" (as seen by Course Coordinator).
       startline        - Ref to hash where key is question number (0 is first)
                          and value is number of first bubble line for current 
                          student or code-based randompick and/or randomorder.
       totalref         - Ref of scalar used to score total number of bubble
                          lines needed for responses in a scan line (used when
                          randompick in use. 
       
  Returns:   Returns:
    Hash containing the result of parsing the scanline     Hash containing the result of parsing the scanline
   
Line 5680  sub digits_to_letters { Line 5914  sub digits_to_letters {
 =cut  =cut
   
 sub scantron_parse_scanline {  sub scantron_parse_scanline {
     my ($line,$whichline,$scantron_config,$scan_data,$just_header)=@_;      my ($line,$whichline,$scantron_config,$scan_data,$just_header,$idmap,
           $randomorder,$randompick,$sequence,$master_seq,$symb_to_resource,
           $partids_by_symb,$orderedforcode,$respnumlookup,$startline,$totalref)=@_;
   
     my %record;      my %record;
     my $lastpos = $env{'form.scantron_maxbubble'}*$$scantron_config{'Qlength'};      my $data=substr($line,0,$$scantron_config{'Qstart'}-1); # stuff before answers
     my $questions=substr($line,$$scantron_config{'Qstart'}-1,$lastpos);  # Answers  
     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')) {
  if ($$scantron_config{'CODElocation'} < 0 ||   if ($$scantron_config{'CODElocation'} < 0 ||
Line 5721  sub scantron_parse_scanline { Line 5955  sub scantron_parse_scanline {
     my $questnum=0;      my $questnum=0;
     my $ansnum  =1; # Multiple 'answer lines'/question.      my $ansnum  =1; # Multiple 'answer lines'/question.
   
       my $lastpos = $env{'form.scantron_maxbubble'}*$$scantron_config{'Qlength'};
       if ($randompick || $randomorder) {
           my $total = &get_respnum_lookups($sequence,$scan_data,$idmap,$line,\%record,
                                            $master_seq,$symb_to_resource,
                                            $partids_by_symb,$orderedforcode,
                                            $respnumlookup,$startline);
           if ($total) {
               $lastpos = $total*$$scantron_config{'Qlength'}; 
           }
           if (ref($totalref)) {
               $$totalref = $total;
           }
       }
       my $questions=substr($line,$$scantron_config{'Qstart'}-1,$lastpos);  # Answers
     chomp($questions); # Get rid of any trailing \n.      chomp($questions); # Get rid of any trailing \n.
     $questions =~ s/\r$//;      # Get rid of trailing \r too (MAC or Win uploads).      $questions =~ s/\r$//;      # Get rid of trailing \r too (MAC or Win uploads).
     while (length($questions)) {      while (length($questions)) {
  my $answers_needed = $bubble_lines_per_response{$questnum};          my $answers_needed;
           if (($randompick || $randomorder) && (ref($respnumlookup) eq 'HASH')) {
               $answers_needed = $bubble_lines_per_response{$respnumlookup->{$questnum}};
           } else {
       $answers_needed = $bubble_lines_per_response{$questnum};
           }
         my $answer_length  = ($$scantron_config{'Qlength'} * $answers_needed)          my $answer_length  = ($$scantron_config{'Qlength'} * $answers_needed)
                              || 1;                               || 1;
         $questnum++;          $questnum++;
Line 5733  sub scantron_parse_scanline { Line 5986  sub scantron_parse_scanline {
         $questions       = substr($questions,$answer_length);          $questions       = substr($questions,$answer_length);
         if (length($currentquest) < $answer_length) { next; }          if (length($currentquest) < $answer_length) { next; }
   
         if ($subdivided_bubble_lines{$questnum-1} =~ /,/) {          my $subdivided;
           if (($randompick || $randomorder) && (ref($respnumlookup) eq 'HASH')) {
               $subdivided = $subdivided_bubble_lines{$respnumlookup->{$questnum-1}};
           } else {
               $subdivided = $subdivided_bubble_lines{$questnum-1};
           }
           if ($subdivided =~ /,/) {
             my $subquestnum = 1;              my $subquestnum = 1;
             my $subquestions = $currentquest;              my $subquestions = $currentquest;
             my @subanswers_needed =               my @subanswers_needed = split(/,/,$subdivided);
                 split(/,/,$subdivided_bubble_lines{$questnum-1});    
             foreach my $subans (@subanswers_needed) {              foreach my $subans (@subanswers_needed) {
                 my $subans_length =                  my $subans_length =
                     ($$scantron_config{'Qlength'} * $subans)  || 1;                      ($$scantron_config{'Qlength'} * $subans)  || 1;
Line 5748  sub scantron_parse_scanline { Line 6006  sub scantron_parse_scanline {
                     ($$scantron_config{'Qon'} eq 'number')) {                      ($$scantron_config{'Qon'} eq 'number')) {
                     $ansnum = &scantron_validator_lettnum($ansnum,                       $ansnum = &scantron_validator_lettnum($ansnum, 
                         $questnum,$quest_id,$subans,$currsubquest,$whichline,                          $questnum,$quest_id,$subans,$currsubquest,$whichline,
                         \@alphabet,\%record,$scantron_config,$scan_data);                          \@alphabet,\%record,$scantron_config,$scan_data,
                           $randomorder,$randompick,$respnumlookup);
                 } else {                  } else {
                     $ansnum = &scantron_validator_positional($ansnum,                      $ansnum = &scantron_validator_positional($ansnum,
                         $questnum,$quest_id,$subans,$currsubquest,$whichline,                        \@alphabet,\%record,$scantron_config,$scan_data);                          $questnum,$quest_id,$subans,$currsubquest,$whichline,
                           \@alphabet,\%record,$scantron_config,$scan_data,
                           $randomorder,$randompick,$respnumlookup);
                 }                  }
                 $subquestnum ++;                  $subquestnum ++;
             }              }
Line 5760  sub scantron_parse_scanline { Line 6021  sub scantron_parse_scanline {
                 ($$scantron_config{'Qon'} eq 'number')) {                  ($$scantron_config{'Qon'} eq 'number')) {
                 $ansnum = &scantron_validator_lettnum($ansnum,$questnum,                  $ansnum = &scantron_validator_lettnum($ansnum,$questnum,
                     $quest_id,$answers_needed,$currentquest,$whichline,                      $quest_id,$answers_needed,$currentquest,$whichline,
                     \@alphabet,\%record,$scantron_config,$scan_data);                      \@alphabet,\%record,$scantron_config,$scan_data,
                       $randomorder,$randompick,$respnumlookup);
             } else {              } else {
                 $ansnum = &scantron_validator_positional($ansnum,$questnum,                  $ansnum = &scantron_validator_positional($ansnum,$questnum,
                     $quest_id,$answers_needed,$currentquest,$whichline,                      $quest_id,$answers_needed,$currentquest,$whichline,
                     \@alphabet,\%record,$scantron_config,$scan_data);                      \@alphabet,\%record,$scantron_config,$scan_data,
                       $randomorder,$randompick,$respnumlookup);
             }              }
         }          }
     }      }
Line 5772  sub scantron_parse_scanline { Line 6035  sub scantron_parse_scanline {
     return \%record;      return \%record;
 }  }
   
   sub get_master_seq {
       my ($resources,$master_seq,$symb_to_resource) = @_;
       return unless ((ref($resources) eq 'ARRAY') && (ref($master_seq) eq 'ARRAY') && 
                      (ref($symb_to_resource) eq 'HASH'));
       my $resource_error;
       foreach my $resource (@{$resources}) {
           my $ressymb;
           if (ref($resource)) {
               $ressymb = $resource->symb();
               push(@{$master_seq},$ressymb);
               $symb_to_resource->{$ressymb} = $resource;
           } else {
               $resource_error = 1;
               last;
           }
       }
       return $resource_error;
   }
   
   sub get_respnum_lookups {
       my ($sequence,$scan_data,$idmap,$line,$record,$master_seq,$symb_to_resource,
           $partids_by_symb,$orderedforcode,$respnumlookup,$startline) = @_;
       return unless ((ref($record) eq 'HASH') && (ref($master_seq) eq 'ARRAY') &&
                      (ref($symb_to_resource) eq 'HASH') && (ref($partids_by_symb) eq 'HASH') &&
                      (ref($orderedforcode) eq 'HASH') && (ref($respnumlookup) eq 'HASH') &&
                      (ref($startline) eq 'HASH'));
       my ($user,$scancode);
       if ((exists($record->{'scantron.CODE'})) &&
           (&Apache::lonnet::validCODE($record->{'scantron.CODE'}))) {
           $scancode = $record->{'scantron.CODE'};
       } else {
           $user = &scantron_find_student($record,$scan_data,$idmap,$line);
       }
       my @mapresources =
           &users_order($user,$scancode,$sequence,$master_seq,$symb_to_resource,
                        $orderedforcode);
       my $total = 0;
       my $count = 0;
       foreach my $resource (@mapresources) {
           my $id = $resource->id();
           my $symb = $resource->symb();
           if (ref($partids_by_symb->{$symb}) eq 'ARRAY') {
               foreach my $partid (@{$partids_by_symb->{$symb}}) {
                   my $respnum = $masterseq_id_responsenum{$id.'_'.$partid};
                   if ($respnum ne '') {
                       $respnumlookup->{$count} = $respnum;
                       $startline->{$count} = $total;
                       $total += $bubble_lines_per_response{$respnum};
                       $count ++;
                   }
               }
           }
       }
       return $total;
   }
   
 sub scantron_validator_lettnum {  sub scantron_validator_lettnum {
     my ($ansnum,$questnum,$quest_id,$answers_needed,$currquest,$whichline,      my ($ansnum,$questnum,$quest_id,$answers_needed,$currquest,$whichline,
         $alphabet,$record,$scantron_config,$scan_data) = @_;          $alphabet,$record,$scantron_config,$scan_data,$randomorder,
           $randompick,$respnumlookup) = @_;
   
     # Qon 'letter' implies for each slot in currquest we have:      # Qon 'letter' implies for each slot in currquest we have:
     #    ? or * for doubles, a letter in A-Z for a bubble, and      #    ? or * for doubles, a letter in A-Z for a bubble, and
Line 5793  sub scantron_validator_lettnum { Line 6113  sub scantron_validator_lettnum {
         $matchon = '\d';          $matchon = '\d';
     }      }
     my $occurrences = 0;      my $occurrences = 0;
     if (($responsetype_per_response{$questnum-1} eq 'essayresponse') ||      my $responsenum = $questnum-1;
         ($responsetype_per_response{$questnum-1} eq 'formularesponse') ||      if (($randompick || $randomorder) && (ref($respnumlookup) eq 'HASH')) {
         ($responsetype_per_response{$questnum-1} eq 'stringresponse') ||         $responsenum = $respnumlookup->{$questnum-1} 
         ($responsetype_per_response{$questnum-1} eq 'imageresponse') ||      }
         ($responsetype_per_response{$questnum-1} eq 'reactionresponse') ||      if (($responsetype_per_response{$responsenum} eq 'essayresponse') ||
         ($responsetype_per_response{$questnum-1} eq 'organicresponse')) {          ($responsetype_per_response{$responsenum} eq 'formularesponse') ||
           ($responsetype_per_response{$responsenum} eq 'stringresponse') ||
           ($responsetype_per_response{$responsenum} eq 'imageresponse') ||
           ($responsetype_per_response{$responsenum} eq 'reactionresponse') ||
           ($responsetype_per_response{$responsenum} eq 'organicresponse')) {
         my @singlelines = split('',$currquest);          my @singlelines = split('',$currquest);
         foreach my $entry (@singlelines) {          foreach my $entry (@singlelines) {
             $occurrences = &occurence_count($entry,$matchon);              $occurrences = &occurence_count($entry,$matchon);
             if ($occurrences > 1) {              if ($occurrences > 1) {
                 last;                  last;
             }              }
         }           }
     } else {      } else {
         $occurrences = &occurence_count($currquest,$matchon);           $occurrences = &occurence_count($currquest,$matchon); 
     }      }
Line 5853  sub scantron_validator_lettnum { Line 6177  sub scantron_validator_lettnum {
   
 sub scantron_validator_positional {  sub scantron_validator_positional {
     my ($ansnum,$questnum,$quest_id,$answers_needed,$currquest,      my ($ansnum,$questnum,$quest_id,$answers_needed,$currquest,
         $whichline,$alphabet,$record,$scantron_config,$scan_data) = @_;          $whichline,$alphabet,$record,$scantron_config,$scan_data,
           $randomorder,$randompick,$respnumlookup) = @_;
   
     # Otherwise there's a positional notation;      # Otherwise there's a positional notation;
     # each bubble line requires Qlength items, and there are filled in      # each bubble line requires Qlength items, and there are filled in
Line 5895  sub scantron_validator_positional { Line 6220  sub scantron_validator_positional {
         #  record all the bubbles filled in as well as the          #  record all the bubbles filled in as well as the
         #  fact this response consists of multiple bubbles.          #  fact this response consists of multiple bubbles.
         #          #
         if (($responsetype_per_response{$questnum-1} eq 'essayresponse') ||          my $responsenum = $questnum-1;
             ($responsetype_per_response{$questnum-1} eq 'formularesponse') ||          if (($randompick || $randomorder) && (ref($respnumlookup) eq 'HASH')) {
             ($responsetype_per_response{$questnum-1} eq 'stringresponse') ||              $responsenum = $respnumlookup->{$questnum-1}
             ($responsetype_per_response{$questnum-1} eq 'imageresponse') ||          }
             ($responsetype_per_response{$questnum-1} eq 'reactionresponse') ||          if (($responsetype_per_response{$responsenum} eq 'essayresponse') ||
             ($responsetype_per_response{$questnum-1} eq 'organicresponse')) {              ($responsetype_per_response{$responsenum} eq 'formularesponse') ||
               ($responsetype_per_response{$responsenum} eq 'stringresponse') ||
               ($responsetype_per_response{$responsenum} eq 'imageresponse') ||
               ($responsetype_per_response{$responsenum} eq 'reactionresponse') ||
               ($responsetype_per_response{$responsenum} eq 'organicresponse')) {
             my $doubleerror = 0;              my $doubleerror = 0;
             while (($currquest >= $$scantron_config{'Qlength'}) &&               while (($currquest >= $$scantron_config{'Qlength'}) && 
                    (!$doubleerror)) {                     (!$doubleerror)) {
Line 6174  sub remember_current_skipped { Line 6503  sub remember_current_skipped {
 =item check_for_error  =item check_for_error
   
     Checks if there was an error when attempting to remove a specific      Checks if there was an error when attempting to remove a specific
     scantron_.. bubble sheet data file. Prints out an error if      scantron_.. bubblesheet data file. Prints out an error if
     something went wrong.      something went wrong.
   
 =cut  =cut
Line 6209  sub scantron_warning_screen { Line 6538  sub scantron_warning_screen {
     '<tr><td><b>'.&mt('List of CODES to validate against:').'</b></td><td><tt>'.      '<tr><td><b>'.&mt('List of CODES to validate against:').'</b></td><td><tt>'.
     $env{'form.scantron_CODElist'}.'</tt></td></tr>';      $env{'form.scantron_CODElist'}.'</tt></td></tr>';
     }      }
       my $lastbubblepoints;
       if ($env{'form.scantron_lastbubblepoints'} ne '') {
           $lastbubblepoints =
               '<tr><td><b>'.&mt('Hand-graded items: points from last bubble in row').'</b></td><td><tt>'.
               $env{'form.scantron_lastbubblepoints'}.'</tt></td></tr>';
       }
     return ('      return ('
 <p>  <p>
 <span class="LC_warning">  <span class="LC_warning">
Line 6217  sub scantron_warning_screen { Line 6552  sub scantron_warning_screen {
 <table>  <table>
 <tr><td><b>'.&mt('Sequence to be Graded:').'</b></td><td>'.$title.'</td></tr>  <tr><td><b>'.&mt('Sequence to be Graded:').'</b></td><td>'.$title.'</td></tr>
 <tr><td><b>'.&mt('Data File that will be used:').'</b></td><td><tt>'.$env{'form.scantron_selectfile'}.'</tt></td></tr>  <tr><td><b>'.&mt('Data File that will be used:').'</b></td><td><tt>'.$env{'form.scantron_selectfile'}.'</tt></td></tr>
 '.$CODElist.'  '.$CODElist.$lastbubblepoints.'
 </table>  </table>
 <p> '.&mt('If this information is correct, please click on \'[_1]\'.',&mt($button_text)).'<br />  <p> '.&mt("If this information is correct, please click on '[_1]'.",&mt($button_text)).'<br />
 '.&mt('If something is incorrect, please return to [_1]Grade/Manage/Review Bubblesheets[_2] to start over.','<a href="/adm/grades?symb='.$symb.'&command=scantron_selectphase" class="LC_info">','</a>').'</p>  '.&mt('If something is incorrect, please return to [_1]Grade/Manage/Review Bubblesheets[_2] to start over.','<a href="/adm/grades?symb='.$symb.'&command=scantron_selectphase" class="LC_info">','</a>').'</p>
   
 <br />  <br />
Line 6255  sub scantron_do_warning { Line 6590  sub scantron_do_warning {
  }    } 
     } else {      } else {
  my $warning=&scantron_warning_screen('Grading: Validate Records',$symb);   my $warning=&scantron_warning_screen('Grading: Validate Records',$symb);
           my $bubbledbyhand=&hand_bubble_option();
  $r->print('   $r->print('
 '.$warning.'  '.$warning.$bubbledbyhand.'
 <input type="submit" name="submit" value="'.&mt('Grading: Validate Records').'" />  <input type="submit" name="submit" value="'.&mt('Grading: Validate Records').'" />
 <input type="hidden" name="command" value="scantron_validate" />  <input type="hidden" name="command" value="scantron_validate" />
 ');  ');
Line 6298  SCANTRONFORM Line 6634  SCANTRONFORM
            '<input type="hidden" name="scantron.sub_bubblelines.'.$line.'" value="'.$env{"form.scantron.sub_bubblelines.$line"}.'" />'."\n";             '<input type="hidden" name="scantron.sub_bubblelines.'.$line.'" value="'.$env{"form.scantron.sub_bubblelines.$line"}.'" />'."\n";
        $chunk .=         $chunk .=
            '<input type="hidden" name="scantron.responsetype.'.$line.'" value="'.$env{"form.scantron.responsetype.$line"}.'" />'."\n";             '<input type="hidden" name="scantron.responsetype.'.$line.'" value="'.$env{"form.scantron.responsetype.$line"}.'" />'."\n";
          $chunk .=
              '<input type="hidden" name="scantron.residpart.'.$line.'" value="'.$env{"form.scantron.residpart.$line"}.'" />'."\n";
        $result .= $chunk;         $result .= $chunk;
        $line++;         $line++;
    }      }
     return $result;      return $result;
 }  }
   
Line 6308  SCANTRONFORM Line 6646  SCANTRONFORM
   
 =item scantron_validate_file  =item scantron_validate_file
   
     Dispatch routine for doing validation of a bubble sheet data file.      Dispatch routine for doing validation of a bubblesheet data file.
   
     Also processes any necessary information resets that need to      Also processes any necessary information resets that need to
     occur before validation begins (ignore previous corrections,      occur before validation begins (ignore previous corrections,
Line 6352  sub scantron_validate_file { Line 6690  sub scantron_validate_file {
         return '';          return '';
     }      }
     my $result=&scantron_form_start($max_bubble).$default_form_data;      my $result=&scantron_form_start($max_bubble).$default_form_data;
       if ($env{'form.scantron_lastbubblepoints'} ne '') {
           $result .= '<input type="hidden" name="scantron_lastbubblepoints" value="'.$env{'form.scantron_lastbubblepoints'}.'" />';
       }
     $r->print($result);      $r->print($result);
           
     my @validate_phases=( 'sequence',      my @validate_phases=( 'sequence',
Line 6369  sub scantron_validate_file { Line 6710  sub scantron_validate_file {
     while (!$stop && $currentphase < scalar(@validate_phases)) {      while (!$stop && $currentphase < scalar(@validate_phases)) {
  $r->print(&mt('Validating '.$validate_phases[$currentphase]).'<br />');   $r->print(&mt('Validating '.$validate_phases[$currentphase]).'<br />');
  $r->rflush();   $r->rflush();
        
  my $which="scantron_validate_".$validate_phases[$currentphase];   my $which="scantron_validate_".$validate_phases[$currentphase];
  {   {
     no strict 'refs';      no strict 'refs';
Line 6419  sub scantron_validate_file { Line 6761  sub scantron_validate_file {
   
 =item scantron_remove_file  =item scantron_remove_file
   
    Removes the requested bubble sheet data file, makes sure that     Removes the requested bubblesheet data file, makes sure that
    scantron_original_<filename> is never removed     scantron_original_<filename> is never removed
   
   
Line 6444  sub scantron_remove_file { Line 6786  sub scantron_remove_file {
   
 =item scantron_remove_scan_data  =item scantron_remove_scan_data
   
    Removes all scan_data correction for the requested bubble sheet     Removes all scan_data correction for the requested bubblesheet
    data file.  (In the case that both the are doing skipped records we need     data file.  (In the case that both the are doing skipped records we need
    to remember the old skipped lines for the time being so that element     to remember the old skipped lines for the time being so that element
    persists for a while.)     persists for a while.)
Line 6481  sub scantron_remove_scan_data { Line 6823  sub scantron_remove_scan_data {
   
 =item scantron_getfile  =item scantron_getfile
   
     Fetches the requested bubble sheet data file (all 3 versions), and      Fetches the requested bubblesheet data file (all 3 versions), and
     the scan_data hash      the scan_data hash
       
   Arguments:    Arguments:
Line 6581  sub lonnet_putfile { Line 6923  sub lonnet_putfile {
   
 =item scantron_putfile  =item scantron_putfile
   
     Stores the current version of the bubble sheet data files, and the      Stores the current version of the bubblesheet data files, and the
     scan_data hash. (Does not modify the original version only the      scan_data hash. (Does not modify the original version only the
     corrected and skipped versions.      corrected and skipped versions.
   
Line 6675  sub get_todo_count { Line 7017  sub get_todo_count {
   
 =item scantron_put_line  =item scantron_put_line
   
     Updates the 'corrected' or 'skipped' versions of the bubble sheet      Updates the 'corrected' or 'skipped' versions of the bubblesheet
     data file.      data file.
   
  Arguments:   Arguments:
Line 6777  sub scantron_validate_sequence { Line 7119  sub scantron_validate_sequence {
  my @resources=   my @resources=
     $navmap->retrieveResources($map,\&scantron_filter_not_exam,1,0);      $navmap->retrieveResources($map,\&scantron_filter_not_exam,1,0);
  if (@resources) {   if (@resources) {
     $r->print("<p>".&mt('Some resources in the sequence currently are not set to exam mode. Grading these resources currently may not work correctly.')."</p>");      $r->print(
                   '<p class="LC_warning">'
                  .&mt('Some resources in the sequence currently are not set to'
                      .' bubblesheet exam mode. Grading these resources currently may not'
                      .' work correctly.')
                  .'</p>'
               );
     return (1,$currentphase);      return (1,$currentphase);
  }   }
     }      }
Line 6858  sub scantron_validate_ID { Line 7206  sub scantron_validate_ID {
   
   
 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,
           $randomorder,$randompick,$respnumlookup,$startline)=@_;
 #FIXME in the case of a duplicated ID the previous line, probably need  #FIXME in the case of a duplicated ID the previous line, probably need
 #to show both the current line and the previous one and allow skipping  #to show both the current line and the previous one and allow skipping
 #the previous one or the current one  #the previous one or the current one
   
     if ( $$scan_record{'scantron.PaperID'} =~ /\S/) {      if ( $$scan_record{'scantron.PaperID'} =~ /\S/) {
  $r->print("<p>".&mt("<b>An error was detected ($error)</b>".          $r->print(
     " for PaperID <tt>[_1]</tt>",              '<p class="LC_warning">'
     $$scan_record{'scantron.PaperID'})."</p> \n");             .&mt('An error was detected ([_1]) for PaperID [_2]',
     } else {                  "<b>$error</b>",
  $r->print("<p>".&mt("<b>An error was detected ($error)</b>".                  '<tt>'.$$scan_record{'scantron.PaperID'}.'</tt>')
     " in scanline [_1] <pre>[_2]</pre>",             ."</p> \n");
     $i,$line)."</p> \n");      } else {
     }          $r->print(
     my $message="<p>".&mt("The ID on the form is  <tt>[_1]</tt><br />".              '<p class="LC_warning">'
   "The name on the paper is [_2],[_3]",             .&mt('An error was detected ([_1]) in scanline [_2] [_3]',
   $$scan_record{'scantron.ID'},                  "<b>$error</b>", $i, "<pre>$line</pre>")
   $$scan_record{'scantron.LastName'},             ."</p> \n");
   $$scan_record{'scantron.FirstName'})."</p>";      }
       my $message =
           '<p>'
          .&mt('The ID on the form is [_1]',
               "<tt>$$scan_record{'scantron.ID'}</tt>")
          .'<br />'
          .&mt('The name on the paper is [_1], [_2]',
               $$scan_record{'scantron.LastName'},
               $$scan_record{'scantron.FirstName'})
          .'</p>';
   
     $r->print('<input type="hidden" name="scantron_corrections" value="'.$error.'" />'."\n");      $r->print('<input type="hidden" name="scantron_corrections" value="'.$error.'" />'."\n");
     $r->print('<input type="hidden" name="scantron_line" value="'.$i.'" />'."\n");      $r->print('<input type="hidden" name="scantron_line" value="'.$i.'" />'."\n");
Line 6886  sub scantron_get_correction { Line 7244  sub scantron_get_correction {
   
     if ($error =~ /ID$/) {      if ($error =~ /ID$/) {
  if ($error eq 'incorrectID') {   if ($error eq 'incorrectID') {
     $r->print("<p>".&mt("The encoded ID is not in the classlist").              $r->print('<p class="LC_warning">'.&mt("The encoded ID is not in the classlist").
       "</p>\n");        "</p>\n");
  } elsif ($error eq 'duplicateID') {   } elsif ($error eq 'duplicateID') {
     $r->print("<p>".&mt("The encoded ID has also been used by a previous paper [_1]",$arg)."</p>\n");              $r->print('<p class="LC_warning">'.&mt("The encoded ID has also been used by a previous paper [_1]",$arg)."</p>\n");
  }   }
  $r->print($message);   $r->print($message);
  $r->print("<p>".&mt("How should I handle this?")." <br /> \n");   $r->print("<p>".&mt("How should I handle this?")." <br /> \n");
Line 6899  sub scantron_get_correction { Line 7257  sub scantron_get_correction {
  $r->print(&Apache::loncommon::selectstudent_link('scantronupload',   $r->print(&Apache::loncommon::selectstudent_link('scantronupload',
        'scantron_username','scantron_domain'));         'scantron_username','scantron_domain'));
  $r->print(": <input type='text' name='scantron_username' value='' />");   $r->print(": <input type='text' name='scantron_username' value='' />");
  $r->print("\n@".   $r->print("\n:\n".
  &Apache::loncommon::select_dom_form($env{'request.role.domain'},'scantron_domain'));   &Apache::loncommon::select_dom_form($env{'request.role.domain'},'scantron_domain'));
   
  $r->print('</li>');   $r->print('</li>');
     } elsif ($error =~ /CODE$/) {      } elsif ($error =~ /CODE$/) {
  if ($error eq 'incorrectCODE') {   if ($error eq 'incorrectCODE') {
     $r->print("<p>".&mt("The encoded CODE is not in the list of possible CODEs.")."</p>\n");      $r->print('<p class="LC_warning">'.&mt("The encoded CODE is not in the list of possible CODEs.")."</p>\n");
  } elsif ($error eq 'duplicateCODE') {   } elsif ($error eq 'duplicateCODE') {
     $r->print("<p>".&mt("The encoded CODE has also been used by a previous paper [_1], and CODEs are supposed to be unique.",join(', ',@{$arg}))."</p>\n");      $r->print('<p class="LC_warning">'.&mt("The encoded CODE has also been used by a previous paper [_1], and CODEs are supposed to be unique.",join(', ',@{$arg}))."</p>\n");
  }   }
  $r->print("<p>".&mt("The CODE on the form is  <tt>'[_1]'</tt>",   $r->print("<p>".&mt('The CODE on the form is [_1]',
     $$scan_record{'scantron.CODE'})."<br />\n");      "<tt>'$$scan_record{'scantron.CODE'}'</tt>")
                    ."</p>\n");
  $r->print($message);   $r->print($message);
  $r->print("<p>".&mt("How should I handle this?")." <br /> \n");   $r->print("<p>".&mt("How should I handle this?")."</p>\n");
  $r->print("\n<br /> ");   $r->print("\n<br /> ");
  my $i=0;   my $i=0;
  if ($error eq 'incorrectCODE'    if ($error eq 'incorrectCODE' 
Line 6939  sub scantron_get_correction { Line 7298  sub scantron_get_correction {
     $r->print("      $r->print("
     <label>      <label>
         <input type='radio' name='scantron_CODE_resolution' value='use_unfound'$checked />          <input type='radio' name='scantron_CODE_resolution' value='use_unfound'$checked />
        ".&mt("Use the CODE [_1] that is was on the paper, ignoring the error.",         ".&mt("Use the CODE [_1] that was on the paper, ignoring the error.",
      "<b><tt>".$$scan_record{'scantron.CODE'}."</tt></b>")."       "<b><tt>".$$scan_record{'scantron.CODE'}."</tt></b>")."
     </label>");      </label>");
     $r->print("\n<br />");      $r->print("\n<br />");
Line 6977  ENDSCRIPT Line 7336  ENDSCRIPT
      "</label><input type='text' size='8' name='scantron_CODE_newvalue' onfocus=\"javascript:change_radio('use_typed')\" onkeypress=\"javascript:change_radio('use_typed')\" />"));       "</label><input type='text' size='8' name='scantron_CODE_newvalue' onfocus=\"javascript:change_radio('use_typed')\" onkeypress=\"javascript:change_radio('use_typed')\" />"));
  $r->print("\n<br /><br />");   $r->print("\n<br /><br />");
     } elsif ($error eq 'doublebubble') {      } elsif ($error eq 'doublebubble') {
  $r->print("<p>".&mt("There have been multiple bubbles scanned for some question(s)")."</p>\n");   $r->print('<p class="LC_warning">'.&mt("There have been multiple bubbles scanned for some question(s)")."</p>\n");
   
  # The form field scantron_questions is acutally a list of line numbers.   # The form field scantron_questions is acutally a list of line numbers.
  # represented by this form so:   # represented by this form so:
   
  my $line_list = &questions_to_line_list($arg);   my $line_list = &questions_to_line_list($arg,$randomorder,$randompick,
                                                   $respnumlookup,$startline);
   
  $r->print('<input type="hidden" name="scantron_questions" value="'.   $r->print('<input type="hidden" name="scantron_questions" value="'.
   $line_list.'" />');    $line_list.'" />');
Line 6990  ENDSCRIPT Line 7350  ENDSCRIPT
  $r->print("<p>".&mt("Please indicate which bubble should be used for grading")."</p>");   $r->print("<p>".&mt("Please indicate which bubble should be used for grading")."</p>");
  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,
                                                      $randomorder,$randompick,
                                                      $respnumlookup,$startline);
             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') {
  $r->print("<p>".&mt("There have been <b>no</b> bubbles scanned for some question(s)")."</p>\n");   $r->print('<p class="LC_warning">'.&mt("There have been [_1]no[_2] bubbles scanned for some question(s)",'<b>','</b>')."</p>\n");
  $r->print($message);   $r->print($message);
  $r->print("<p>".&mt("Please indicate which bubble should be used for grading.")."</p>");   $r->print("<p>".&mt("Please indicate which bubble should be used for grading.")."</p>");
  $r->print(&mt("Some questions have no scanned bubbles.")."\n");   $r->print(&mt("Some questions have no scanned bubbles.")."\n");
Line 7003  ENDSCRIPT Line 7365  ENDSCRIPT
  # The form field scantron_questions is actually a list of line numbers not   # The form field scantron_questions is actually a list of line numbers not
  # a list of question numbers. Therefore:   # a list of question numbers. Therefore:
  #   #
   
  my $line_list = &questions_to_line_list($arg);   my $line_list = &questions_to_line_list($arg,$randomorder,$randompick,
                                                   $respnumlookup,$startline);
   
  $r->print('<input type="hidden" name="scantron_questions" value="'.   $r->print('<input type="hidden" name="scantron_questions" value="'.
   $line_list.'" />');    $line_list.'" />');
  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,
                                                      $randomorder,$randompick,
                                                      $respnumlookup,$startline);
             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));
Line 7061  used to fill in the scantron_questions f Line 7426  used to fill in the scantron_questions f
   
   Arguments:    Arguments:
      questions    - Reference to an array of questions.       questions    - Reference to an array of questions.
        randomorder  - True if randomorder in use.
        randompick   - True if randompick in use.
        respnumlookup - Reference to HASH mapping question numbers in bubble lines
                        for current line to question number used for same question
                        in "Master Seqence" (as seen by Course Coordinator).
        startline    - Reference to hash where key is question number (0 is first)
                       and key is number of first bubble line for current student
                       or code-based randompick and/or randomorder.
   
 =cut  =cut
   
   
 sub questions_to_line_list {  sub questions_to_line_list {
     my ($questions) = @_;      my ($questions,$randomorder,$randompick,$respnumlookup,$startline) = @_;
     my @lines;      my @lines;
   
     foreach my $item (@{$questions}) {      foreach my $item (@{$questions}) {
Line 7075  sub questions_to_line_list { Line 7448  sub questions_to_line_list {
         if ($item =~ /^(\d+)\.(\d+)$/) {          if ($item =~ /^(\d+)\.(\d+)$/) {
             $question = $1;              $question = $1;
             my $subquestion = $2;              my $subquestion = $2;
             $first = $first_bubble_line{$question-1} + 1;              my $responsenum = $question-1;
             my @subans = split(/,/,$subdivided_bubble_lines{$question-1});              if (($randomorder || $randompick) && (ref($respnumlookup) eq 'HASH')) {
                   $responsenum = $respnumlookup->{$question-1};
                   if (ref($startline) eq 'HASH') {
                       $first = $startline->{$question-1} + 1;
                   }
               } else {
                   $first = $first_bubble_line{$responsenum} + 1;
               }
               my @subans = split(/,/,$subdivided_bubble_lines{$responsenum});
             my $subcount = 1;              my $subcount = 1;
             while ($subcount<$subquestion) {              while ($subcount<$subquestion) {
                 $first += $subans[$subcount-1];                  $first += $subans[$subcount-1];
Line 7084  sub questions_to_line_list { Line 7465  sub questions_to_line_list {
             }              }
             $count = $subans[$subquestion-1];              $count = $subans[$subquestion-1];
         } else {          } else {
     $first   = $first_bubble_line{$question-1} + 1;              my $responsenum = $question-1;
     $count   = $bubble_lines_per_response{$question-1};              if (($randomorder || $randompick) && (ref($respnumlookup) eq 'HASH')) {
                   $responsenum = $respnumlookup->{$question-1};
                   if (ref($startline) eq 'HASH') {
                       $first = $startline->{$question-1} + 1;
                   }
               } else {
                   $first = $first_bubble_line{$responsenum} + 1;
               }
       $count   = $bubble_lines_per_response{$responsenum};
         }          }
         $last = $first+$count-1;          $last = $first+$count-1;
         push(@lines, ($first..$last));          push(@lines, ($first..$last));
Line 7107  for multi and missing bubble cases). Line 7496  for multi and missing bubble cases).
    $scan_config - The scantron file configuration hash.     $scan_config - The scantron file configuration hash.
    $scan_record - Reference to the hash that has the the parsed scanlines.     $scan_record - Reference to the hash that has the the parsed scanlines.
    $error       - Type of error     $error       - Type of error
      $randomorder - True if randomorder in use.
      $randompick  - True if randompick in use.
      $respnumlookup - Reference to HASH mapping question numbers in bubble lines
                       for current line to question number used for same question
                       in "Master Seqence" (as seen by Course Coordinator).
      $startline   - Reference to hash where key is question number (0 is first)
                     and value is number of first bubble line for current student
                     or code-based randompick and/or randomorder.
   
   
  Implicit inputs:   Implicit inputs:
    %bubble_lines_per_response   - Starting line numbers for each question.     %bubble_lines_per_response   - Starting line numbers for each question.
Line 7131  for multi and missing bubble cases). Line 7529  for multi and missing bubble cases).
 =cut  =cut
   
 sub prompt_for_corrections {  sub prompt_for_corrections {
     my ($r, $question, $scan_config, $scan_record, $error) = @_;      my ($r, $question, $scan_config, $scan_record, $error, $randomorder,
           $randompick, $respnumlookup, $startline) = @_;
     my ($current_line,$lines);      my ($current_line,$lines);
     my @linenums;      my @linenums;
     my $questionnum = $question;      my $questionnum = $question;
       my ($first,$responsenum);
     if ($question =~ /^(\d+)\.(\d+)$/) {      if ($question =~ /^(\d+)\.(\d+)$/) {
         $question = $1;          $question = $1;
         $current_line = $first_bubble_line{$question-1} + 1 ;  
         my $subquestion = $2;          my $subquestion = $2;
         my @subans = split(/,/,$subdivided_bubble_lines{$question-1});          if (($randomorder || $randompick) && (ref($respnumlookup) eq 'HASH')) {
               $responsenum = $respnumlookup->{$question-1};
               if (ref($startline) eq 'HASH') {
                   $first = $startline->{$question-1};
               }
           } else {
               $responsenum = $question-1;
               $first = $first_bubble_line{$responsenum} + 1;
           }
           $current_line = $first + 1 ;
           my @subans = split(/,/,$subdivided_bubble_lines{$responsenum});
         my $subcount = 1;          my $subcount = 1;
         while ($subcount<$subquestion) {          while ($subcount<$subquestion) {
             $current_line += $subans[$subcount-1];              $current_line += $subans[$subcount-1];
Line 7147  sub prompt_for_corrections { Line 7556  sub prompt_for_corrections {
         }          }
         $lines = $subans[$subquestion-1];          $lines = $subans[$subquestion-1];
     } else {      } else {
         $current_line = $first_bubble_line{$question-1} + 1 ;          if (($randomorder || $randompick) && (ref($respnumlookup) eq 'HASH')) {
         $lines        = $bubble_lines_per_response{$question-1};              $responsenum = $respnumlookup->{$question-1};
               if (ref($startline) eq 'HASH') { 
                   $first = $startline->{$question-1};
               }
           } else {
               $responsenum = $question-1;
               $first = $first_bubble_line{$responsenum};
           }
           $current_line = $first + 1;
           $lines        = $bubble_lines_per_response{$responsenum};
     }      }
     if ($lines > 1) {      if ($lines > 1) {
         $r->print(&mt('The group of bubble lines below responds to a single question.').'<br />');          $r->print(&mt('The group of bubble lines below responds to a single question.').'<br />');
         if (($responsetype_per_response{$question-1} eq 'essayresponse') ||          if (($responsetype_per_response{$responsenum} eq 'essayresponse') ||
             ($responsetype_per_response{$question-1} eq 'formularesponse') ||              ($responsetype_per_response{$responsenum} eq 'formularesponse') ||
             ($responsetype_per_response{$question-1} eq 'stringresponse') ||              ($responsetype_per_response{$responsenum} eq 'stringresponse') ||
             ($responsetype_per_response{$question-1} eq 'imageresponse') ||              ($responsetype_per_response{$responsenum} eq 'imageresponse') ||
             ($responsetype_per_response{$question-1} eq 'reactionresponse') ||              ($responsetype_per_response{$responsenum} eq 'reactionresponse') ||
             ($responsetype_per_response{$question-1} eq 'organicresponse')) {              ($responsetype_per_response{$responsenum} eq 'organicresponse')) {
             $r->print(&mt("Although this particular question type requires handgrading, the instructions for this question in the exam directed students to leave [quant,_1,line] blank on their bubblesheets.",$lines).'<br /><br />'.&mt('A non-zero score can be assigned to the student during bubblesheet grading by selecting a bubble in at least one line.').'<br />'.&mt('The score for this question will be a sum of the numeric values for the selected bubbles from each line, where A=1 point, B=2 points etc.').'<br />'.&mt("To assign a score of zero for this question, mark all lines as 'No bubble'.").'<br /><br />');              $r->print(
                   &mt("Although this particular question type requires handgrading, the instructions for this question in the bubblesheet exam directed students to leave [quant,_1,line] blank on their bubblesheets.",$lines)
                  .'<br /><br />'
                  .&mt('A non-zero score can be assigned to the student during bubblesheet grading by selecting a bubble in at least one line.')
                  .'<br />'
                  .&mt('The score for this question will be a sum of the numeric values for the selected bubbles from each line, where A=1 point, B=2 points etc.')
                  .'<br />'
                  .&mt("To assign a score of zero for this question, mark all lines as 'No bubble'.")
                  .'<br /><br />'
               );
         } else {          } else {
             $r->print(&mt("Select at most one bubble in a single line and select 'No Bubble' in all the other lines. ")."<br />");              $r->print(&mt("Select at most one bubble in a single line and select 'No Bubble' in all the other lines. ")."<br />");
         }          }
     }      }
     for (my $i =0; $i < $lines; $i++) {      for (my $i =0; $i < $lines; $i++) {
         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++;
Line 7419  sub scantron_validate_doublebubble { Line 7846  sub scantron_validate_doublebubble {
     #get student info      #get student info
     my $classlist=&Apache::loncoursedata::get_classlist();      my $classlist=&Apache::loncoursedata::get_classlist();
     my %idmap=&username_to_idmap($classlist);      my %idmap=&username_to_idmap($classlist);
       my (undef,undef,$sequence)=
           &Apache::lonnet::decode_symb($env{'form.selectpage'});
   
     #get scantron line setup      #get scantron line setup
     my %scantron_config=&get_scantron_config($env{'form.scantron_format'});      my %scantron_config=&get_scantron_config($env{'form.scantron_format'});
     my ($scanlines,$scan_data)=&scantron_getfile();      my ($scanlines,$scan_data)=&scantron_getfile();
   
       my $navmap = Apache::lonnavmaps::navmap->new();
       unless (ref($navmap)) {
           $r->print(&navmap_errormsg());
           return(1,$currentphase);
       }
       my $map=$navmap->getResourceByUrl($sequence);
       my @resources=$navmap->retrieveResources($map,\&scantron_filter,1,0);
       my ($randomorder,$randompick,@master_seq,%symb_to_resource,%grader_partids_by_symb,
           %grader_randomlists_by_symb,%orderedforcode,%respnumlookup,%startline);
       my $bubbles_per_row = &bubblesheet_bubbles_per_row(\%scantron_config);
   
     my $nav_error;      my $nav_error;
       if (ref($map)) {
           $randomorder = $map->randomorder();
           $randompick = $map->randompick();
           if ($randomorder || $randompick) {
               $nav_error = &get_master_seq(\@resources,\@master_seq,\%symb_to_resource);
               if ($nav_error) {
                   $r->print(&navmap_errormsg());
                   return(1,$currentphase);
               }
               &graders_resources_pass(\@resources,\%grader_partids_by_symb,
                                       \%grader_randomlists_by_symb,$bubbles_per_row);
           }
       } else {
           $r->print(&navmap_errormsg());
           return(1,$currentphase);
       }
   
     &scantron_get_maxbubble(\$nav_error,\%scantron_config); # parse needs the bubble line array.      &scantron_get_maxbubble(\$nav_error,\%scantron_config); # parse needs the bubble line array.
     if ($nav_error) {      if ($nav_error) {
         $r->print(&navmap_errormsg());          $r->print(&navmap_errormsg());
Line 7434  sub scantron_validate_doublebubble { Line 7892  sub scantron_validate_doublebubble {
  my $line=&scantron_get_line($scanlines,$scan_data,$i);   my $line=&scantron_get_line($scanlines,$scan_data,$i);
  if ($line=~/^[\s\cz]*$/) { next; }   if ($line=~/^[\s\cz]*$/) { next; }
  my $scan_record=&scantron_parse_scanline($line,$i,\%scantron_config,   my $scan_record=&scantron_parse_scanline($line,$i,\%scantron_config,
  $scan_data);   $scan_data,undef,\%idmap,$randomorder,
                                                    $randompick,$sequence,\@master_seq,
                                                    \%symb_to_resource,\%grader_partids_by_symb,
                                                    \%orderedforcode,\%respnumlookup,\%startline);
  if (!defined($$scan_record{'scantron.doubleerror'})) { next; }   if (!defined($$scan_record{'scantron.doubleerror'})) { next; }
  &scantron_get_correction($r,$i,$scan_record,\%scantron_config,$line,   &scantron_get_correction($r,$i,$scan_record,\%scantron_config,$line,
  'doublebubble',   'doublebubble',
  $$scan_record{'scantron.doubleerror'});   $$scan_record{'scantron.doubleerror'},
                                    $randomorder,$randompick,\%respnumlookup,\%startline);
     return (1,$currentphase);      return (1,$currentphase);
     }      }
     return (0,$currentphase+1);      return (0,$currentphase+1);
Line 7477  sub scantron_get_maxbubble { Line 7939  sub scantron_get_maxbubble {
     %first_bubble_line         = ();      %first_bubble_line         = ();
     %subdivided_bubble_lines   = ();      %subdivided_bubble_lines   = ();
     %responsetype_per_response = ();      %responsetype_per_response = ();
       %masterseq_id_responsenum  = ();
   
     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 ($analysis,$parts) = &scantron_partids_tograde($resource,$cid,$uname,$udom,undef,$bubbles_per_row);          my $resid = $resource->id(); 
           my ($analysis,$parts) = &scantron_partids_tograde($resource,$cid,$uname,
                                                             $udom,undef,$bubbles_per_row);
         if ((ref($analysis) eq 'HASH') && (ref($parts) eq 'ARRAY')) {          if ((ref($analysis) eq 'HASH') && (ref($parts) eq 'ARRAY')) {
     foreach my $part_id (@{$parts}) {      foreach my $part_id (@{$parts}) {
                 my $lines;                  my $lines;
Line 7530  sub scantron_get_maxbubble { Line 7995  sub scantron_get_maxbubble {
         $bubble_lines_per_response{$response_number} = $lines;          $bubble_lines_per_response{$response_number} = $lines;
                 $responsetype_per_response{$response_number} =                   $responsetype_per_response{$response_number} = 
                     $analysis->{$part_id.'.type'};                      $analysis->{$part_id.'.type'};
                   $masterseq_id_responsenum{$resid.'_'.$part_id} = $response_number;  
         $response_number++;          $response_number++;
   
         $bubble_line +=  $lines;          $bubble_line +=  $lines;
Line 7562  sub scantron_validate_missingbubbles { Line 8028  sub scantron_validate_missingbubbles {
     #get student info      #get student info
     my $classlist=&Apache::loncoursedata::get_classlist();      my $classlist=&Apache::loncoursedata::get_classlist();
     my %idmap=&username_to_idmap($classlist);      my %idmap=&username_to_idmap($classlist);
       my (undef,undef,$sequence)=
           &Apache::lonnet::decode_symb($env{'form.selectpage'});
   
     #get scantron line setup      #get scantron line setup
     my %scantron_config=&get_scantron_config($env{'form.scantron_format'});      my %scantron_config=&get_scantron_config($env{'form.scantron_format'});
     my ($scanlines,$scan_data)=&scantron_getfile();      my ($scanlines,$scan_data)=&scantron_getfile();
   
       my $navmap = Apache::lonnavmaps::navmap->new();
       unless (ref($navmap)) {
           $r->print(&navmap_errormsg());
           return(1,$currentphase);
       }
   
       my $map=$navmap->getResourceByUrl($sequence);
       my @resources=$navmap->retrieveResources($map,\&scantron_filter,1,0);
       my ($randomorder,$randompick,@master_seq,%symb_to_resource,%grader_partids_by_symb,
           %grader_randomlists_by_symb,%orderedforcode,%respnumlookup,%startline);
       my $bubbles_per_row = &bubblesheet_bubbles_per_row(\%scantron_config);
   
     my $nav_error;      my $nav_error;
       if (ref($map)) {
           $randomorder = $map->randomorder();
           $randompick = $map->randompick();
           if ($randomorder || $randompick) {
               $nav_error = &get_master_seq(\@resources,\@master_seq,\%symb_to_resource);
               if ($nav_error) {
                   $r->print(&navmap_errormsg());
                   return(1,$currentphase);
               }
               &graders_resources_pass(\@resources,\%grader_partids_by_symb,
                                       \%grader_randomlists_by_symb,$bubbles_per_row);
           }
       } else {
           $r->print(&navmap_errormsg());
           return(1,$currentphase);
       }
   
   
     my $max_bubble=&scantron_get_maxbubble(\$nav_error,\%scantron_config);      my $max_bubble=&scantron_get_maxbubble(\$nav_error,\%scantron_config);
     if ($nav_error) {      if ($nav_error) {
           $r->print(&navmap_errormsg());
         return(1,$currentphase);          return(1,$currentphase);
     }      }
   
     if (!$max_bubble) { $max_bubble=2**31; }      if (!$max_bubble) { $max_bubble=2**31; }
     for (my $i=0;$i<=$scanlines->{'count'};$i++) {      for (my $i=0;$i<=$scanlines->{'count'};$i++) {
  my $line=&scantron_get_line($scanlines,$scan_data,$i);   my $line=&scantron_get_line($scanlines,$scan_data,$i);
  if ($line=~/^[\s\cz]*$/) { next; }   if ($line=~/^[\s\cz]*$/) { next; }
  my $scan_record=&scantron_parse_scanline($line,$i,\%scantron_config,   my $scan_record =
  $scan_data);              &scantron_parse_scanline($line,$i,\%scantron_config,$scan_data,undef,\%idmap,
        $randomorder,$randompick,$sequence,\@master_seq,
                                        \%symb_to_resource,\%grader_partids_by_symb,
                                        \%orderedforcode,\%respnumlookup,\%startline);
  if (!defined($$scan_record{'scantron.missingerror'})) { next; }   if (!defined($$scan_record{'scantron.missingerror'})) { next; }
  my @to_correct;   my @to_correct;
   
Line 7587  sub scantron_validate_missingbubbles { Line 8091  sub scantron_validate_missingbubbles {
             if ($missing =~ /^(\d+)\.(\d+)$/) {              if ($missing =~ /^(\d+)\.(\d+)$/) {
                my $question = $1;                 my $question = $1;
                my $subquestion = $2;                 my $subquestion = $2;
                if (!defined($first_bubble_line{$question -1})) { next; }                 my ($first,$responsenum);
                my $first = $first_bubble_line{$question-1};                 if ($randomorder || $randompick) {
                my @subans = split(/,/,$subdivided_bubble_lines{$question-1});                     $responsenum = $respnumlookup{$question-1};
                      $first = $startline{$question-1};
                  } else {
                      $responsenum = $question-1; 
                      $first = $first_bubble_line{$responsenum};
                  }
                  if (!defined($first)) { next; }
                  my @subans = split(/,/,$subdivided_bubble_lines{$responsenum});
                my $subcount = 1;                 my $subcount = 1;
                while ($subcount<$subquestion) {                 while ($subcount<$subquestion) {
                    $first += $subans[$subcount-1];                     $first += $subans[$subcount-1];
Line 7598  sub scantron_validate_missingbubbles { Line 8109  sub scantron_validate_missingbubbles {
                my $count = $subans[$subquestion-1];                 my $count = $subans[$subquestion-1];
                $lastbubble = $first + $count;                 $lastbubble = $first + $count;
             } else {              } else {
                 if (!defined($first_bubble_line{$missing - 1})) { next; }                 my ($first,$responsenum);
                 $lastbubble = $first_bubble_line{$missing - 1} + $bubble_lines_per_response{$missing - 1};                 if ($randomorder || $randompick) {
                      $responsenum = $respnumlookup{$missing-1};
                      $first = $startline{$missing-1};
                  } else {
                      $responsenum = $missing-1;
                      $first = $first_bubble_line{$responsenum};
                  }
                  if (!defined($first)) { next; }
                  $lastbubble = $first + $bubble_lines_per_response{$responsenum};
             }              }
             if ($lastbubble > $max_bubble) { next; }              if ($lastbubble > $max_bubble) { next; }
     push(@to_correct,$missing);      push(@to_correct,$missing);
  }   }
  if (@to_correct) {   if (@to_correct) {
     &scantron_get_correction($r,$i,$scan_record,\%scantron_config,      &scantron_get_correction($r,$i,$scan_record,\%scantron_config,
      $line,'missingbubble',\@to_correct);       $line,'missingbubble',\@to_correct,
                                        $randomorder,$randompick,\%respnumlookup,
                                        \%startline);
     return (1,$currentphase);      return (1,$currentphase);
  }   }
   
Line 7614  sub scantron_validate_missingbubbles { Line 8135  sub scantron_validate_missingbubbles {
     return (0,$currentphase+1);      return (0,$currentphase+1);
 }  }
   
   sub hand_bubble_option {
       my (undef, undef, $sequence) =
           &Apache::lonnet::decode_symb($env{'form.selectpage'});
       return if ($sequence eq '');
       my $navmap = Apache::lonnavmaps::navmap->new();
       unless (ref($navmap)) {
           return;
       }
       my $needs_hand_bubbles;
       my $map=$navmap->getResourceByUrl($sequence);
       my @resources=$navmap->retrieveResources($map,\&scantron_filter,1,0);
       foreach my $res (@resources) {
           if (ref($res)) {
               if ($res->is_problem()) {
                   my $partlist = $res->parts();
                   foreach my $part (@{ $partlist }) {
                       my @types = $res->responseType($part);
                       if (grep(/^(chem|essay|image|formula|math|string|functionplot)$/,@types)) {
                           $needs_hand_bubbles = 1;
                           last;
                       }
                   }
               }
           }
       }
       if ($needs_hand_bubbles) {
           my %scantron_config=&get_scantron_config($env{'form.scantron_format'});
           my $bubbles_per_row = &bubblesheet_bubbles_per_row(\%scantron_config);
           return &mt('The sequence to be graded contains response types which are handgraded.').'<p>'.
                  &mt('If you have already graded these by bubbling sheets to indicate points awarded, [_1]what point value is assigned to a filled last bubble in each row?','<br />').
                  '<label><input type="radio" name="scantron_lastbubblepoints" value="'.$bubbles_per_row.'" checked="checked" />'.&mt('[quant,_1,point]',$bubbles_per_row).'</label>&nbsp;'.&mt('or').'&nbsp;'.
                  '<label><input type="radio" name="scantron_lastbubblepoints" value="0"/>0 points</label></p>';
       }
       return;
   }
   
 sub scantron_process_students {  sub scantron_process_students {
     my ($r,$symb) = @_;      my ($r,$symb) = @_;
Line 7625  sub scantron_process_students { Line 8181  sub scantron_process_students {
     my $default_form_data=&defaultFormData($symb);      my $default_form_data=&defaultFormData($symb);
   
     my %scantron_config=&get_scantron_config($env{'form.scantron_format'});      my %scantron_config=&get_scantron_config($env{'form.scantron_format'});
     my $bubbles_per_row =      my $bubbles_per_row = &bubblesheet_bubbles_per_row(\%scantron_config); 
         &bubblesheet_bubbles_per_row(\%scantron_config);  
     my ($scanlines,$scan_data)=&scantron_getfile();      my ($scanlines,$scan_data)=&scantron_getfile();
     my $classlist=&Apache::loncoursedata::get_classlist();      my $classlist=&Apache::loncoursedata::get_classlist();
     my %idmap=&username_to_idmap($classlist);      my %idmap=&username_to_idmap($classlist);
Line 7634  sub scantron_process_students { Line 8189  sub scantron_process_students {
     unless (ref($navmap)) {      unless (ref($navmap)) {
         $r->print(&navmap_errormsg());          $r->print(&navmap_errormsg());
         return '';          return '';
     }    
     my $map=$navmap->getResourceByUrl($sequence);  
     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,$bubbles_per_row);  
     my $resource_error;  
     foreach my $resource (@resources) {  
         my $ressymb;  
         if (ref($resource)) {  
             $ressymb = $resource->symb();  
         } else {  
             $resource_error = 1;  
             last;  
         }  
         my ($analysis,$parts) =  
             &scantron_partids_tograde($resource,$env{'request.course.id'},  
                                       $env{'user.name'},$env{'user.domain'},1,$bubbles_per_row);  
         $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'};  
             }  
         }  
     }      }
     if ($resource_error) {      my $map=$navmap->getResourceByUrl($sequence);
       my ($randomorder,$randompick,@master_seq,%symb_to_resource,%grader_partids_by_symb,
           %grader_randomlists_by_symb);
       if (ref($map)) {
           $randomorder = $map->randomorder();
           $randompick = $map->randompick();
       } else {
         $r->print(&navmap_errormsg());          $r->print(&navmap_errormsg());
         return '';          return '';
     }      }
       my $nav_error;
       my @resources=$navmap->retrieveResources($map,\&scantron_filter,1,0);
       if ($randomorder || $randompick) {
           $nav_error = &get_master_seq(\@resources,\@master_seq,\%symb_to_resource);
           if ($nav_error) {
               $r->print(&navmap_errormsg());
               return '';
           }
       }
       &graders_resources_pass(\@resources,\%grader_partids_by_symb,
                               \%grader_randomlists_by_symb,$bubbles_per_row);
   
     my ($uname,$udom);      my ($uname,$udom);
     my $result= <<SCANTRONFORM;      my $result= <<SCANTRONFORM;
Line 7678  SCANTRONFORM Line 8225  SCANTRONFORM
           
     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);
     my %prog_state=&Apache::lonhtmlcommon::Create_PrgWin($r,'Bubblesheet Status',      my %prog_state=&Apache::lonhtmlcommon::Create_PrgWin($r,$count);
      'Bubblesheet Progress',$count,      &Apache::lonhtmlcommon::Update_PrgWin($r,\%prog_state,'Processing first student');
     'inline',undef,'scantronupload');  
     &Apache::lonhtmlcommon::Update_PrgWin($r,\%prog_state,  
   'Processing first student');  
     $r->print('<br />');      $r->print('<br />');
     my $start=&Time::HiRes::time();      my $start=&Time::HiRes::time();
     my $i=-1;      my $i=-1;
     my $started;      my $started;
   
     my $nav_error;  
     &scantron_get_maxbubble(\$nav_error,\%scantron_config); # Need the bubble lines array to parse.      &scantron_get_maxbubble(\$nav_error,\%scantron_config); # Need the bubble lines array to parse.
     if ($nav_error) {      if ($nav_error) {
         $r->print(&navmap_errormsg());          $r->print(&navmap_errormsg());
Line 7707  SCANTRONFORM Line 8250  SCANTRONFORM
   
     my %lettdig = &letter_to_digits();      my %lettdig = &letter_to_digits();
     my $numletts = scalar(keys(%lettdig));      my $numletts = scalar(keys(%lettdig));
       my %orderedforcode;
   
     while ($i<$scanlines->{'count'}) {      while ($i<$scanlines->{'count'}) {
   ($uname,$udom)=('','');    ($uname,$udom)=('','');
Line 7714  SCANTRONFORM Line 8258  SCANTRONFORM
   my $line=&scantron_get_line($scanlines,$scan_data,$i);    my $line=&scantron_get_line($scanlines,$scan_data,$i);
   if ($line=~/^[\s\cz]*$/) { next; }    if ($line=~/^[\s\cz]*$/) { next; }
  if ($started) {   if ($started) {
     &Apache::lonhtmlcommon::Increment_PrgWin($r,\%prog_state,      &Apache::lonhtmlcommon::Increment_PrgWin($r,\%prog_state,'last student');
      'last student');  
  }   }
  $started=1;   $started=1;
           my %respnumlookup = ();
           my %startline = ();
           my $total;
   my $scan_record=&scantron_parse_scanline($line,$i,\%scantron_config,    my $scan_record=&scantron_parse_scanline($line,$i,\%scantron_config,
   $scan_data);                                                   $scan_data,undef,\%idmap,$randomorder,
                                                    $randompick,$sequence,\@master_seq,
                                                    \%symb_to_resource,\%grader_partids_by_symb,
                                                    \%orderedforcode,\%respnumlookup,\%startline,
                                                    \$total);
   unless ($uname=&scantron_find_student($scan_record,$scan_data,    unless ($uname=&scantron_find_student($scan_record,$scan_data,
        \%idmap,$i)) {         \%idmap,$i)) {
      &scantron_add_delay(\@delayqueue,$line,       &scantron_add_delay(\@delayqueue,$line,
Line 7731  SCANTRONFORM Line 8281  SCANTRONFORM
   'Student '.$uname.' has multiple sheets',2);    'Student '.$uname.' has multiple sheets',2);
      next;       next;
   }    }
           my $usec = $classlist->{$uname}->[&Apache::loncoursedata::CL_SECTION];
           my $user = $uname.':'.$usec;
   ($uname,$udom)=split(/:/,$uname);    ($uname,$udom)=split(/:/,$uname);
   
           my $scancode;
           if ((exists($scan_record->{'scantron.CODE'})) &&
               (&Apache::lonnet::validCODE($scan_record->{'scantron.CODE'}))) {
               $scancode = $scan_record->{'scantron.CODE'};
           } else {
               $scancode = '';
           }
   
           my @mapresources = @resources;
           if ($randomorder || $randompick) {
               @mapresources = 
                   &users_order($user,$scancode,$sequence,\@master_seq,\%symb_to_resource,
                                \%orderedforcode);
           }
         my (%partids_by_symb,$res_error);          my (%partids_by_symb,$res_error);
         foreach my $resource (@resources) {          foreach my $resource (@mapresources) {
             my $ressymb;              my $ressymb;
             if (ref($resource)) {              if (ref($resource)) {
                 $ressymb = $resource->symb();                  $ressymb = $resource->symb();
Line 7745  SCANTRONFORM Line 8311  SCANTRONFORM
             if ((exists($grader_randomlists_by_symb{$ressymb})) ||              if ((exists($grader_randomlists_by_symb{$ressymb})) ||
                 (ref($grader_partids_by_symb{$ressymb}) ne 'ARRAY')) {                  (ref($grader_partids_by_symb{$ressymb}) ne 'ARRAY')) {
                 my ($analysis,$parts) =                  my ($analysis,$parts) =
                     &scantron_partids_tograde($resource,$env{'request.course.id'},$uname,$udom,undef,$bubbles_per_row);                      &scantron_partids_tograde($resource,$env{'request.course.id'},
                                                 $uname,$udom,undef,$bubbles_per_row);
                 $partids_by_symb{$ressymb} = $parts;                  $partids_by_symb{$ressymb} = $parts;
             } else {              } else {
                 $partids_by_symb{$ressymb} = $grader_partids_by_symb{$ressymb};                  $partids_by_symb{$ressymb} = $grader_partids_by_symb{$ressymb};
Line 7765  SCANTRONFORM Line 8332  SCANTRONFORM
     &scantron_putfile($scanlines,$scan_data);      &scantron_putfile($scanlines,$scan_data);
  }   }
   
         my $scancode;  
         if ((exists($scan_record->{'scantron.CODE'})) &&  
             (&Apache::lonnet::validCODE($scan_record->{'scantron.CODE'}))) {  
             $scancode = $scan_record->{'scantron.CODE'};  
         } else {  
             $scancode = '';  
         }  
   
         if (&grade_student_bubbles($r,$uname,$udom,$scan_record,$scancode,          if (&grade_student_bubbles($r,$uname,$udom,$scan_record,$scancode,
                                    \@resources,\%partids_by_symb,                                     \@mapresources,\%partids_by_symb,
                                    $bubbles_per_row) eq 'ssi_error') {                                     $bubbles_per_row,$randomorder,$randompick,
                                      \%respnumlookup,\%startline) 
               eq 'ssi_error') {
             $ssi_error = 0; # So end of handler error message does not trigger.              $ssi_error = 0; # So end of handler error message does not trigger.
             $r->print("</form>");              $r->print("</form>");
             &ssi_print_error($r);              &ssi_print_error($r);
Line 7783  SCANTRONFORM Line 8344  SCANTRONFORM
             return '';      # Why return ''?  Beats me.              return '';      # Why return ''?  Beats me.
         }          }
   
           if (($scancode) && ($randomorder || $randompick)) {
               my $parmresult =
                   &Apache::lonparmset::storeparm_by_symb($symb,
                                                          '0_examcode',2,$scancode,
                                                          'string_examcode',$uname,
                                                          $udom);
           }
  $completedstudents{$uname}={'line'=>$line};   $completedstudents{$uname}={'line'=>$line};
         if ($env{'form.verifyrecord'}) {          if ($env{'form.verifyrecord'}) {
             my $lastpos = $env{'form.scantron_maxbubble'}*$scantron_config{'Qlength'};              my $lastpos = $env{'form.scantron_maxbubble'}*$scantron_config{'Qlength'};
               if ($randompick) {
                   if ($total) {
                       $lastpos = $total*$scantron_config{'Qlength'};
                   }
               }
   
             my $studentdata = substr($line,$scantron_config{'Qstart'}-1,$lastpos);              my $studentdata = substr($line,$scantron_config{'Qstart'}-1,$lastpos);
             chomp($studentdata);              chomp($studentdata);
             $studentdata =~ s/\r$//;              $studentdata =~ s/\r$//;
             my $studentrecord = '';              my $studentrecord = '';
             my $counter = -1;              my $counter = -1;
             foreach my $resource (@resources) {              foreach my $resource (@mapresources) {
                 my $ressymb = $resource->symb();                  my $ressymb = $resource->symb();
                 ($counter,my $recording) =                  ($counter,my $recording) =
                     &verify_scantron_grading($resource,$udom,$uname,$env{'request.course.id'},                      &verify_scantron_grading($resource,$udom,$uname,$env{'request.course.id'},
                                              $counter,$studentdata,$partids_by_symb{$ressymb},                                               $counter,$studentdata,$partids_by_symb{$ressymb},
                                              \%scantron_config,\%lettdig,$numletts);                                               \%scantron_config,\%lettdig,$numletts,$randomorder,
                                                $randompick,\%respnumlookup,\%startline);
                 $studentrecord .= $recording;                  $studentrecord .= $recording;
             }              }
             if ($studentrecord ne $studentdata) {              if ($studentrecord ne $studentdata) {
                 &Apache::lonxml::clear_problem_counter();                  &Apache::lonxml::clear_problem_counter();
                 if (&grade_student_bubbles($r,$uname,$udom,$scan_record,$scancode,                  if (&grade_student_bubbles($r,$uname,$udom,$scan_record,$scancode,
                                            \@resources,\%partids_by_symb,                                             \@mapresources,\%partids_by_symb,
                                            $bubbles_per_row) eq 'ssi_error') {                                             $bubbles_per_row,$randomorder,$randompick,
                                              \%respnumlookup,\%startline) 
                       eq 'ssi_error') {
                     $ssi_error = 0; # So end of handler error message does not trigger.                      $ssi_error = 0; # So end of handler error message does not trigger.
                     $r->print("</form>");                      $r->print("</form>");
                     &ssi_print_error($r);                      &ssi_print_error($r);
Line 7813  SCANTRONFORM Line 8390  SCANTRONFORM
                 }                  }
                 $counter = -1;                  $counter = -1;
                 $studentrecord = '';                  $studentrecord = '';
                 foreach my $resource (@resources) {                  foreach my $resource (@mapresources) {
                     my $ressymb = $resource->symb();                      my $ressymb = $resource->symb();
                     ($counter,my $recording) =                      ($counter,my $recording) =
                         &verify_scantron_grading($resource,$udom,$uname,$env{'request.course.id'},                          &verify_scantron_grading($resource,$udom,$uname,$env{'request.course.id'},
                                                  $counter,$studentdata,$partids_by_symb{$ressymb},                                                   $counter,$studentdata,$partids_by_symb{$ressymb},
                                                  \%scantron_config,\%lettdig,$numletts);                                                   \%scantron_config,\%lettdig,$numletts,
                                                    $randomorder,$randompick,\%respnumlookup,
                                                    \%startline);
                     $studentrecord .= $recording;                      $studentrecord .= $recording;
                 }                  }
                 if ($studentrecord ne $studentdata) {                  if ($studentrecord ne $studentdata) {
                     $r->print('<p><span class="LC_error">');                      $r->print('<p><span class="LC_warning">');
                     if ($scancode eq '') {                      if ($scancode eq '') {
                         $r->print(&mt('Mismatch grading bubble sheet for user: [_1] with ID: [_2].',                          $r->print(&mt('Mismatch grading bubblesheet for user: [_1] with ID: [_2].',
                                   $uname.':'.$udom,$scan_record->{'scantron.ID'}));                                    $uname.':'.$udom,$scan_record->{'scantron.ID'}));
                     } else {                      } else {
                         $r->print(&mt('Mismatch grading bubble sheet for user: [_1] with ID: [_2] and CODE: [_3].',                          $r->print(&mt('Mismatch grading bubblesheet for user: [_1] with ID: [_2] and CODE: [_3].',
                                   $uname.':'.$udom,$scan_record->{'scantron.ID'},$scancode));                                    $uname.':'.$udom,$scan_record->{'scantron.ID'},$scancode));
                     }                      }
                     $r->print('</span><br />'.&Apache::loncommon::start_data_table()."\n".                      $r->print('</span><br />'.&Apache::loncommon::start_data_table()."\n".
Line 7835  SCANTRONFORM Line 8414  SCANTRONFORM
                               '<th>'.&mt('Source').'</th><th>'.&mt('Bubbled responses').'</th>'.                                '<th>'.&mt('Source').'</th><th>'.&mt('Bubbled responses').'</th>'.
                               &Apache::loncommon::end_data_table_header_row()."\n".                                &Apache::loncommon::end_data_table_header_row()."\n".
                               &Apache::loncommon::start_data_table_row().                                &Apache::loncommon::start_data_table_row().
                               '<td>'.&mt('Bubble Sheet').'</td>'.                                '<td>'.&mt('Bubblesheet').'</td>'.
                               '<td><span class="LC_nobreak">'.$studentdata.'</span></td>'.                                '<td><span class="LC_nobreak"><tt>'.$studentdata.'</tt></span></td>'.
                               &Apache::loncommon::end_data_table_row().                                &Apache::loncommon::end_data_table_row().
                               &Apache::loncommon::start_data_table_row().                                &Apache::loncommon::start_data_table_row().
                               '<td>Stored submissions</td>'.                                '<td>'.&mt('Stored submissions').'</td>'.
                               '<td><span class="LC_nobreak">'.$studentrecord.'</span></td>'."\n".                                '<td><span class="LC_nobreak"><tt>'.$studentrecord.'</tt></span></td>'."\n".
                               &Apache::loncommon::end_data_table_row().                                &Apache::loncommon::end_data_table_row().
                               &Apache::loncommon::end_data_table().'</p>');                                &Apache::loncommon::end_data_table().'</p>');
                 } else {                  } else {
Line 7874  sub graders_resources_pass { Line 8453  sub graders_resources_pass {
             my $ressymb = $resource->symb();              my $ressymb = $resource->symb();
             my ($analysis,$parts) =              my ($analysis,$parts) =
                 &scantron_partids_tograde($resource,$env{'request.course.id'},                  &scantron_partids_tograde($resource,$env{'request.course.id'},
                                           $env{'user.name'},$env{'user.domain'},1,$bubbles_per_row);                                            $env{'user.name'},$env{'user.domain'},
                                             1,$bubbles_per_row);
             $grader_partids_by_symb->{$ressymb} = $parts;              $grader_partids_by_symb->{$ressymb} = $parts;
             if (ref($analysis) eq 'HASH') {              if (ref($analysis) eq 'HASH') {
                 if (ref($analysis->{'parts_withrandomlist'}) eq 'ARRAY') {                  if (ref($analysis->{'parts_withrandomlist'}) eq 'ARRAY') {
Line 7887  sub graders_resources_pass { Line 8467  sub graders_resources_pass {
     return;      return;
 }  }
   
   =pod
   
   =item users_order
   
     Returns array of resources in current map, ordered based on either CODE,
     if this is a CODEd exam, or based on student's identity if this is a 
     "NAMEd" exam.
   
     Should be used when randomorder and/or randompick applied when the 
     corresponding exam was printed, prior to students completing bubblesheets 
     for the version of the exam the student received.
   
   =cut
   
   sub users_order  {
       my ($user,$scancode,$mapurl,$master_seq,$symb_to_resource,$orderedforcode) = @_;
       my @mapresources;
       unless ((ref($master_seq) eq 'ARRAY') && (ref($symb_to_resource) eq 'HASH')) {
           return @mapresources;
       }
       if ($scancode) {
           if ((ref($orderedforcode) eq 'HASH') && (ref($orderedforcode->{$scancode}) eq 'ARRAY')) {
               @mapresources = @{$orderedforcode->{$scancode}};
           } else {
               $env{'form.CODE'} = $scancode;
               my $actual_seq =
                   &Apache::lonprintout::master_seq_to_person_seq($mapurl,
                                                                  $master_seq,
                                                                  $user,$scancode,1);
               if (ref($actual_seq) eq 'ARRAY') {
                   @mapresources = map { $symb_to_resource->{$_}; } @{$actual_seq};
                   if (ref($orderedforcode) eq 'HASH') {
                       if (@mapresources > 0) { 
                           $orderedforcode->{$scancode} = \@mapresources;
                       }
                   }
               }
               delete($env{'form.CODE'});
           }
       } else {
           my $actual_seq =
               &Apache::lonprintout::master_seq_to_person_seq($mapurl,
                                                              $master_seq,
                                                              $user,undef,1);
           if (ref($actual_seq) eq 'ARRAY') {
               @mapresources = 
                   map { $symb_to_resource->{$_}; } @{$actual_seq};
           }
       }
       return @mapresources;
   }
   
 sub grade_student_bubbles {  sub grade_student_bubbles {
     my ($r,$uname,$udom,$scan_record,$scancode,$resources,$parts,$bubbles_per_row) = @_;      my ($r,$uname,$udom,$scan_record,$scancode,$resources,$parts,$bubbles_per_row,
 # Walk folder as student here to get resources in order student sees.          $randomorder,$randompick,$respnumlookup,$startline) = @_;
       my $uselookup = 0;
       if (($randomorder || $randompick) && (ref($respnumlookup) eq 'HASH') &&
           (ref($startline) eq 'HASH')) {
           $uselookup = 1;
       }
   
     if (ref($resources) eq 'ARRAY') {      if (ref($resources) eq 'ARRAY') {
         my $count = 0;          my $count = 0;
         foreach my $resource (@{$resources}) {          foreach my $resource (@{$resources}) {
Line 7905  sub grade_student_bubbles { Line 8543  sub grade_student_bubbles {
             if ($bubbles_per_row ne '') {              if ($bubbles_per_row ne '') {
                 $form{'bubbles_per_row'} = $bubbles_per_row;                  $form{'bubbles_per_row'} = $bubbles_per_row;
             }              }
               if ($env{'form.scantron_lastbubblepoints'} ne '') {
                   $form{'scantron_lastbubblepoints'} = $env{'form.scantron_lastbubblepoints'};
               }
             if (ref($parts) eq 'HASH') {              if (ref($parts) eq 'HASH') {
                 if (ref($parts->{$ressymb}) eq 'ARRAY') {                  if (ref($parts->{$ressymb}) eq 'ARRAY') {
                     foreach my $part (@{$parts->{$ressymb}}) {                      foreach my $part (@{$parts->{$ressymb}}) {
                         $form{'scantron_questnum_start.'.$part} =                          if ($uselookup) {
                             1+$env{'form.scantron.first_bubble_line.'.$count};                              $form{'scantron_questnum_start.'.$part} = $startline->{$count} + 1;
                           } else {
                               $form{'scantron_questnum_start.'.$part} =
                                   1+$env{'form.scantron.first_bubble_line.'.$count};
                           }
                         $count++;                          $count++;
                     }                      }
                 }                  }
Line 8140  sub scantron_download_scantron_data { Line 8785  sub scantron_download_scantron_data {
     if (! &valid_file($file)) {      if (! &valid_file($file)) {
  $r->print('   $r->print('
  <p>   <p>
     '.&mt('The requested file name was invalid.').'      '.&mt('The requested filename was invalid.').'
         </p>          </p>
 ');  ');
  return;   return;
Line 8190  sub checkscantron_results { Line 8835  sub checkscantron_results {
         return '';          return '';
     }      }
     my $map=$navmap->getResourceByUrl($sequence);      my $map=$navmap->getResourceByUrl($sequence);
       my ($randomorder,$randompick,@master_seq,%symb_to_resource,%grader_partids_by_symb,
           %grader_randomlists_by_symb,%orderedforcode);
       if (ref($map)) { 
           $randomorder=$map->randomorder();
           $randompick=$map->randompick();
       }
     my @resources=$navmap->retrieveResources($map,\&scantron_filter,1,0);      my @resources=$navmap->retrieveResources($map,\&scantron_filter,1,0);
     my (%grader_partids_by_symb,%grader_randomlists_by_symb);      my $nav_error = &get_master_seq(\@resources,\@master_seq,\%symb_to_resource);
     &graders_resources_pass(\@resources,\%grader_partids_by_symb,                             \%grader_randomlists_by_symb);      if ($nav_error) {
           $r->print(&navmap_errormsg());
           return '';
       }
       &graders_resources_pass(\@resources,\%grader_partids_by_symb,
                               \%grader_randomlists_by_symb,$bubbles_per_row);
     my ($uname,$udom);      my ($uname,$udom);
     my (%scandata,%lastname,%bylast);      my (%scandata,%lastname,%bylast);
     $r->print('      $r->print('
Line 8202  sub checkscantron_results { Line 8857  sub checkscantron_results {
     my @delayqueue;      my @delayqueue;
     my %completedstudents;      my %completedstudents;
   
     my $count=&Apache::grades::get_todo_count($scanlines,$scan_data);      my $count=&get_todo_count($scanlines,$scan_data);
     my %prog_state=&Apache::lonhtmlcommon::Create_PrgWin($r,'Bubblesheet/Submissions Comparison Status',      my %prog_state=&Apache::lonhtmlcommon::Create_PrgWin($r,$count);
                                     'Progress of Bubblesheet Data/Submission Records Comparison',$count,      my ($username,$domain,$started,%ordered);
                                     'inline',undef,'checkscantron');  
     my ($username,$domain,$started);  
     my $nav_error;  
     &scantron_get_maxbubble(\$nav_error,\%scantron_config); # Need the bubble lines array to parse.      &scantron_get_maxbubble(\$nav_error,\%scantron_config); # Need the bubble lines array to parse.
     if ($nav_error) {      if ($nav_error) {
         $r->print(&navmap_errormsg());          $r->print(&navmap_errormsg());
         return '';          return '';
     }      }
   
     &Apache::lonhtmlcommon::Update_PrgWin($r,\%prog_state,      &Apache::lonhtmlcommon::Update_PrgWin($r,\%prog_state,'Processing first student');
                                           'Processing first student');  
     my $start=&Time::HiRes::time();      my $start=&Time::HiRes::time();
     my $i=-1;      my $i=-1;
   
Line 8225  sub checkscantron_results { Line 8876  sub checkscantron_results {
         my $line=&Apache::grades::scantron_get_line($scanlines,$scan_data,$i);          my $line=&Apache::grades::scantron_get_line($scanlines,$scan_data,$i);
         if ($line=~/^[\s\cz]*$/) { next; }          if ($line=~/^[\s\cz]*$/) { next; }
         if ($started) {          if ($started) {
             &Apache::lonhtmlcommon::Increment_PrgWin($r,\%prog_state,              &Apache::lonhtmlcommon::Increment_PrgWin($r,\%prog_state,'last student');
                                                      'last student');  
         }          }
         $started=1;          $started=1;
         my $scan_record=          my $scan_record=
             &Apache::grades::scantron_parse_scanline($line,$i,\%scantron_config,              &Apache::grades::scantron_parse_scanline($line,$i,\%scantron_config,
                                                      $scan_data);                                                       $scan_data);
         unless ($uname=&Apache::grades::scantron_find_student($scan_record,$scan_data,          unless ($uname=&scantron_find_student($scan_record,$scan_data,
                                                               \%idmap,$i)) {                                                \%idmap,$i)) {
             &Apache::grades::scantron_add_delay(\@delayqueue,$line,              &Apache::grades::scantron_add_delay(\@delayqueue,$line,
                                 'Unable to find a student that matches',1);                                  'Unable to find a student that matches',1);
             next;              next;
Line 8246  sub checkscantron_results { Line 8896  sub checkscantron_results {
         my $pid = $scan_record->{'scantron.ID'};          my $pid = $scan_record->{'scantron.ID'};
         $lastname{$pid} = $scan_record->{'scantron.LastName'};          $lastname{$pid} = $scan_record->{'scantron.LastName'};
         push(@{$bylast{$lastname{$pid}}},$pid);          push(@{$bylast{$lastname{$pid}}},$pid);
           my $usec = $classlist->{$uname}->[&Apache::loncoursedata::CL_SECTION];
           my $user = $uname.':'.$usec;
           ($username,$domain)=split(/:/,$uname);
   
           my $scancode;
           if ((exists($scan_record->{'scantron.CODE'})) &&
               (&Apache::lonnet::validCODE($scan_record->{'scantron.CODE'}))) {
               $scancode = $scan_record->{'scantron.CODE'};
           } else {
               $scancode = '';
           }
   
           my @mapresources = @resources;
         my $lastpos = $env{'form.scantron_maxbubble'}*$scantron_config{'Qlength'};          my $lastpos = $env{'form.scantron_maxbubble'}*$scantron_config{'Qlength'};
           my %respnumlookup=();
           my %startline=();
           if ($randomorder || $randompick) {
               @mapresources =
                   &users_order($user,$scancode,$sequence,\@master_seq,\%symb_to_resource,
                                \%orderedforcode);
               my $total = &get_respnum_lookups($sequence,$scan_data,\%idmap,$line,
                                                $scan_record,\@master_seq,\%symb_to_resource,
                                                \%grader_partids_by_symb,\%orderedforcode,
                                                \%respnumlookup,\%startline);
               if ($randompick && $total) {
                   $lastpos = $total*$scantron_config{'Qlength'};
               }
           }
         $scandata{$pid} = substr($line,$scantron_config{'Qstart'}-1,$lastpos);          $scandata{$pid} = substr($line,$scantron_config{'Qstart'}-1,$lastpos);
         chomp($scandata{$pid});          chomp($scandata{$pid});
         $scandata{$pid} =~ s/\r$//;          $scandata{$pid} =~ s/\r$//;
         ($username,$domain)=split(/:/,$uname);  
         my $counter = -1;          my $counter = -1;
         foreach my $resource (@resources) {          foreach my $resource (@mapresources) {
             my $parts;              my $parts;
             my $ressymb = $resource->symb();              my $ressymb = $resource->symb();
             if ((exists($grader_randomlists_by_symb{$ressymb})) ||              if ((exists($grader_randomlists_by_symb{$ressymb})) ||
                 (ref($grader_partids_by_symb{$ressymb}) ne 'ARRAY')) {                  (ref($grader_partids_by_symb{$ressymb}) ne 'ARRAY')) {
                 (my $analysis,$parts) =                  (my $analysis,$parts) =
                     &scantron_partids_tograde($resource,$env{'request.course.id'},$username,$domain,undef,$bubbles_per_row);                      &scantron_partids_tograde($resource,$env{'request.course.id'},
                                                 $username,$domain,undef,
                                                 $bubbles_per_row);
             } else {              } else {
                 $parts = $grader_partids_by_symb{$ressymb};                  $parts = $grader_partids_by_symb{$ressymb};
             }              }
             ($counter,my $recording) =              ($counter,my $recording) =
                 &verify_scantron_grading($resource,$domain,$username,$cid,$counter,                  &verify_scantron_grading($resource,$domain,$username,$cid,$counter,
                                          $scandata{$pid},$parts,                                           $scandata{$pid},$parts,
                                          \%scantron_config,\%lettdig,$numletts);                                           \%scantron_config,\%lettdig,$numletts,
                                            $randomorder,$randompick,
                                            \%respnumlookup,\%startline);
             $record{$pid} .= $recording;              $record{$pid} .= $recording;
         }          }
     }      }
Line 8312  sub checkscantron_results { Line 8993  sub checkscantron_results {
             $env{'form.scantron_maxbubble'})              $env{'form.scantron_maxbubble'})
        .'</p>'         .'</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>');      $r->print('<p>'
                .&mt('Exact matches for [_1][quant,_2,student][_3].','<b>',$passed,'</b>')
                .'<br />'
                .&mt('Discrepancies detected for [_1][quant,_2,student][_3].','<b>',$failed,'</b>')
                .'</p>'
       );
     if ($passed) {      if ($passed) {
         $r->print(&mt('Students with exact correspondence between bubblesheet data and submissions are as follows:').'<br /><br />');          $r->print(&mt('Students with exact correspondence between bubblesheet data and submissions are as follows:').'<br /><br />');
         $r->print(&Apache::loncommon::start_data_table()."\n".          $r->print(&Apache::loncommon::start_data_table()."\n".
Line 8338  sub checkscantron_results { Line 9024  sub checkscantron_results {
   
 sub verify_scantron_grading {  sub verify_scantron_grading {
     my ($resource,$domain,$username,$cid,$counter,$scandata,$partids,      my ($resource,$domain,$username,$cid,$counter,$scandata,$partids,
         $scantron_config,$lettdig,$numletts) = @_;          $scantron_config,$lettdig,$numletts,$randomorder,$randompick,
           $respnumlookup,$startline) = @_;
     my ($record,%expected,%startpos);      my ($record,%expected,%startpos);
     return ($counter,$record) if (!ref($resource));      return ($counter,$record) if (!ref($resource));
     return ($counter,$record) if (!$resource->is_problem());      return ($counter,$record) if (!$resource->is_problem());
Line 8347  sub verify_scantron_grading { Line 9034  sub verify_scantron_grading {
     foreach my $part_id (@{$partids}) {      foreach my $part_id (@{$partids}) {
         $counter ++;          $counter ++;
         $expected{$part_id} = 0;          $expected{$part_id} = 0;
         if ($env{"form.scantron.sub_bubblelines.$counter"}) {          my $respnum = $counter;
             my @sub_lines = split(/,/,$env{"form.scantron.sub_bubblelines.$counter"});          if ($randomorder || $randompick) {
               $respnum = $respnumlookup->{$counter};
               $startpos{$part_id} = $startline->{$counter} + 1;
           } else {
               $startpos{$part_id} = $env{"form.scantron.first_bubble_line.$counter"};
           }
           if ($env{"form.scantron.sub_bubblelines.$respnum"}) {
               my @sub_lines = split(/,/,$env{"form.scantron.sub_bubblelines.$respnum"});
             foreach my $item (@sub_lines) {              foreach my $item (@sub_lines) {
                 $expected{$part_id} += $item;                  $expected{$part_id} += $item;
             }              }
         } else {          } else {
             $expected{$part_id} = $env{"form.scantron.bubblelines.$counter"};              $expected{$part_id} = $env{"form.scantron.bubblelines.$respnum"};
         }          }
         $startpos{$part_id} = $env{"form.scantron.first_bubble_line.$counter"};  
     }      }
     if ($symb) {      if ($symb) {
         my %recorded;          my %recorded;
Line 8451  sub verify_scantron_grading { Line 9144  sub verify_scantron_grading {
     return ($counter,$record);      return ($counter,$record);
 }  }
   
 sub letter_to_digits {   sub letter_to_digits {
     my %lettdig = (      my %lettdig = (
                     A => 1,                      A => 1,
                     B => 2,                      B => 2,
Line 8478  sub letter_to_digits { Line 9171  sub letter_to_digits {
   
 sub href_symb_cmd {  sub href_symb_cmd {
     my ($symb,$cmd)=@_;      my ($symb,$cmd)=@_;
     return '/adm/grades?symb='.&HTML::Entities::encode(&Apache::lonenc::check_encrypt($symb),'<>&"').'&command='.$cmd;      return '/adm/grades?symb='.&HTML::Entities::encode(&Apache::lonenc::check_encrypt($symb),'<>&"').'&amp;command='.$cmd;
 }  }
   
 sub grading_menu {  sub grading_menu {
Line 8741  sub init_perm { Line 9434  sub init_perm {
     }      }
 }  }
   
   sub init_old_essays {
       my ($symb,$apath,$adom,$aname) = @_;
       if ($symb ne '') {
           my %essays = &Apache::lonnet::dump('nohist_essay_'.$apath,$adom,$aname);
           if (keys(%essays) > 0) {
               $old_essays{$symb} = \%essays;
           }
       }
       return;
   }
   
   sub reset_old_essays {
       undef(%old_essays);
   }
   
 sub gather_clicker_ids {  sub gather_clicker_ids {
     my %clicker_ids;      my %clicker_ids;
   
Line 8838  sub process_clicker { Line 9546  sub process_clicker {
     my $pincorrect=&mt("Percentage points for incorrect solution");      my $pincorrect=&mt("Percentage points for incorrect solution");
     my $selectform=&Apache::loncommon::select_form($env{'form.upfiletype'},'upfiletype',      my $selectform=&Apache::loncommon::select_form($env{'form.upfiletype'},'upfiletype',
    {'iclicker' => 'i>clicker',     {'iclicker' => 'i>clicker',
                                                     'interwrite' => 'interwrite PRS'});                                                      'interwrite' => 'interwrite PRS',
                                                       'turning' => 'Turning Technologies'});
     $symb = &Apache::lonenc::check_encrypt($symb);      $symb = &Apache::lonenc::check_encrypt($symb);
     $result.= &Apache::lonhtmlcommon::scripttag(<<ENDUPFORM);      $result.= &Apache::lonhtmlcommon::scripttag(<<ENDUPFORM);
 function sanitycheck() {  function sanitycheck() {
Line 9012  ENDHEADER Line 9721  ENDHEADER
     if ($env{'form.upfiletype'} eq 'interwrite') {      if ($env{'form.upfiletype'} eq 'interwrite') {
         ($errormsg,$number)=&interwrite_eval(\@questiontitles,\%responses);          ($errormsg,$number)=&interwrite_eval(\@questiontitles,\%responses);
     }      }
       if ($env{'form.upfiletype'} eq 'turning') {
           ($errormsg,$number)=&turning_eval(\@questiontitles,\%responses);
       }
     $result.='<br />'.&mt('Found [_1] question(s)',$number).'<br />'.      $result.='<br />'.&mt('Found [_1] question(s)',$number).'<br />'.
              '<input type="hidden" name="number" value="'.$number.'" />'.               '<input type="hidden" name="number" value="'.$number.'" />'.
              &mt('Awarding [_1] percent for correct and [_2] percent for incorrect responses',               &mt('Awarding [_1] percent for correct and [_2] percent for incorrect responses',
Line 9070  ENDHEADER Line 9782  ENDHEADER
              &mt('Found [_1] registered and [_2] unregistered clickers.',$student_count,$unknown_count);               &mt('Found [_1] registered and [_2] unregistered clickers.',$student_count,$unknown_count);
     if (($env{'form.gradingmechanism'} ne 'attendance') && ($env{'form.gradingmechanism'} ne 'given')) {      if (($env{'form.gradingmechanism'} ne 'attendance') && ($env{'form.gradingmechanism'} ne 'given')) {
        if ($correct_count==0) {         if ($correct_count==0) {
           $errormsg.="Found no correct answers answers for grading!";            $errormsg.="Found no correct answers for grading!";
        } elsif ($correct_count>1) {         } elsif ($correct_count>1) {
           $result.='<br /><span class="LC_warning">'.&mt("Found [_1] entries for grading!",$correct_count).'</span>';            $result.='<br /><span class="LC_warning">'.&mt("Found [_1] entries for grading!",$correct_count).'</span>';
        }         }
Line 9148  sub interwrite_eval { Line 9860  sub interwrite_eval {
     return ($errormsg,$number);      return ($errormsg,$number);
 }  }
   
   sub turning_eval {
       my ($questiontitles,$responses)=@_;
       my $number=0;
       my $errormsg='';
       foreach my $line (split(/[\n\r]/,$env{'form.upfile'})) {
           my %components=&Apache::loncommon::record_sep($line);
           my @entries=map {$components{$_}} (sort(keys(%components)));
           if ($#entries>$number) { $number=$#entries; }
           my $id=$entries[0];
           my @idresponses;
           $id=~s/^[\#0]+//;
           unless ($id) { next; }
           for (my $idx=1;$idx<=$#entries;$idx++) {
               $entries[$idx]=~s/\,/\;/g;
               $entries[$idx]=~s/[^a-zA-Z0-9\.\*\-\+\;]+//g;
               push(@idresponses,$entries[$idx]);
           }
           $$responses{$id}=join(',',@idresponses);
       }
       for (my $i=1; $i<=$number; $i++) {
           $$questiontitles[$i]=&mt('Question [_1]',$i);
       }
       return ($errormsg,$number);
   }
   
   
 sub assign_clicker_grades {  sub assign_clicker_grades {
     my ($r,$symb)=@_;      my ($r,$symb)=@_;
     if (!$symb) {return '';}      if (!$symb) {return '';}
Line 9216  sub assign_clicker_grades { Line 9954  sub assign_clicker_grades {
        if ($user) {         if ($user) {
           if ($users{$user}) {            if ($users{$user}) {
              $result.='<br /><span class="LC_warning">'.               $result.='<br /><span class="LC_warning">'.
                       &mt("More than one entry found for <tt>[_1]</tt>!",$user).                        &mt('More than one entry found for [_1]!','<tt>'.$user.'</tt>').
                       '</span><br />';                        '</span><br />';
           }            }
           $users{$user}=1;             $users{$user}=1; 
Line 9285  sub navmap_errormsg { Line 10023  sub navmap_errormsg {
 }  }
   
 sub startpage {  sub startpage {
     my ($r,$symb,$crumbs,$onlyfolderflag,$nodisplayflag) = @_;      my ($r,$symb,$crumbs,$onlyfolderflag,$nodisplayflag,$stuvcurrent,$stuvdisp,$nomenu,$js) = @_;
     unshift(@$crumbs,{href=>&href_symb_cmd($symb,'gradingmenu'),text=>"Grading"});      if ($nomenu) {
     $r->print(&Apache::loncommon::start_page('Grading',undef,          $r->print(&Apache::loncommon::start_page("Student's Version",$js,{'only_body' => '1'}));
                                           {'bread_crumbs' => $crumbs}));      } else {
     &Apache::lonquickgrades::startGradeScreen($r,($env{'form.symb'}?'probgrading':'grading'));          unshift(@$crumbs,{href=>&href_symb_cmd($symb,'gradingmenu'),text=>"Grading"});
           $r->print(&Apache::loncommon::start_page('Grading',$js,
                                                    {'bread_crumbs' => $crumbs}));
           &Apache::lonquickgrades::startGradeScreen($r,($env{'form.symb'}?'probgrading':'grading'));
       }
     unless ($nodisplayflag) {      unless ($nodisplayflag) {
        $r->print(&Apache::lonhtmlcommon::resource_info_box($symb,$onlyfolderflag));         $r->print(&Apache::lonhtmlcommon::resource_info_box($symb,$onlyfolderflag,$stuvcurrent,$stuvdisp));
     }      }
 }  }
   
Line 9313  sub handler { Line 10055  sub handler {
     }      }
     &Apache::loncommon::get_unprocessed_cgi($ENV{'QUERY_STRING'});      &Apache::loncommon::get_unprocessed_cgi($ENV{'QUERY_STRING'});
   
   # see what command we need to execute
   
       my @commands=&Apache::loncommon::get_env_multiple('form.command');
       my $command=$commands[0];
   
     &init_perm();      &init_perm();
     if (!$env{'request.course.id'}) {      if (!$env{'request.course.id'}) {
         # Not in a course.          unless ((&Apache::lonnet::allowed('usc',$env{'request.role.domain'})) &&
         $env{'user.error.msg'}="/adm/grades::vgr:0:0:Cannot display grades page outside course context";                  ($command =~ /^scantronupload/)) {
         return HTTP_NOT_ACCEPTABLE;              # Not in a course.
               $env{'user.error.msg'}="/adm/grades::vgr:0:0:Cannot display grades page outside course context";
               return HTTP_NOT_ACCEPTABLE;
           }
     } elsif (!%perm) {      } elsif (!%perm) {
         $request->internal_redirect('/adm/quickgrades');          $request->internal_redirect('/adm/quickgrades');
           return OK;
     }      }
     &Apache::loncommon::content_type($request,'text/html');      &Apache::loncommon::content_type($request,'text/html');
     $request->send_http_header;      $request->send_http_header;
   
   
 # see what command we need to execute  
   
     my @commands=&Apache::loncommon::get_env_multiple('form.command');  
     my $command=$commands[0];  
   
     if ($#commands > 0) {      if ($#commands > 0) {
  &Apache::lonnet::logthis("grades got multiple commands ".join(':',@commands));   &Apache::lonnet::logthis("grades got multiple commands ".join(':',@commands));
     }      }
Line 9352  sub handler { Line 10097  sub handler {
         &select_problem($request);          &select_problem($request);
     } else {      } else {
  if ($command eq 'submission' && $perm{'vgr'}) {   if ($command eq 'submission' && $perm{'vgr'}) {
             &startpage($request,$symb,[{href=>"", text=>"Student Submissions"}]);              my ($stuvcurrent,$stuvdisp,$versionform,$js);
               if (($env{'form.student'} ne '') && ($env{'form.userdom'} ne '')) {
                   ($stuvcurrent,$stuvdisp,$versionform,$js) =
                       &choose_task_version_form($symb,$env{'form.student'},
                                                 $env{'form.userdom'});
               }
               &startpage($request,$symb,[{href=>"", text=>"Student Submissions"}],undef,undef,$stuvcurrent,$stuvdisp,undef,$js);
               if ($versionform) {
                   $request->print($versionform);
               }
               $request->print('<br clear="all" />');
     ($env{'form.student'} eq '' ? &listStudents($request,$symb) : &submission($request,0,0,$symb));      ($env{'form.student'} eq '' ? &listStudents($request,$symb) : &submission($request,0,0,$symb));
           } elsif ($command eq 'versionsub' && $perm{'vgr'}) {
               my ($stuvcurrent,$stuvdisp,$versionform,$js) =
                   &choose_task_version_form($symb,$env{'form.student'},
                                             $env{'form.userdom'},
                                             $env{'form.inhibitmenu'});
               &startpage($request,$symb,[{href=>"", text=>"Previous Student Version"}],undef,undef,$stuvcurrent,$stuvdisp,$env{'form.inhibitmenu'},$js);
               if ($versionform) {
                   $request->print($versionform);
               }
               $request->print('<br clear="all" />');
               $request->print(&show_previous_task_version($request,$symb));
  } elsif ($command eq 'pickStudentPage' && $perm{'vgr'}) {   } elsif ($command eq 'pickStudentPage' && $perm{'vgr'}) {
             &startpage($request,$symb,[{href=>&href_symb_cmd($symb,'all_for_one'),text=>'Grade page/folder for one student'},              &startpage($request,$symb,[{href=>&href_symb_cmd($symb,'all_for_one'),text=>'Grade page/folder for one student'},
                                        {href=>'',text=>'Select student'}],1,1);                                         {href=>'',text=>'Select student'}],1,1);
Line 9491  sub handler { Line 10257  sub handler {
     if ($ssi_error) {      if ($ssi_error) {
  &ssi_print_error($request);   &ssi_print_error($request);
     }      }
     &Apache::lonquickgrades::endGradeScreen($request);      if ($env{'form.inhibitmenu'}) {
     $request->print(&Apache::loncommon::end_page());          $request->print(&Apache::loncommon::end_page());
       } else {
           &Apache::lonquickgrades::endGradeScreen($request);
       }
     &reset_caches();      &reset_caches();
     return OK;      return OK;
 }  }
Line 9563  ssi_with_retries() Line 10332  ssi_with_retries()
   
 =over  =over
   
   =head1 Routines to display previous version of a Task for a specific student
   
   Tasks are graded pass/fail. Students who have yet to pass a particular Task
   can receive another opportunity. Access to tasks is slot-based. If a slot
   requires a proctor to check-in the student, a new version of the Task will
   be created when the student is checked in to the new opportunity.
   
   If a particular student has tried two or more versions of a particular task,
   the submission screen provides a user with vgr privileges (e.g., a Course
   Coordinator) the ability to display a previous version worked on by the
   student.  By default, the current version is displayed. If a previous version
   has been selected for display, submission data are only shown that pertain
   to that particular version, and the interface to submit grades is not shown.
   
   =over 4
   
   =item show_previous_task_version()
   
   Displays a specified version of a student's Task, as the student sees it.
   
   Inputs: 2
           request - request object
           symb    - unique symb for current instance of resource
   
   Output: None.
   
   Side Effects: calls &show_problem() to print version of Task, with
                 version contained in form item: $env{'form.previousversion'}
   
   =item choose_task_version_form()
   
   Displays a web form used to select which version of a student's view of a
   Task should be displayed.  Either launches a pop-up window, or replaces
   content in existing pop-up, or replaces page in main window.
   
   Inputs: 4
           symb    - unique symb for current instance of resource
           uname   - username of student
           udom    - domain of student
           nomenu  - 1 if display is in a pop-up window, and hence no menu
                     breadcrumbs etc., are displayed
   
   Output: 4
           current   - student's current version
           displayed - student's version being displayed
           result    - scalar containing HTML for web form used to switch to
                       a different version (or a link to close window, if pop-up).
           js        - javascript for processing selection in versions web form
   
   Side Effects: None.
   
   =item previous_display_javascript()
   
   Inputs: 2
           nomenu  - 1 if display is in a pop-up window, and hence no menu
                     breadcrumbs etc., are displayed.
           current - student's current version number.
   
   Output: 1
           js      - javascript for processing selection in versions web form.
   
   Side Effects: None.
   
   =back
   
   =head1 Routines to process bubblesheet data.
   
   =over 4
   
 =item scantron_get_correction() :   =item scantron_get_correction() : 
   
    Builds the interface screen to interact with the operator to fix a     Builds the interface screen to interact with the operator to fix a
Line 9589  ssi_with_retries() Line 10427  ssi_with_retries()
          - missingbubble - array ref of the bubble lines that have missing           - missingbubble - array ref of the bubble lines that have missing
                            bubble errors                             bubble errors
   
      $randomorder - True if exam folder has randomorder set
      $randompick  - True if exam folder has randompick set
      $respnumlookup - Reference to HASH mapping question numbers in bubble lines
                        for current line to question number used for same question
                        in "Master Seqence" (as seen by Course Coordinator).
      $startline   - Reference to hash where key is question number (0 is first)
                     and value is number of first bubble line for current student
                     or code-based randompick and/or randomorder.
   
   
   
 =item  scantron_get_maxbubble() :   =item  scantron_get_maxbubble() : 
   
    Arguments:     Arguments:
Line 9609  ssi_with_retries() Line 10458  ssi_with_retries()
    $env{'form.scantron.bubble_lines.n'},      $env{'form.scantron.bubble_lines.n'}, 
    $env{'form.scantron.first_bubble_line.n'} and     $env{'form.scantron.first_bubble_line.n'} and
    $env{"form.scantron.sub_bubblelines.n"}     $env{"form.scantron.sub_bubblelines.n"}
    which are the total number of bubble, lines, the number of bubble     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,     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     and a comma separated list of numbers of bubble lines for sub-questions
    (for optionresponse, matchresponse, and rankresponse items), for response n.       (for optionresponse, matchresponse, and rankresponse items), for response n.  
Line 9623  ssi_with_retries() Line 10472  ssi_with_retries()
   
 =item  scantron_process_students() :   =item  scantron_process_students() : 
   
    Routine that does the actual grading of the bubble sheet information.     Routine that does the actual grading of the bubblesheet information.
   
    The parsed scanline hash is added to %env      The parsed scanline hash is added to %env 
   
Line 9643  ssi_with_retries() Line 10492  ssi_with_retries()
   
 =item  scantron_upload_scantron_data() :  =item  scantron_upload_scantron_data() :
   
     Creates the screen for adding a new bubble sheet data file to a course.      Creates the screen for adding a new bubblesheet data file to a course.
   
 =item  scantron_upload_scantron_data_save() :   =item  scantron_upload_scantron_data_save() : 
   
Line 9657  ssi_with_retries() Line 10506  ssi_with_retries()
 =item  scantron_download_scantron_data() :   =item  scantron_download_scantron_data() : 
   
    Shows a list of the three internal files (original, corrected,     Shows a list of the three internal files (original, corrected,
    skipped) for a specific bubble sheet data file that exists in the     skipped) for a specific bubblesheet data file that exists in the
    course.     course.
   
 =item  scantron_validate_ID() :   =item  scantron_validate_ID() : 
Line 9668  ssi_with_retries() Line 10517  ssi_with_retries()
 =item navmap_errormsg() :  =item navmap_errormsg() :
   
    Returns HTML mark-up inside a <div></div> with a link to re-initialize the course.     Returns HTML mark-up inside a <div></div> with a link to re-initialize the course.
    Should be called whenever the request to instantiate a navmap object fails.       Should be called whenever the request to instantiate a navmap object fails.
   
   =back
   
 =back  =back
   

Removed from v.1.655  
changed lines
  Added in v.1.696


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