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

Diff for /loncom/homework/grades.pm between versions 1.499 and 1.513.2.1

version 1.499, 2007/12/05 18:40:59 version 1.513.2.1, 2008/03/24 19:08:09
Line 47  use LONCAPA; Line 47  use LONCAPA;
 use POSIX qw(floor);  use POSIX qw(floor);
   
   
   
 my %perm=();  my %perm=();
   
   #  These variables are used to recover from ssi errors
   
   my $ssi_retries = 5;
   my $ssi_error;
   my $ssi_error_resource;
   my $ssi_error_message;
   
   
   #  Do an ssi with retries:
   #  While I'd love to factor out this with the vesrion in lonprintout,
   #  that would either require a data coupling between modules, which I refuse to perpetuate
   #  (there's quite enough of that already), or would require the invention of another infrastructure
   #  I'm not quite ready to invent (e.g. an ssi_with_retry object).
   #
   # At least the logic that drives this has been pulled out into loncommon.
   
   
   #
   #   ssi_with_retries - Does the server side include of a resource.
   #                      if the ssi call returns an error we'll retry it up to
   #                      the number of times requested by the caller.
   #                      If we still have a proble, no text is appended to the
   #                      output and we set some global variables.
   #                      to indicate to the caller an SSI error occured.  
   #                      All of this is supposed to deal with the issues described
   #                      in LonCAPA BZ 5631 see:
   #                      http://bugs.lon-capa.org/show_bug.cgi?id=5631
   #                      by informing the user that this happened.
   #
   # Parameters:
   #   resource   - The resource to include.  This is passed directly, without
   #                interpretation to lonnet::ssi.
   #   form       - The form hash parameters that guide the interpretation of the resource
   #                
   #   retries    - Number of retries allowed before giving up completely.
   # Returns:
   #   On success, returns the rendered resource identified by the resource parameter.
   # Side Effects:
   #   The following global variables can be set:
   #    ssi_error                - If an unrecoverable error occured this becomes true.
   #                               It is up to the caller to initialize this to false
   #                               if desired.
   #    ssi_last_error_resource  - If an unrecoverable error occured, this is the value
   #                               of the resource that could not be rendered by the ssi
   #                               call.
   #    ssi_last_error           - The error string fetched from the ssi response
   #                               in the event of an error.
   #
   sub ssi_with_retries {
       my ($resource, $retries, %form) = @_;
       my ($content, $response) = &Apache::loncommon::ssi_with_retries($resource, $retries, %form);
       if ($response->is_error) {
    $ssi_error          = 1;
    $ssi_error_resource = $resource;
    $ssi_error_message  = $response->code . " " . $response->message;
       }
   
       return $content;
   
   }
   #
   #  Prodcuces an ssi retry failure error message to the user:
   #
   
   sub ssi_print_error {
       my ($r) = @_;
       $r->print('<h2>Unrecoverable network error</h2>');
       $r->print('<p>Unable to perform a resource fetch from a server: <br />');
       $r->print("Resource: $ssi_error_resource <br />");
       $r->print("Error: $ssi_error_message <br /> Try again later.");
       $r->print('If errors persist, contact LonCAPA support for assistance</p>');
   }
   
 #  #
 # --- Retrieve the parts from the metadata file.---  # --- Retrieve the parts from the metadata file.---
 sub getpartlist {  sub getpartlist {
Line 201  sub reset_caches { Line 275  sub reset_caches {
   
  my (undef,undef,$url)=&Apache::lonnet::decode_symb($symb);   my (undef,undef,$url)=&Apache::lonnet::decode_symb($symb);
  $url=&Apache::lonnet::clutter($url);   $url=&Apache::lonnet::clutter($url);
  my $subresult=&Apache::lonnet::ssi($url,   my $subresult=&ssi_with_retries($url, $ssi_retries,
    ('grade_target' => 'analyze'),     ('grade_target' => 'analyze'),
    ('grade_domain' => $udom),     ('grade_domain' => $udom),
    ('grade_symb' => $symb),     ('grade_symb' => $symb),
Line 3960  sub csvuploadassign { Line 4034  sub csvuploadassign {
  $grades{$store_key}=$entries{$fields{$dest}};   $grades{$store_key}=$entries{$fields{$dest}};
     }      }
  }   }
  if (! %grades) { push(@skipped,"$username:$domain no data to save"); }   if (! %grades) { 
  $grades{"resource.regrader"}="$env{'user.name'}:$env{'user.domain'}";             push(@skipped,&mt("[_1]: no data to save","$username:$domain")); 
  my $result=&Apache::lonnet::cstore(\%grades,$symb,          } else {
      $grades{"resource.regrader"}="$env{'user.name'}:$env{'user.domain'}";
      my $result=&Apache::lonnet::cstore(\%grades,$symb,
    $env{'request.course.id'},     $env{'request.course.id'},
    $domain,$username);     $domain,$username);
  if ($result eq 'ok') {     if ($result eq 'ok') {
     $request->print('.');        $request->print('.');
  } else {     } else {
     $request->print("<p>        $request->print("<p><span class=\"LC_error\">".
                               <span class=\"LC_error\">                                &mt("Failed to save data for student [_1]. Message when trying to save was: [_2]",
                                  Failed to save student $username:$domain.                                    "$username:$domain",$result)."</span></p>");
                                  Message when trying to save was ($result)     }
                               </span>     $request->rflush();
                              </p>" );     $countdone++;
  }          }
  $request->rflush();  
  $countdone++;  
     }      }
     $request->print("<br />Saved $countdone students\n");      $request->print('<br /><span class="LC_info">'.&mt("Saved [_1] students",$countdone)."</span>\n");
     if (@skipped) {      if (@skipped) {
  $request->print('<p><h4><b>Skipped Students</b></h4></p>');   $request->print('<p><span class="LC_warning">'.&mt('Skipped Students').'</span></p>');
  foreach my $student (@skipped) { $request->print("$student<br />\n"); }   foreach my $student (@skipped) { $request->print("$student<br />\n"); }
     }      }
     if (@notallowed) {      if (@notallowed) {
  $request->print('<p><span class="LC_error">Students Not Allowed to Modify</span></p>');   $request->print('<p><span class="LC_error">'.&mt('Students Not Allowed to Modify').'</span></p>');
  foreach my $student (@notallowed) { $request->print("$student<br />\n"); }   foreach my $student (@notallowed) { $request->print("$student<br />\n"); }
     }      }
     $request->print("<br />\n");      $request->print("<br />\n");
Line 4174  sub displayPage { Line 4248  sub displayPage {
     my $result='<h3><span class="LC_info">&nbsp;'.$env{'form.title'}.'</span></h3>';      my $result='<h3><span class="LC_info">&nbsp;'.$env{'form.title'}.'</span></h3>';
     $result.='<h3>&nbsp;'.&mt('Student: [_1]',&nameUserString(undef,$$fullname{$env{'form.student'}},$uname,$udom)).      $result.='<h3>&nbsp;'.&mt('Student: [_1]',&nameUserString(undef,$$fullname{$env{'form.student'}},$uname,$udom)).
  '</h3>'."\n";   '</h3>'."\n";
     if (&Apache::lonnet::validCODE($env{'form.CODE'})) {      $env{'form.CODE'} = uc($env{'form.CODE'});
       if (&Apache::lonnet::validCODE(uc($env{'form.CODE'}))) {
  $result.='<h3>&nbsp;'.&mt('CODE: [_1]',$env{'form.CODE'}).'</h3>'."\n";   $result.='<h3>&nbsp;'.&mt('CODE: [_1]',$env{'form.CODE'}).'</h3>'."\n";
     } else {      } else {
  delete($env{'form.CODE'});   delete($env{'form.CODE'});
Line 4680  my %bubble_lines_per_response;     # no. Line 4755  my %bubble_lines_per_response;     # no.
   
 my %first_bubble_line;             # First bubble line no. for each bubble.  my %first_bubble_line;             # First bubble line no. for each bubble.
   
   my %subdivided_bubble_lines;       # no. bubble lines for optionresponse, 
                                      # matchresponse or rankresponse, where 
                                      # an individual response can have multiple 
                                      # lines
   
   my %responsetype_per_response;     # responsetype for each response
   
 # Save and restore the bubble lines array to the form env.  # Save and restore the bubble lines array to the form env.
   
   
Line 4688  sub save_bubble_lines { Line 4770  sub save_bubble_lines {
  $env{"form.scantron.bubblelines.$line"}  = $bubble_lines_per_response{$line};   $env{"form.scantron.bubblelines.$line"}  = $bubble_lines_per_response{$line};
  $env{"form.scantron.first_bubble_line.$line"} =   $env{"form.scantron.first_bubble_line.$line"} =
     $first_bubble_line{$line};      $first_bubble_line{$line};
           $env{"form.scantron.sub_bubblelines.$line"} = 
               $subdivided_bubble_lines{$line};
           $env{"form.scantron.responsetype.$line"} =
               $responsetype_per_response{$line};
     }      }
 }  }
   
Line 4700  sub restore_bubble_lines { Line 4786  sub restore_bubble_lines {
  $bubble_lines_per_response{$line} = $value;   $bubble_lines_per_response{$line} = $value;
  $first_bubble_line{$line}  =   $first_bubble_line{$line}  =
     $env{"form.scantron.first_bubble_line.$line"};      $env{"form.scantron.first_bubble_line.$line"};
           $subdivided_bubble_lines{$line} =
               $env{"form.scantron.sub_bubblelines.$line"};
           $responsetype_per_response{$line} =
               $env{"form.scantron.responsetype.$line"};
  $line++;   $line++;
     }      }
   
Line 4865  sub scantron_selectphase { Line 4955  sub scantron_selectphase {
     my $CODE_unique=&scantron_CODEunique();      my $CODE_unique=&scantron_CODEunique();
     my $result;      my $result;
   
       $ssi_error = 0;
   
     # Chunk of form to prompt for a file to grade and how:      # Chunk of form to prompt for a file to grade and how:
   
     $result.= '      $result.= '
Line 5138  sub username_to_idmap { Line 5230  sub username_to_idmap {
                           - 'answer'                            - 'answer'
                                'response' - new answer or 'none' if blank                                 'response' - new answer or 'none' if blank
                                'question' - the bubble line to change                                 'question' - the bubble line to change
                                  'questionnum' - the question identifier,
                                                  may include subquestion. 
   
   Returns:    Returns:
     $line - the modified scanline      $line - the modified scanline
Line 5186  sub scantron_fixup_scanline { Line 5280  sub scantron_fixup_scanline {
  my $answer=${off}x$length;   my $answer=${off}x$length;
  if ($args->{'response'} eq 'none') {   if ($args->{'response'} eq 'none') {
     &scan_data($scan_data,      &scan_data($scan_data,
        "$whichline.no_bubble.".$args->{'question'},'1');         "$whichline.no_bubble.".$args->{'questionnum'},'1');
  } else {   } else {
     if ($on eq 'letter') {      if ($on eq 'letter') {
  my @alphabet=('A'..'Z');   my @alphabet=('A'..'Z');
Line 5198  sub scantron_fixup_scanline { Line 5292  sub scantron_fixup_scanline {
  substr($answer,$args->{'response'},1)=$on;   substr($answer,$args->{'response'},1)=$on;
     }      }
     &scan_data($scan_data,      &scan_data($scan_data,
        "$whichline.no_bubble.".$args->{'question'},undef,'1');         "$whichline.no_bubble.".$args->{'questionnum'},undef,'1');
  }   }
  my $where=$length*($args->{'question'}-1)+$scantron_config->{'Qstart'};   my $where=$length*($args->{'question'}-1)+$scantron_config->{'Qstart'};
  substr($line,$where-1,$length)=$answer;   substr($line,$where-1,$length)=$answer;
Line 5370  sub scantron_parse_scanline { Line 5464  sub scantron_parse_scanline {
     $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 = $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++;          my $quest_id = $questnum;
  my $currentquest = substr($questions,0,$answer_length);          my $currentquest = substr($questions,0,$answer_length);
  $questions       = substr($questions,$answer_length);          $questions       = substr($questions,$answer_length);
  if (length($currentquest) < $answer_length) { next; }          if (length($currentquest) < $answer_length) { next; }
   
  # Qon letter implies for each slot in currentquest we have:          if ($subdivided_bubble_lines{$questnum-1} =~ /,/) {
  #    ? or * for doubles a letter in A-Z for a bubble and              my $subquestnum = 1;
         #    about anything else (esp. a value of Qoff for missing              my $subquestions = $currentquest;
  #    bubbles.              my @subanswers_needed = 
                   split(/,/,$subdivided_bubble_lines{$questnum-1});  
               foreach my $subans (@subanswers_needed) {
  if ($$scantron_config{'Qon'} eq 'letter') {                  my $subans_length =
     if ($currentquest =~ /\?/                      ($$scantron_config{'Qlength'} * $subans)  || 1;
  || $currentquest =~ /\*/                  my $currsubquest = substr($subquestions,0,$subans_length);
  || (&occurence_count($currentquest, "[A-Z]") > 1)) {                  $subquestions   = substr($subquestions,$subans_length);
  push(@{$record{'scantron.doubleerror'}},$questnum);                  $quest_id = "$questnum.$subquestnum";
  for (my $ans = 0; $ans < $answers_needed; $ans++) {                   if (($$scantron_config{'Qon'} eq 'letter') ||
     my $bubble = substr($currentquest, $ans, 1);                      ($$scantron_config{'Qon'} eq 'number')) {
     if ($bubble =~ /[A-Z]/ ) {                      $ansnum = &scantron_validator_lettnum($ansnum, 
  $record{"scantron.$ansnum.answer"} = $bubble;                          $questnum,$quest_id,$subans,$currsubquest,$whichline,
     } else {                          \@alphabet,\%record,$scantron_config,$scan_data);
  $record{"scantron.$ansnum.answer"}='';                  } else {
     }                      $ansnum = &scantron_validator_positional($ansnum,
     $ansnum++;                          $questnum,$quest_id,$subans,$currsubquest,$whichline,                        \@alphabet,\%record,$scantron_config,$scan_data);
  }                  }
                   $subquestnum ++;
     } elsif (!defined($currentquest)              }
      || (&occurence_count($currentquest, $$scantron_config{'Qoff'}) == length($currentquest))          } else {
      || (&occurence_count($currentquest, "[A-Z]") == 0)) {              if (($$scantron_config{'Qon'} eq 'letter') ||
  for (my $ans = 0; $ans < $answers_needed; $ans++ ) {                  ($$scantron_config{'Qon'} eq 'number')) {
     $record{"scantron.$ansnum.answer"}='';                  $ansnum = &scantron_validator_lettnum($ansnum,$questnum,
     $ansnum++;                      $quest_id,$answers_needed,$currentquest,$whichline,
                       \@alphabet,\%record,$scantron_config,$scan_data);
  }              } else {
  if (!&scan_data($scan_data,"$whichline.no_bubble.$questnum")) {                  $ansnum = &scantron_validator_positional($ansnum,$questnum,
     push(@{$record{"scantron.missingerror"}},$questnum);                      $quest_id,$answers_needed,$currentquest,$whichline,
    #  $ansnum += $answers_needed;                      \@alphabet,\%record,$scantron_config,$scan_data);
  }              }
     } else {          }
  for (my $ans = 0; $ans < $answers_needed; $ans++) {      }
     my $bubble = substr($currentquest, $ans, 1);      $record{'scantron.maxquest'}=$questnum;
     $record{"scantron.$ansnum.answer"} = $bubble;      return \%record;
     $ansnum++;  }
  }  
     }  
   
  # Qon 'number' implies each slot gives a digit that indexes the  
  #    the bubbles filled or Qoff or a non number for unbubbled lines.  
         #    and *? for double bubbles on a line.  
  #    these answers are also stored as letters.  
   
  } elsif ($$scantron_config{'Qon'} eq 'number') {  
     if ($currentquest =~ /\?/  
  || $currentquest =~ /\*/  
  || (&occurence_count($currentquest, '\d') > 1)) {  
  push(@{$record{'scantron.doubleerror'}},$questnum);  
  for (my $ans = 0; $ans < $answers_needed; $ans++) {  
     my $bubble = substr($currentquest, $ans, 1);  
     if ($bubble =~ /\d/) {  
  $record{"scantron.$ansnum.answer"} = $alphabet[$bubble];  
     } else {  
  $record{"scantron.$ansnum.answer"}=' ';  
     }  
     $ansnum++;  
  }  
   
     } elsif (!defined($currentquest)  
      || (&occurence_count($currentquest,$$scantron_config{'Qoff'}) == length($currentquest))   
      || (&occurence_count($currentquest, '\d') == 0)) {  
  for (my $ans = 0; $ans < $answers_needed; $ans++ ) {  
     $record{"scantron.$ansnum.answer"}='';  
     $ansnum++;  
   
  }  
  if (!&scan_data($scan_data,"$whichline.no_bubble.$questnum")) {  
     push(@{$record{"scantron.missingerror"}},$questnum);  
     $ansnum += $answers_needed;  
  }  
   
     } else {  
  $currentquest = &digits_to_letters($currentquest);  
  for (my $ans =0; $ans < $answers_needed; $ans++) {  
     $record{"scantron.$ansnum.answer"} = substr($currentquest, $ans, 1);  
     $ansnum++;  
  }  
     }  
  } else {  
   
     # Otherwise there's a positional notation;  sub scantron_validator_lettnum {
     # each bubble line requires Qlength items, and there are filled in      my ($ansnum,$questnum,$quest_id,$answers_needed,$currquest,$whichline,
     # bubbles for each case where there 'Qon' characters.          $alphabet,$record,$scantron_config,$scan_data) = @_;
     #  
       # Qon 'letter' implies for each slot in currquest we have:
       #    ? or * for doubles, a letter in A-Z for a bubble, and
       #    about anything else (esp. a value of Qoff) for missing
       #    bubbles.
       #
       # Qon 'number' implies each slot gives a digit that indexes the
       #    bubbles filled, or Qoff, or a non-number for unbubbled lines,
       #    and * or ? for double bubbles on a single line.
       #
   
     my @array=split($$scantron_config{'Qon'},$currentquest,-1);      my $matchon;
       if ($$scantron_config{'Qon'} eq 'letter') {
           $matchon = '[A-Z]';
       } elsif ($$scantron_config{'Qon'} eq 'number') {
           $matchon = '\d';
       }
       my $occurrences = 0;
       if (($responsetype_per_response{$questnum-1} eq 'essayresponse') ||
           ($responsetype_per_response{$questnum-1} eq 'formularesponse') ||
           ($responsetype_per_response{$questnum-1} eq 'stringresponse') ||
           ($responsetype_per_response{$questnum-1} eq 'imageresponse') ||
           ($responsetype_per_response{$questnum-1} eq 'reactionresponse') ||
           ($responsetype_per_response{$questnum-1} eq 'organicresponse')) {
           my @singlelines = split('',$currquest);
           foreach my $entry (@singlelines) {
               $occurrences = &occurence_count($entry,$matchon);
               if ($occurrences > 1) {
                   last;
               }
           } 
       } else {
           $occurrences = &occurence_count($currquest,$matchon); 
       }
       if (($currquest =~ /\?/ || $currquest =~ /\*/) || ($occurrences > 1)) {
           push(@{$record->{'scantron.doubleerror'}},$quest_id);
           for (my $ans=0; $ans<$answers_needed; $ans++) {
               my $bubble = substr($currquest,$ans,1);
               if ($bubble =~ /$matchon/ ) {
                   if ($$scantron_config{'Qon'} eq 'number') {
                       if ($bubble == 0) {
                           $bubble = 10; 
                       }
                       $record->{"scantron.$ansnum.answer"} = 
                           $alphabet->[$bubble-1];
                   } else {
                       $record->{"scantron.$ansnum.answer"} = $bubble;
                   }
               } else {
                   $record->{"scantron.$ansnum.answer"}='';
               }
               $ansnum++;
           }
       } elsif (!defined($currquest)
               || (&occurence_count($currquest, $$scantron_config{'Qoff'}) == length($currquest))
               || (&occurence_count($currquest,$matchon) == 0)) {
           for (my $ans=0; $ans<$answers_needed; $ans++ ) {
               $record->{"scantron.$ansnum.answer"}='';
               $ansnum++;
           }
           if (!&scan_data($scan_data,"$whichline.no_bubble.$quest_id")) {
               push(@{$record->{'scantron.missingerror'}},$quest_id);
           }
       } else {
           if ($$scantron_config{'Qon'} eq 'number') {
               $currquest = &digits_to_letters($currquest);            
           }
           for (my $ans=0; $ans<$answers_needed; $ans++) {
               my $bubble = substr($currquest,$ans,1);
               $record->{"scantron.$ansnum.answer"} = $bubble;
               $ansnum++;
           }
       }
       return $ansnum;
   }
   
     # If the split only  giveas us one element.. the full length of the  sub scantron_validator_positional {
     # answser string, no bubbles are filled in:      my ($ansnum,$questnum,$quest_id,$answers_needed,$currquest,
           $whichline,$alphabet,$record,$scantron_config,$scan_data) = @_;
   
     if (length($array[0]) eq $$scantron_config{'Qlength'}*$answers_needed) {      # Otherwise there's a positional notation;
  for (my $ans = 0; $ans < $answers_needed; $ans++ ) {      # each bubble line requires Qlength items, and there are filled in
     $record{"scantron.$ansnum.answer"}='';      # bubbles for each case where there 'Qon' characters.
     $ansnum++;      #
   
  }      my @array=split($$scantron_config{'Qon'},$currquest,-1);
  if (!&scan_data($scan_data,"$whichline.no_bubble.$questnum")) {  
     push(@{$record{"scantron.missingerror"}},$questnum);  
  }  
   
   
       # If the split only gives us one element.. the full length of the
       # answer string, no bubbles are filled in:
   
     } elsif (scalar(@array) eq 2) {      if ($answers_needed eq '') {
           return;
       }
   
  my $location      = length($array[0]);      if (length($array[0]) eq $$scantron_config{'Qlength'}*$answers_needed) {
  my $line_num      = int($location / $$scantron_config{'Qlength'});          for (my $ans=0; $ans<$answers_needed; $ans++ ) {
  my $bubble        = $alphabet[$location % $$scantron_config{'Qlength'}];              $record->{"scantron.$ansnum.answer"}='';
               $ansnum++;
           }
           if (!&scan_data($scan_data,"$whichline.no_bubble.$quest_id")) {
               push(@{$record->{"scantron.missingerror"}},$quest_id);
           }
       } elsif (scalar(@array) == 2) {
           my $location = length($array[0]);
           my $line_num = int($location / $$scantron_config{'Qlength'});
           my $bubble   = $alphabet->[$location % $$scantron_config{'Qlength'}];
           for (my $ans=0; $ans<$answers_needed; $ans++) {
               if ($ans eq $line_num) {
                   $record->{"scantron.$ansnum.answer"} = $bubble;
               } else {
                   $record->{"scantron.$ansnum.answer"} = ' ';
               }
               $ansnum++;
            }
       } else {
           #  If there's more than one instance of a bubble character
           #  That's a double bubble; with positional notation we can
           #  record all the bubbles filled in as well as the
           #  fact this response consists of multiple bubbles.
           #
           if (($responsetype_per_response{$questnum-1} eq 'essayresponse') ||
               ($responsetype_per_response{$questnum-1} eq 'formularesponse') ||
               ($responsetype_per_response{$questnum-1} eq 'stringresponse') ||
               ($responsetype_per_response{$questnum-1} eq 'imageresponse') ||
               ($responsetype_per_response{$questnum-1} eq 'reactionresponse') ||
               ($responsetype_per_response{$questnum-1} eq 'organicresponse')) {
               my $doubleerror = 0;
               while (($currquest >= $$scantron_config{'Qlength'}) && 
                      (!$doubleerror)) {
                  my $currline = substr($currquest,0,$$scantron_config{'Qlength'});
                  $currquest = substr($currquest,$$scantron_config{'Qlength'});
                  my @currarray = split($$scantron_config{'Qon'},$currline,-1);
                  if (length(@currarray) > 2) {
                      $doubleerror = 1;
                  } 
               }
               if ($doubleerror) {
                   push(@{$record->{'scantron.doubleerror'}},$quest_id);
               }
           } else {
               push(@{$record->{'scantron.doubleerror'}},$quest_id);
           }
           my $item = $ansnum;
           for (my $ans=0; $ans<$answers_needed; $ans++) {
               $record->{"scantron.$item.answer"} = '';
               $item ++;
           }
   
  for (my $ans = 0; $ans < $answers_needed; $ans++) {          my @ans=@array;
     if ($ans eq $line_num) {          my $i=0;
  $record{"scantron.$ansnum.answer"} = $bubble;          my $increment = 0;
     } else {          while ($#ans) {
  $record{"scantron.$ansnum.answer"} = ' ';              $i+=length($ans[0]) + $increment;
     }              my $line   = int($i/$$scantron_config{'Qlength'} + $ansnum);
     $ansnum++;              my $bubble = $i%$$scantron_config{'Qlength'};
  }              $record->{"scantron.$line.answer"}.=$alphabet->[$bubble];
     }              shift(@ans);
     #  If there's more than one instance of a bubble character              $increment = 1;
     #  That's a double bubble; with positional notation we can          }
     #  record all the bubbles filled in as well as the           $ansnum += $answers_needed;
     #  fact this response consists of multiple bubbles.  
     #  
     else {  
  push(@{$record{'scantron.doubleerror'}},$questnum);  
   
  my $first_answer = $ansnum;  
  for (my $ans =0; $ans < $answers_needed; $ans++) {  
     my $item = $first_answer+$ans;  
     $record{"scantron.$item.answer"} = '';  
  }  
   
  my @ans=@array;  
  my $i=0;  
  my $increment = 0;  
  while ($#ans) {  
     $i+=length($ans[0]) + $increment;  
     my $line   = int($i/$$scantron_config{'Qlength'} + $first_answer);  
     my $bubble = $i%$$scantron_config{'Qlength'};  
     $record{"scantron.$line.answer"}.=$alphabet[$bubble];  
     shift(@ans);  
     $increment = 1;  
  }  
  $ansnum += $answers_needed;  
     }  
  }  
     }      }
     $record{'scantron.maxquest'}=$questnum;      return $ansnum;
     return \%record;  
 }  }
   
 =pod  =pod
Line 5669  sub scantron_process_corrections { Line 5815  sub scantron_process_corrections {
  &scantron_fixup_scanline(\%scantron_config,$scan_data,$line,   &scantron_fixup_scanline(\%scantron_config,$scan_data,$line,
  $which,'answer',   $which,'answer',
  { 'question'=>$question,   { 'question'=>$question,
          'response'=>$env{"form.scantron_correct_Q_$question"}});           'response'=>$env{"form.scantron_correct_Q_$question"},
                                      'questionnum'=>$env{"form.scantron_questionnum_Q_$question"}});
     if ($err) { last; }      if ($err) { last; }
  }   }
     }      }
Line 5888  SCANTRONFORM Line 6035  SCANTRONFORM
    '<input type="hidden" name="scantron.bubblelines.'.$line.'" value="'.$env{"form.scantron.bubblelines.$line"}.'" />'."\n";     '<input type="hidden" name="scantron.bubblelines.'.$line.'" value="'.$env{"form.scantron.bubblelines.$line"}.'" />'."\n";
        $chunk .=         $chunk .=
    '<input type="hidden" name="scantron.first_bubble_line.'.$line.'" value="'.$env{"form.scantron.first_bubble_line.$line"}.'" />'."\n";     '<input type="hidden" name="scantron.first_bubble_line.'.$line.'" value="'.$env{"form.scantron.first_bubble_line.$line"}.'" />'."\n";
          $chunk .= 
              '<input type="hidden" name="scantron.sub_bubblelines.'.$line.'" value="'.$env{"form.scantron.sub_bubblelines.$line"}.'" />'."\n";
          $chunk .=
              '<input type="hidden" name="scantron.responsetype.'.$line.'" value="'.$env{"form.scantron.responsetype.$line"}.'" />'."\n";
        $result .= $chunk;         $result .= $chunk;
        $line++;         $line++;
    }     }
Line 5932  sub scantron_validate_file { Line 6083  sub scantron_validate_file {
     if ($env{'form.scantron_corrections'}) {      if ($env{'form.scantron_corrections'}) {
  &scantron_process_corrections($r);   &scantron_process_corrections($r);
     }      }
     $r->print('<p>'.&mt('Gathering necessary info.').'</p>');$r->rflush();      $r->print('<p>'.&mt('Gathering necessary information.').'</p>');$r->rflush();
     #get the student pick code ready      #get the student pick code ready
     $r->print(&Apache::loncommon::studentbrowser_javascript());      $r->print(&Apache::loncommon::studentbrowser_javascript());
     my $max_bubble=&scantron_get_maxbubble();      my $max_bubble=&scantron_get_maxbubble();
Line 5952  sub scantron_validate_file { Line 6103  sub scantron_validate_file {
   
     my $stop=0;      my $stop=0;
     while (!$stop && $currentphase < scalar(@validate_phases)) {      while (!$stop && $currentphase < scalar(@validate_phases)) {
  $r->print('<p> '.&mt('Validating '.$validate_phases[$currentphase]).'</p>');   $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];
  {   {
Line 5962  sub scantron_validate_file { Line 6113  sub scantron_validate_file {
     }      }
     if (!$stop) {      if (!$stop) {
  my $warning=&scantron_warning_screen('Start Grading');   my $warning=&scantron_warning_screen('Start Grading');
  $r->print('   $r->print(&mt('Validation process complete.').'<br />
 '.&mt('Validation process complete.').'<br />  
 '.$warning.'  '.$warning.'
 <input type="submit" name="submit" value="'.&mt('Start Grading').'" />  <input type="submit" name="submit" value="'.&mt('Start Grading').'" />
 <input type="hidden" name="command" value="scantron_process" />  <input type="hidden" name="command" value="scantron_process" />
Line 5980  sub scantron_validate_file { Line 6130  sub scantron_validate_file {
   
     $r->print(" <p>".&mt("Or click the 'Grading Menu' button to start over.")."</p>");      $r->print(" <p>".&mt("Or click the 'Grading Menu' button to start over.")."</p>");
  } else {   } else {
     $r->print('<input type="submit" name="submit" value="'.&mt('Continue -&gt;').'" />');              if ($validate_phases[$currentphase] eq 'doublebubble' || $validate_phases[$currentphase] eq 'missingbubbles') {
           $r->print('<input type="button" name="submitbutton" value="'.&mt('Continue -&gt;').'" onclick="javascript:verify_bubble_radio(this.form)" />');
               } else {
                   $r->print('<input type="submit" name="submit" value="'.&mt('Continue -&gt;').'" />');
               }
     $r->print(' '.&mt('using corrected info').' <br />');      $r->print(' '.&mt('using corrected info').' <br />');
     $r->print("<input type='submit' value='".&mt("Skip")."' name='scantron_skip_record' />");      $r->print("<input type='submit' value='".&mt("Skip")."' name='scantron_skip_record' />");
     $r->print(" ".&mt("this scanline saving it for later."));      $r->print(" ".&mt("this scanline saving it for later."));
Line 6462  sub scantron_validate_ID { Line 6616  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)=@_;
   
 #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 6484  sub scantron_get_correction { Line 6637  sub scantron_get_correction {
   
     $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");
                              # Array populated for doublebubble or
       my @lines_to_correct;  # missingbubble errors to build javascript
                              # to validate radio button checking   
   
     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>".&mt("The encoded ID is not in the classlist").
Line 6579  ENDSCRIPT Line 6736  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 a some question(s)")."</p>\n");   $r->print("<p>".&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:
Line 6591  ENDSCRIPT Line 6748  ENDSCRIPT
  $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>");
  foreach my $question (@{$arg}) {   foreach my $question (@{$arg}) {
     &prompt_for_corrections($r, $question, $scan_config, $scan_record);      my @linenums = &prompt_for_corrections($r,$question,$scan_config,
                                                      $scan_record, $error);
               push (@lines_to_correct,@linenums);
  }   }
           $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>".&mt("There have been <b>no</b> bubbles scanned for some question(s)")."</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");
   
  # The form field scantron_questinos 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:
  #   #
   
Line 6608  ENDSCRIPT Line 6768  ENDSCRIPT
  $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}) {
     &prompt_for_corrections($r, $question, $scan_config, $scan_record);      my @linenums = &prompt_for_corrections($r,$question,$scan_config,
                                                      $scan_record, $error);
               push (@lines_to_correct,@linenums);
  }   }
           $r->print(&verify_bubbles_checked(@lines_to_correct));
     } else {      } else {
  $r->print("\n<ul>");   $r->print("\n<ul>");
     }      }
     $r->print("\n</li></ul>");      $r->print("\n</li></ul>");
 }  }
   
   sub verify_bubbles_checked {
       my (@ansnums) = @_;
       my $ansnumstr = join('","',@ansnums);
       my $warning = &mt("A bubble or 'No bubble' selection has not been made for one or more lines.");
       my $output = (<<ENDSCRIPT);
   <script type="text/javascript">
   function verify_bubble_radio(form) {
       var ansnumArray = new Array ("$ansnumstr");
       var need_bubble_count = 0;
       for (var i=0; i<ansnumArray.length; i++) {
           if (form.elements["scantron_correct_Q_"+ansnumArray[i]].length > 1) {
               var bubble_picked = 0; 
               for (var j=0; j<form.elements["scantron_correct_Q_"+ansnumArray[i]].length; j++) {
                   if (form.elements["scantron_correct_Q_"+ansnumArray[i]][j].checked == true) {
                       bubble_picked = 1;
                   }
               }
               if (bubble_picked == 0) {
                   need_bubble_count ++;
               }
           }
       }
       if (need_bubble_count) {
           alert("$warning");
           return;
       }
       form.submit(); 
   }
   </script>
   ENDSCRIPT
       return $output;
   }
   
 =pod  =pod
   
 =item  questions_to_line_list  =item  questions_to_line_list
Line 6634  sub questions_to_line_list { Line 6830  sub questions_to_line_list {
     my ($questions) = @_;      my ($questions) = @_;
     my @lines;      my @lines;
   
     foreach my $question (@{$questions}) {      foreach my $item (@{$questions}) {
  my $first   = $first_bubble_line{$question-1} + 1;          my $question = $item;
  my $count   = $bubble_lines_per_response{$question-1};          my ($first,$count,$last);
  my $last = $first+$count-1;          if ($item =~ /^(\d+)\.(\d+)$/) {
  push(@lines, ($first..$last));              $question = $1;
               my $subquestion = $2;
               $first = $first_bubble_line{$question-1} + 1;
               my @subans = split(/,/,$subdivided_bubble_lines{$question-1});
               my $subcount = 1;
               while ($subcount<$subquestion) {
                   $first += $subans[$subcount-1];
                   $subcount ++;
               }
               $count = $subans[$subquestion-1];
           } else {
       $first   = $first_bubble_line{$question-1} + 1;
       $count   = $bubble_lines_per_response{$question-1};
           }
           $last = $first+$count-1;
           push(@lines, ($first..$last));
     }      }
     return join(',', @lines);      return join(',', @lines);
 }  }
Line 6656  for multi and missing bubble cases). Line 6867  for multi and missing bubble cases).
    $question    - The question number to prompt for.     $question    - The question number to prompt for.
    $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
   
  Implicit inputs:   Implicit inputs:
    %bubble_lines_per_response   - Starting line numbers for each question.     %bubble_lines_per_response   - Starting line numbers for each question.
                                   Numbered from 0 (but question numbers are from                                    Numbered from 0 (but question numbers are from
                                   1.                                    1.
    %first_bubble_line           - Starting bubble line for each question.     %first_bubble_line           - Starting bubble line for each question.
      %subdivided_bubble_lines     - optionresponse, matchresponse and rankresponse 
                                     type problems render as separate sub-questions, 
                                     in exam mode. This hash contains a 
                                     comma-separated list of the lines per 
                                     sub-question.
      %responsetype_per_response   - essayresponse, formularesponse,
                                     stringresponse, imageresponse, reactionresponse,
                                     and organicresponse type problem parts can have
                                     multiple lines per response if the weight
                                     assigned exceeds 10.  In this case, only
                                     one bubble per line is permitted, but more 
                                     than one line might contain bubbles, e.g.
                                     bubbling of: line 1 - J, line 2 - J, 
                                     line 3 - B would assign 22 points.  
   
 =cut  =cut
   
 sub prompt_for_corrections {  sub prompt_for_corrections {
     my ($r, $question, $scan_config, $scan_record) = @_;      my ($r, $question, $scan_config, $scan_record, $error) = @_;
       my ($current_line,$lines);
     my $lines        = $bubble_lines_per_response{$question-1};      my @linenums;
     my $current_line = $first_bubble_line{$question-1} + 1 ;      my $questionnum = $question;
       if ($question =~ /^(\d+)\.(\d+)$/) {
           $question = $1;
           $current_line = $first_bubble_line{$question-1} + 1 ;
           my $subquestion = $2;
           my @subans = split(/,/,$subdivided_bubble_lines{$question-1});
           my $subcount = 1;
           while ($subcount<$subquestion) {
               $current_line += $subans[$subcount-1];
               $subcount ++;
           }
           $lines = $subans[$subquestion-1];
       } else {
           $current_line = $first_bubble_line{$question-1} + 1 ;
           $lines        = $bubble_lines_per_response{$question-1};
       }
     if ($lines > 1) {      if ($lines > 1) {
  $r->print(&mt("The group of bubble lines below responds to a single question. Select at most one bubble in a single line and select 'No Bubble' in all the other lines. ")."<br />");          $r->print(&mt('The group of bubble lines below responds to a single question.').'<br />');
           if (($responsetype_per_response{$question-1} eq 'essayresponse') ||
               ($responsetype_per_response{$question-1} eq 'formularesponse') ||
               ($responsetype_per_response{$question-1} eq 'stringresponse') ||
               ($responsetype_per_response{$question-1} eq 'imageresponse') ||
               ($responsetype_per_response{$question-1} eq 'reactionresponse') ||
               ($responsetype_per_response{$question-1} 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 scantron sheets.",$lines).'<br /><br />'.&mt('A non-zero score can be assigned to the student during scantron 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 {
               $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, 
   split('', $selected));            $questionnum,$error,split('', $selected));
           push (@linenums,$current_line);
  $current_line++;   $current_line++;
     }      }
     if ($lines > 1) {      if ($lines > 1) {
  $r->print("<hr /><br />");   $r->print("<hr /><br />");
     }      }
       return @linenums;
 }  }
   
 =pod  =pod
Line 6696  sub prompt_for_corrections { Line 6948  sub prompt_for_corrections {
     $r           - Apache request object      $r           - Apache request object
     $scan_config - hash from &get_scantron_config()      $scan_config - hash from &get_scantron_config()
     $line        - Number of the line being displayed.      $line        - Number of the line being displayed.
       $questionnum - Question number (may include subquestion)
       $error       - Type of error.
     @selected    - Array of bubbles picked on this line.      @selected    - Array of bubbles picked on this line.
   
 =cut  =cut
   
 sub scantron_bubble_selector {  sub scantron_bubble_selector {
     my ($r,$scan_config,$line,@selected)=@_;      my ($r,$scan_config,$line,$questionnum,$error,@selected)=@_;
     my $max=$$scan_config{'Qlength'};      my $max=$$scan_config{'Qlength'};
   
     my $scmode=$$scan_config{'Qon'};      my $scmode=$$scan_config{'Qon'};
     if ($scmode eq 'number' || $scmode eq 'letter') { $max=10; }           if ($scmode eq 'number' || $scmode eq 'letter') { $max=10; }     
   
     my @alphabet=('A'..'Z');      my @alphabet=('A'..'Z');
     $r->print("<table border='1'><tr><td rowspan='2'>$line</td>");      $r->print(&Apache::loncommon::start_data_table().
                 &Apache::loncommon::start_data_table_row());
       $r->print('<td rowspan="2" class="LC_leftcol_header">'.$line.'</td>');
     for (my $i=0;$i<$max+1;$i++) {      for (my $i=0;$i<$max+1;$i++) {
  $r->print("\n".'<td align="center">');   $r->print("\n".'<td align="center">');
  if ($selected[0] eq $alphabet[$i]) { $r->print('X'); shift(@selected) }   if ($selected[0] eq $alphabet[$i]) { $r->print('X'); shift(@selected) }
  else { $r->print('&nbsp;'); }   else { $r->print('&nbsp;'); }
  $r->print('</td>');   $r->print('</td>');
     }      }
     $r->print('</tr><tr>');      $r->print(&Apache::loncommon::end_data_table_row().
                 &Apache::loncommon::start_data_table_row());
     for (my $i=0;$i<$max;$i++) {      for (my $i=0;$i<$max;$i++) {
  $r->print("\n".   $r->print("\n".
   '<td><label><input type="radio" name="scantron_correct_Q_'.    '<td><label><input type="radio" name="scantron_correct_Q_'.
   $line.'" value="'.$i.'" />'.$alphabet[$i]."</label></td>");    $line.'" value="'.$i.'" />'.$alphabet[$i]."</label></td>");
     }      }
     $r->print('<td><label><input type="radio" name="scantron_correct_Q_'.      my $nobub_checked = ' ';
       $line.'" value="none" /> No bubble </label></td>');      if ($error eq 'missingbubble') {
     $r->print('</tr></table>');          $nobub_checked = ' checked = "checked" ';
       }
       $r->print("\n".'<td><label><input type="radio" name="scantron_correct_Q_'.
         $line.'" value="none"'.$nobub_checked.'/>'.&mt('No bubble').
                 '</label>'."\n".'<input type="hidden" name="scantron_questionnum_Q_'.
                 $line.'" value="'.$questionnum.'" /></td>');
       $r->print(&Apache::loncommon::end_data_table_row().
                 &Apache::loncommon::end_data_table());
 }  }
   
 =pod  =pod
Line 6903  sub scantron_validate_doublebubble { Line 7167  sub scantron_validate_doublebubble {
     #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();
   
     &scantron_get_maxbubble(); # parse needs the bubble line array.      &scantron_get_maxbubble(); # parse needs the bubble line array.
   
     for (my $i=0;$i<=$scanlines->{'count'};$i++) {      for (my $i=0;$i<=$scanlines->{'count'};$i++) {
Line 6930  sub scantron_validate_doublebubble { Line 7193  sub scantron_validate_doublebubble {
    for what the current value of the problem counter is.     for what the current value of the problem counter is.
   
    Caches the results to $env{'form.scantron_maxbubble'},     Caches the results to $env{'form.scantron_maxbubble'},
    $env{'form.scantron.bubble_lines.n'} and      $env{'form.scantron.bubble_lines.n'}, 
    $env{'form.scantron.first_bubble_line.n'}     $env{'form.scantron.first_bubble_line.n'} and
      $env{"form.scantron.sub_bubblelines.n"}
    which are the total number of bubble, lines, the number of bubble     which are the total number of bubble, lines, the number of bubble
    lines for reponse 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
      (for optionresponse, matchresponse, and rankresponse items), for response n.  
   
 =cut  =cut
   
 sub scantron_get_maxbubble {      sub scantron_get_maxbubble {
     if (defined($env{'form.scantron_maxbubble'}) &&      if (defined($env{'form.scantron_maxbubble'}) &&
  $env{'form.scantron_maxbubble'}) {   $env{'form.scantron_maxbubble'}) {
  &restore_bubble_lines();   &restore_bubble_lines();
Line 6959  sub scantron_get_maxbubble { Line 7225  sub scantron_get_maxbubble {
     my $total_lines = 0;      my $total_lines = 0;
     %bubble_lines_per_response = ();      %bubble_lines_per_response = ();
     %first_bubble_line         = ();      %first_bubble_line         = ();
       %subdivided_bubble_lines   = ();
       %responsetype_per_response = ();
       
     my $response_number = 0;      my $response_number = 0;
     my $bubble_line     = 0;      my $bubble_line     = 0;
     foreach my $resource (@resources) {      foreach my $resource (@resources) {
  my $symb = $resource->symb();          my $symb = $resource->symb();
  my $result=&Apache::lonnet::ssi($resource->src(),          # Need to retrieve part IDs and response IDs because essayresponse,
  ('symb' => $resource->symb()),          # reactionresponse and organicresponse items are not included in 
           # $analysis{'parts'} from lonnet::ssi.  
           my %possible_part_ids; 
           if (ref($resource->parts()) eq 'ARRAY') { 
               foreach my $part (@{$resource->parts()}) {
                   if (!&Apache::loncommon::check_if_partid_hidden($part,$symb,$udom,$uname)) {
                       my @resp_ids = $resource->responseIds($part);
                       foreach my $id (@resp_ids) {
                           $possible_part_ids{$part.'.'.$id} = 1;
                       }
                   }
               }
           }
    my $result=&ssi_with_retries($resource->src(), $ssi_retries,
    ('symb' => $symb),
  ('grade_target' => 'analyze'),   ('grade_target' => 'analyze'),
  ('grade_courseid' => $cid),   ('grade_courseid' => $cid),
  ('grade_domain' => $udom),   ('grade_domain' => $udom),
Line 6974  sub scantron_get_maxbubble { Line 7255  sub scantron_get_maxbubble {
  my (undef, $an) =   my (undef, $an) =
     split(/_HASH_REF__/,$result, 2);      split(/_HASH_REF__/,$result, 2);
   
  my %analysis = &Apache::lonnet::str2hash($an);          my @parts;
   
   
   
  foreach my $part_id (@{$analysis{'parts'}}) {  
   
     my $lines = $analysis{"$part_id.bubble_lines"};;   my %analysis = &Apache::lonnet::str2hash($an);
   
           if (ref($analysis{'parts'}) eq 'ARRAY') {
               foreach my $part (@{$analysis{'parts'}}) {
                   my ($id,$respid) = split(/\./,$part);
                   if (!&Apache::loncommon::check_if_partid_hidden($id,$symb,$udom,$uname)) {
                       push(@parts,$part);
                   }
               }
           }
           # Add part_ids for any essayresponse items. 
           foreach my $part_id (keys(%possible_part_ids)) {
               if (($analysis{$part_id.'.type'} eq 'essayresponse') ||
                   ($analysis{$part_id.'.type'} eq 'reactionresponse') ||
                   ($analysis{$part_id.'.type'} eq 'organicresponse')) {
                   if (!grep(/^\Q$part_id\E$/,@parts)) {
                       push (@parts,$part_id);
                   }
               }
           }
   
    foreach my $part_id (@parts) {
               my $lines = $analysis{"$part_id.bubble_lines"};
   
     # TODO - make this a persistent hash not an array.      # TODO - make this a persistent hash not an array.
   
               # optionresponse, matchresponse and rankresponse type items 
               # render as separate sub-questions in exam mode.
               if (($analysis{$part_id.'.type'} eq 'optionresponse') ||
                   ($analysis{$part_id.'.type'} eq 'matchresponse') ||
                   ($analysis{$part_id.'.type'} eq 'rankresponse')) {
                   my ($numbub,$numshown);
                   if ($analysis{$part_id.'.type'} eq 'optionresponse') {
                       if (ref($analysis{$part_id.'.options'}) eq 'ARRAY') {
                           $numbub = scalar(@{$analysis{$part_id.'.options'}});
                       }
                   } elsif ($analysis{$part_id.'.type'} eq 'matchresponse') {
                       if (ref($analysis{$part_id.'.items'}) eq 'ARRAY') {
                           $numbub = scalar(@{$analysis{$part_id.'.items'}});
                       }
                   } elsif ($analysis{$part_id.'.type'} eq 'rankresponse') {
                       if (ref($analysis{$part_id.'.foils'}) eq 'ARRAY') {
                           $numbub = scalar(@{$analysis{$part_id.'.foils'}});
                       }
                   }
                   if (ref($analysis{$part_id.'.shown'}) eq 'ARRAY') {
                       $numshown = scalar(@{$analysis{$part_id.'.shown'}});
                   }
                   my $bubbles_per_line = 10;
                   my $inner_bubble_lines = int($numshown/$bubbles_per_line);
                   if (($numshown % $bubbles_per_line) != 0) {
                       $inner_bubble_lines++;
                   }
                   for (my $i=0; $i<$numshown; $i++) {
                       $subdivided_bubble_lines{$response_number} .= 
                           $inner_bubble_lines.',';
                   }
                   $subdivided_bubble_lines{$response_number} =~ s/,$//;
               } 
   
     $first_bubble_line{$response_number}           = $bubble_line;              $first_bubble_line{$response_number} = $bubble_line;
     $bubble_lines_per_response{$response_number}   = $lines;      $bubble_lines_per_response{$response_number} = $lines;
               $responsetype_per_response{$response_number} = 
                   $analysis{$part_id.'.type'};
     $response_number++;      $response_number++;
   
     $bubble_line +=  $lines;      $bubble_line +=  $lines;
Line 7036  sub scantron_validate_missingbubbles { Line 7368  sub scantron_validate_missingbubbles {
  # Probably here's where the error is...   # Probably here's where the error is...
   
  foreach my $missing (@{$$scan_record{'scantron.missingerror'}}) {   foreach my $missing (@{$$scan_record{'scantron.missingerror'}}) {
     if ($missing > $max_bubble) { next; }              my $lastbubble;
               if ($missing =~ /^(\d+)\.(\d+)$/) {
                  my $question = $1;
                  my $subquestion = $2;
                  if (!defined($first_bubble_line{$question -1})) { next; }
                  my $first = $first_bubble_line{$question-1};
                  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 {
                   if (!defined($first_bubble_line{$missing - 1})) { next; }
                   $lastbubble = $first_bubble_line{$missing - 1} + $bubble_lines_per_response{$missing - 1};
               }
               if ($lastbubble > $max_bubble) { next; }
     push(@to_correct,$missing);      push(@to_correct,$missing);
  }   }
  if (@to_correct) {   if (@to_correct) {
Line 7075  sub scantron_validate_missingbubbles { Line 7425  sub scantron_validate_missingbubbles {
   
 sub scantron_process_students {  sub scantron_process_students {
     my ($r) = @_;      my ($r) = @_;
   
     my (undef,undef,$sequence)=&Apache::lonnet::decode_symb($env{'form.selectpage'});      my (undef,undef,$sequence)=&Apache::lonnet::decode_symb($env{'form.selectpage'});
     my ($symb)=&get_symb($r);      my ($symb)=&get_symb($r);
     if (!$symb) {return '';}      if (!$symb) {
    return '';
       }
     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'});
Line 7109  SCANTRONFORM Line 7462  SCANTRONFORM
     my ($uname,$udom,$started);      my ($uname,$udom,$started);
   
     &scantron_get_maxbubble(); # Need the bubble lines array to parse.      &scantron_get_maxbubble(); # Need the bubble lines array to parse.
       
   
       # If an ssi failed in scantron_get_maxbubble, put an error message out to
       # the user and return.
   
       if ($ssi_error) {
    $r->print("</form>");
    &ssi_print_error($r);
    $r->print(&show_grading_menu_form($symb));
    return ''; # Dunno why the other returns return '' rather than just returning.
       }
   
     while ($i<$scanlines->{'count'}) {      while ($i<$scanlines->{'count'}) {
   ($uname,$udom)=('','');    ($uname,$udom)=('','');
Line 7157  SCANTRONFORM Line 7521  SCANTRONFORM
  $form{'CODE'}=$scan_record->{'scantron.CODE'};   $form{'CODE'}=$scan_record->{'scantron.CODE'};
     } else {      } else {
  $form{'CODE'}='';   $form{'CODE'}='';
       } 
       my $result=&ssi_with_retries($resource->src(), $ssi_retries, %form);
       if ($ssi_error) {
    $ssi_error = 0; # So end of handler error message does not trigger.
    $r->print("</form>");
    &ssi_print_error($r);
    $r->print(&show_grading_menu_form($symb));
    return ''; # Why return ''?  Beats me.
     }      }
     my $result=&Apache::lonnet::ssi($resource->src(),%form);  
     if ($result ne '') {  
     }  
     if (&Apache::loncommon::connection_aborted($r)) { last; }      if (&Apache::loncommon::connection_aborted($r)) { last; }
  }   }
  $completedstudents{$uname}={'line'=>$line};   $completedstudents{$uname}={'line'=>$line};
Line 7462  sub grading_menu { Line 7832  sub grading_menu {
                 $menudata->{'url'}.'" >'.                  $menudata->{'url'}.'" >'.
                 $menudata->{'name'}."</a></h3>\n";                  $menudata->{'name'}."</a></h3>\n";
         } else {          } else {
             $Str .='    <h3><input type="button" value="'.&mt('Verify Receipt').'" '.              $Str .='<hr /><input type="button" value="'.&mt('Verify Receipt').'" '.
                 $menudata->{'jscript'}.                  $menudata->{'jscript'}.
                 ' onClick="javascript:checkChoice(document.forms.gradingMenu,\'5\',\'verify\')" '.                  ' onClick="javascript:checkChoice(document.forms.gradingMenu,\'5\',\'verify\')" '.
                 ' /></h3>';                  ' /> '.
             $Str .= ('&nbsp;'x8).   &Apache::lonnet::recprefix($env{'request.course.id'}).
  &mt(' receipt: [_1]',                      '-<input type="text" name="receipt" size="4" onChange="javascript:checkReceiptNo(this.form,\'OK\')" />';
     &Apache::lonnet::recprefix($env{'request.course.id'}).  
                     '-<input type="text" name="receipt" size="4" onChange="javascript:checkReceiptNo(this.form,\'OK\')" />');  
         }          }
         $Str .= '    '.('&nbsp;'x8).$menudata->{'short_description'}.          $Str .= '    '.('&nbsp;'x8).$menudata->{'short_description'}.
             "\n";              "\n";
Line 7955  ENDHEADER Line 8323  ENDHEADER
     }      }
     $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 corrion(s)',$number).'<br />'.  
              '<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',
                  $env{'form.pcorrect'},$env{'form.pincorrect'}).                   $env{'form.pcorrect'},$env{'form.pincorrect'}).
              '<br />';               '<br />';
Line 8204  sub handler { Line 8570  sub handler {
  &Apache::lonnet::logthis("grades got multiple commands ".join(':',@commands));   &Apache::lonnet::logthis("grades got multiple commands ".join(':',@commands));
     }      }
   
       $ssi_error = 0;
     $request->print(&Apache::loncommon::start_page('Grading'));      $request->print(&Apache::loncommon::start_page('Grading'));
     if ($symb eq '' && $command eq '') {      if ($symb eq '' && $command eq '') {
  if ($env{'user.adv'}) {   if ($env{'user.adv'}) {
Line 8217  sub handler { Line 8583  sub handler {
  if ($tsymb) {   if ($tsymb) {
     my ($map,$id,$url)=&Apache::lonnet::decode_symb($tsymb);      my ($map,$id,$url)=&Apache::lonnet::decode_symb($tsymb);
     if (&Apache::lonnet::allowed('mgr',$tcrsid)) {      if (&Apache::lonnet::allowed('mgr',$tcrsid)) {
  $request->print(&Apache::lonnet::ssi_body('/res/'.$url,   $request->print(&ssi_with_retries('/res/'.$url, $ssi_retries,
   ('grade_username' => $tuname,    ('grade_username' => $tuname,
    'grade_domain' => $tudom,     'grade_domain' => $tudom,
    'grade_courseid' => $tcrsid,     'grade_courseid' => $tcrsid,
Line 8304  sub handler { Line 8670  sub handler {
     $request->print("Access Denied ($command)");      $request->print("Access Denied ($command)");
  }   }
     }      }
       if ($ssi_error) {
    &ssi_print_error($request);
       }
     $request->print(&Apache::loncommon::end_page());      $request->print(&Apache::loncommon::end_page());
     &reset_caches();      &reset_caches();
     return '';      return '';
Removed from v.1.499  
changed lines
  Added in v.1.513.2.1

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