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

Diff for /loncom/homework/grades.pm between versions 1.596.2.12.2.15 and 1.596.2.12.2.16

version 1.596.2.12.2.15, 2013/05/30 05:28:03 version 1.596.2.12.2.16, 2013/06/28 22:54:50
Line 5308  my %subdivided_bubble_lines;       # no. Line 5308  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 5321  sub save_bubble_lines { Line 5326  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 5336  sub restore_bubble_lines { Line 5346  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 6021  sub digits_to_letters { Line 6015  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 6065  sub digits_to_letters { Line 6080  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 6106  sub scantron_parse_scanline { Line 6121  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 6118  sub scantron_parse_scanline { Line 6152  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 6133  sub scantron_parse_scanline { Line 6172  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 6145  sub scantron_parse_scanline { Line 6187  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 6157  sub scantron_parse_scanline { Line 6201  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 6178  sub scantron_validator_lettnum { Line 6279  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 6238  sub scantron_validator_lettnum { Line 6343  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 6280  sub scantron_validator_positional { Line 6386  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 6692  SCANTRONFORM Line 6802  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 6767  sub scantron_validate_file { Line 6879  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 7261  sub scantron_validate_ID { Line 7374  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
Line 7397  ENDSCRIPT Line 7511  ENDSCRIPT
  # 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 7405  ENDSCRIPT Line 7520  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));
Line 7419  ENDSCRIPT Line 7536  ENDSCRIPT
  # 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 7478  used to fill in the scantron_questions f Line 7598  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 7492  sub questions_to_line_list { Line 7620  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;
               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{$question-1});              my @subans = split(/,/,$subdivided_bubble_lines{$question-1});
             my $subcount = 1;              my $subcount = 1;
             while ($subcount<$subquestion) {              while ($subcount<$subquestion) {
Line 7548  for multi and missing bubble cases). Line 7684  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 7564  sub prompt_for_corrections { Line 7711  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 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 />');              $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 />");
Line 7582  sub prompt_for_corrections { Line 7738  sub prompt_for_corrections {
     }      }
     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 7836  sub scantron_validate_doublebubble { Line 7992  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 7851  sub scantron_validate_doublebubble { Line 8038  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 7894  sub scantron_get_maxbubble { Line 8085  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 $resid = $resource->id();
         my ($analysis,$parts) = &scantron_partids_tograde($resource,$cid,$uname,          my ($analysis,$parts) = &scantron_partids_tograde($resource,$cid,$uname,
                                                           $udom,$bubbles_per_row);                                                            $udom,$bubbles_per_row);
         if ((ref($analysis) eq 'HASH') && (ref($parts) eq 'ARRAY')) {          if ((ref($analysis) eq 'HASH') && (ref($parts) eq 'ARRAY')) {
Line 7948  sub scantron_get_maxbubble { Line 8141  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 7980  sub scantron_validate_missingbubbles { Line 8174  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();
       } else {
           $r->print(&navmap_errormsg());
           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 $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 8003  sub scantron_validate_missingbubbles { Line 8238  sub scantron_validate_missingbubbles {
  foreach my $missing (@{$$scan_record{'scantron.missingerror'}}) {   foreach my $missing (@{$$scan_record{'scantron.missingerror'}}) {
             my $lastbubble;              my $lastbubble;
             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};
                my $subcount = 1;                      $first = $startline{$question-1};
                while ($subcount<$subquestion) {                  } else {
                    $first += $subans[$subcount-1];                      $responsenum = $question-1;
                    $subcount ++;                      $first = $first_bubble_line{$responsenum};
                }                  }
                my $count = $subans[$subquestion-1];                  if (!defined($first)) { next; }
                $lastbubble = $first + $count;                  my @subans = split(/,/,$subdivided_bubble_lines{$question-1});
                   my $subcount = 1;
                   while ($subcount<$subquestion) {
                       $first += $subans[$subcount-1];
                       $subcount ++;
                   }
                   my $count = $subans[$subquestion-1];
                   $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 8079  sub scantron_process_students { Line 8331  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 8088  sub scantron_process_students { Line 8339  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 $map=$navmap->getResourceByUrl($sequence);
     my $randomorder;      my ($randomorder,$randompick,@master_seq,%symb_to_resource,%grader_partids_by_symb,
           %grader_randomlists_by_symb);
     if (ref($map)) {      if (ref($map)) {
         $randomorder = $map->randomorder();          $randomorder = $map->randomorder();
           $randompick = $map->randompick();
       } else {
           $r->print(&navmap_errormsg());
           return '';
     }      }
       my $nav_error;
     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,%ordered);      my (%grader_partids_by_symb,%grader_randomlists_by_symb,%ordered);
     &graders_resources_pass(\@resources,\%grader_partids_by_symb,      if ($randomorder || $randompick) {
                             \%grader_randomlists_by_symb,$bubbles_per_row);          $nav_error = &get_master_seq(\@resources,\@master_seq,\%symb_to_resource);
     my ($resource_error,%symb_to_resource,@master_seq);          if ($nav_error) {
     foreach my $resource (@resources) {              $r->print(&navmap_errormsg());
         my $ressymb;              return '';
         if (ref($resource)) {  
             $ressymb = $resource->symb();  
             push(@master_seq,$ressymb);  
             $symb_to_resource{$ressymb} = $resource;  
         } 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) {  
         $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 8147  SCANTRONFORM Line 8384  SCANTRONFORM
     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 8167  SCANTRONFORM Line 8403  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 8178  SCANTRONFORM Line 8415  SCANTRONFORM
      '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 8204  SCANTRONFORM Line 8448  SCANTRONFORM
         }          }
   
         my @mapresources = @resources;          my @mapresources = @resources;
         if ($randomorder) {          if ($randomorder || $randompick) {
             @mapresources =              @mapresources =
                 &users_order($user,$scancode,$sequence,\@master_seq,\%ordered,                  &users_order($user,$scancode,$sequence,\@master_seq,\%symb_to_resource,
                              \%symb_to_resource);                               \%orderedforcode);
         }          }
         my (%partids_by_symb,$res_error);          my (%partids_by_symb,$res_error);
         foreach my $resource (@mapresources) {          foreach my $resource (@mapresources) {
Line 8244  SCANTRONFORM Line 8488  SCANTRONFORM
   
         if (&grade_student_bubbles($r,$uname,$udom,$scan_record,$scancode,          if (&grade_student_bubbles($r,$uname,$udom,$scan_record,$scancode,
                                    \@mapresources,\%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 8253  SCANTRONFORM Line 8499  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$//;
Line 8266  SCANTRONFORM Line 8525  SCANTRONFORM
                 ($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,
                                            \@mapresources,\%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 8289  SCANTRONFORM Line 8551  SCANTRONFORM
                     ($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) {
Line 8368  sub graders_resources_pass { Line 8632  sub graders_resources_pass {
   if this is a CODEd exam, or based on student's identity if this is a    if this is a CODEd exam, or based on student's identity if this is a
   "NAMEd" exam.    "NAMEd" exam.
   
   Should be used when randomorder applied when the corresponding exam was    Should be used when randomorder and/or randompick applied when the 
   printed, prior to students completing bubblesheets for the version of the    corresponding exam was printed, prior to students completing bubblesheets 
   exam the student received.    for the version of the exam the student received.
   
 =cut  =cut
   
 sub users_order  {  sub users_order  {
     my ($user,$scancode,$mapurl,$master_seq,$ordered,$symb_to_resource) = @_;      my ($user,$scancode,$mapurl,$master_seq,$symb_to_resource,$orderedforcode) = @_;
     my @mapresources;      my @mapresources;
     unless ((ref($ordered) eq 'HASH') && (ref($symb_to_resource) eq 'HASH')) {      unless ((ref($master_seq) eq 'ARRAY') && (ref($symb_to_resource) eq 'HASH')) {
         return @mapresources;          return @mapresources;
     }      }
     if (($scancode) && (ref($ordered->{$scancode}) eq 'ARRAY')) {      if ($scancode) {
         @mapresources = @{$ordered->{$scancode}};          if ((ref($orderedforcode) eq 'HASH') && (ref($orderedforcode->{$scancode}) eq 'ARRAY')) {
     } elsif ($scancode) {              @mapresources = @{$orderedforcode->{$scancode}};
         $env{'form.CODE'} = $scancode;          } else {
         my $actual_seq =              $env{'form.CODE'} = $scancode;
             &Apache::lonprintout::master_seq_to_person_seq($mapurl,              my $actual_seq =
                                                            $master_seq,                  &Apache::lonprintout::master_seq_to_person_seq($mapurl,
                                                            $user,$scancode,1);                                                                 $master_seq,
         if (ref($actual_seq) eq 'ARRAY') {                                                                 $user,$scancode,1);
             @{$ordered->{$scancode}} =              if (ref($actual_seq) eq 'ARRAY') {
                 map { $symb_to_resource->{$_}; } @{$actual_seq};                  @mapresources = map { $symb_to_resource->{$_}; } @{$actual_seq};
             @mapresources = @{$ordered->{$scancode}};                  if (ref($orderedforcode) eq 'HASH') {
                       if (@mapresources > 0) {
                           $orderedforcode->{$scancode} = \@mapresources;
                       }
                   }
               }
               delete($env{'form.CODE'});
         }          }
         delete($env{'form.CODE'});  
     } else {      } else {
         my $actual_seq =          my $actual_seq =
             &Apache::lonprintout::master_seq_to_person_seq($mapurl,              &Apache::lonprintout::master_seq_to_person_seq($mapurl,
Line 8403  sub users_order  { Line 8672  sub users_order  {
             @mapresources =              @mapresources =
                 map { $symb_to_resource->{$_}; } @{$actual_seq};                  map { $symb_to_resource->{$_}; } @{$actual_seq};
         }          }
      }      }
      return @mapresources;      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,
           $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 8430  sub grade_student_bubbles { Line 8706  sub grade_student_bubbles {
             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 8722  sub checkscantron_results { Line 9002  sub checkscantron_results {
         return '';          return '';
     }      }
     my $map=$navmap->getResourceByUrl($sequence);      my $map=$navmap->getResourceByUrl($sequence);
     my ($randomorder,@master_seq,%symb_to_resource);      my ($randomorder,$randompick,@master_seq,%symb_to_resource,%grader_partids_by_symb,
           %grader_randomlists_by_symb,%orderedforcode);
     if (ref($map)) {      if (ref($map)) {
         $randomorder=$map->randomorder();          $randomorder=$map->randomorder();
     }      }
     my @resources=$navmap->retrieveResources($map,\&scantron_filter,1,0);      my @resources=$navmap->retrieveResources($map,\&scantron_filter,1,0);
     foreach my $resource (@resources) {      my $nav_error = &get_master_seq(\@resources,\@master_seq,\%symb_to_resource);
         if (ref($resource)) {      if ($nav_error) {
             my $ressymb = $resource->symb();          $r->print(&navmap_errormsg());
             push(@master_seq,$ressymb);          return '';
             $symb_to_resource{$ressymb} = $resource;  
         }  
     }      }
     my (%grader_partids_by_symb,%grader_randomlists_by_symb);  
     &graders_resources_pass(\@resources,\%grader_partids_by_symb,      &graders_resources_pass(\@resources,\%grader_partids_by_symb,
                             \%grader_randomlists_by_symb,$bubbles_per_row);                              \%grader_randomlists_by_symb,$bubbles_per_row);
     my ($uname,$udom);      my ($uname,$udom);
Line 8745  sub checkscantron_results { Line 9023  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,$count);      my %prog_state=&Apache::lonhtmlcommon::Create_PrgWin($r,$count);
     my ($username,$domain,$started,%ordered);      my ($username,$domain,$started,%ordered);
     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 8773  sub checkscantron_results { Line 9050  sub checkscantron_results {
         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 8787  sub checkscantron_results { Line 9064  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 $lastpos = $env{'form.scantron_maxbubble'}*$scantron_config{'Qlength'};  
         $scandata{$pid} = substr($line,$scantron_config{'Qstart'}-1,$lastpos);  
         chomp($scandata{$pid});  
         $scandata{$pid} =~ s/\r$//;  
         my $usec = $classlist->{$uname}->[&Apache::loncoursedata::CL_SECTION];          my $usec = $classlist->{$uname}->[&Apache::loncoursedata::CL_SECTION];
         my $user = $uname.':'.$usec;          my $user = $uname.':'.$usec;
         ($username,$domain)=split(/:/,$uname);          ($username,$domain)=split(/:/,$uname);
Line 8804  sub checkscantron_results { Line 9077  sub checkscantron_results {
         }          }
   
         my @mapresources = @resources;          my @mapresources = @resources;
         if ($randomorder) {          my $lastpos = $env{'form.scantron_maxbubble'}*$scantron_config{'Qlength'};
           my %respnumlookup=();
           my %startline=();
           if ($randomorder || $randompick) {
             @mapresources =              @mapresources =
                 &users_order($user,$scancode,$sequence,\@master_seq,\%ordered,                  &users_order($user,$scancode,$sequence,\@master_seq,\%symb_to_resource,
                              \%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);
           chomp($scandata{$pid});
           $scandata{$pid} =~ s/\r$//;
   
         my $counter = -1;          my $counter = -1;
         foreach my $resource (@mapresources) {          foreach my $resource (@mapresources) {
             my $parts;              my $parts;
Line 8825  sub checkscantron_results { Line 9112  sub checkscantron_results {
             ($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 8901  sub checkscantron_results { Line 9190  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 8910  sub verify_scantron_grading { Line 9200  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 9014  sub verify_scantron_grading { Line 9310  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 10250  ssi_with_retries() Line 10546  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 10270  ssi_with_retries() Line 10576  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.  
Removed from v.1.596.2.12.2.15  
changed lines
  Added in v.1.596.2.12.2.16

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