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

Diff for /loncom/homework/grades.pm between versions 1.502 and 1.521

version 1.502, 2008/01/09 14:16:52 version 1.521, 2008/05/23 22:14:25
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 occurred.  
   #                      All of this is supposed to deal with the issues described
   #                      in LonCAPA BZ 5631 see:
   #                      http://bugs.lon-capa.org/show_bug.cgi?id=5631
   #                      by informing the user that this happened.
   #
   # Parameters:
   #   resource   - The resource to include.  This is passed directly, without
   #                interpretation to lonnet::ssi.
   #   form       - The form hash parameters that guide the interpretation of the resource
   #                
   #   retries    - Number of retries allowed before giving up completely.
   # Returns:
   #   On success, returns the rendered resource identified by the resource parameter.
   # Side Effects:
   #   The following global variables can be set:
   #    ssi_error                - If an unrecoverable error occurred this becomes true.
   #                               It is up to the caller to initialize this to false
   #                               if desired.
   #    ssi_error_resource  - If an unrecoverable error occurred, this is the value
   #                               of the resource that could not be rendered by the ssi
   #                               call.
   #    ssi_error_message   - The error string fetched from the ssi response
   #                               in the event of an error.
   #
   sub ssi_with_retries {
       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) = @_;
       my $helpurl = &Apache::loncommon::top_nav_help('Helpdesk');
       $r->print('
   <br />
   <h2>'.&mt('An unrecoverable network error occurred:').'</h2>
   <p>
   '.&mt('Unable to retrieve a resource from a server:').'<br />
   '.&mt('Resource:').' '.$ssi_error_resource.'<br />
   '.&mt('Error:').' '.$ssi_error_message.'
   </p>
   <p>'.
   &mt('It is recommended that you try again later, as this error may mean the server was just temporarily unavailable, or is down for maintenance.').'<br />'.
   &mt('If the error persists, please contact the [_1] for assistance.',$helpurl).
   '</p>');
       return;
   }
   
 #  #
 # --- Retrieve the parts from the metadata file.---  # --- Retrieve the parts from the metadata file.---
 sub getpartlist {  sub getpartlist {
Line 201  sub reset_caches { Line 284  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,
    ('grade_courseid' =>       'grade_courseid' => 
     $env{'request.course.id'}),      $env{'request.course.id'},
    ('grade_username' => $uname));      'grade_username' => $uname));
  (undef,$subresult)=split(/_HASH_REF__/,$subresult,2);   (undef,$subresult)=split(/_HASH_REF__/,$subresult,2);
  my %analyze=&Apache::lonnet::str2hash($subresult);   my %analyze=&Apache::lonnet::str2hash($subresult);
  return $analyze_cache{$key} = \%analyze;   return $analyze_cache{$key} = \%analyze;
Line 1759  sub download_all_link { Line 1842  sub download_all_link {
  join("\n",&Apache::loncommon::get_env_multiple('form.vPart'));   join("\n",&Apache::loncommon::get_env_multiple('form.vPart'));
   
     my $identifier = &Apache::loncommon::get_cgi_id();      my $identifier = &Apache::loncommon::get_cgi_id();
     &Apache::lonnet::appenv('cgi.'.$identifier.'.students' => $all_students,      &Apache::lonnet::appenv({'cgi.'.$identifier.'.students' => $all_students,
                             'cgi.'.$identifier.'.symb' => $symb,                               'cgi.'.$identifier.'.symb' => $symb,
                             'cgi.'.$identifier.'.parts' => $parts,);                               'cgi.'.$identifier.'.parts' => $parts,});
     $r->print('<a href="/cgi-bin/multidownload.pl?'.$identifier.'">'.      $r->print('<a href="/cgi-bin/multidownload.pl?'.$identifier.'">'.
       &mt('Download All Submitted Documents').'</a>');        &mt('Download All Submitted Documents').'</a>');
     return      return
Line 2685  sub check_and_remove_from_queue { Line 2768  sub check_and_remove_from_queue {
   
 sub handback_files {  sub handback_files {
     my ($request,$symb,$stuname,$domain,$newflg,$new_part,$newrecord) = @_;      my ($request,$symb,$stuname,$domain,$newflg,$new_part,$newrecord) = @_;
     my $portfolio_root = &propath($domain,$stuname).'/userfiles/portfolio';      my $portfolio_root = '/userfiles/portfolio';
     my ($partlist,$handgrade,$responseType) = &response_type($symb);      my ($partlist,$handgrade,$responseType) = &response_type($symb);
   
     my @part_response_id = &flatten_responseType($responseType);      my @part_response_id = &flatten_responseType($responseType);
Line 2703  sub handback_files { Line 2786  sub handback_files {
                     my ($answer_name,$answer_ver,$answer_ext) =                      my ($answer_name,$answer_ver,$answer_ext) =
         &file_name_version_ext($answer_file);          &file_name_version_ext($answer_file);
     my ($portfolio_path) = ($directory =~ /^.+$stuname\/portfolio(.*)/);      my ($portfolio_path) = ($directory =~ /^.+$stuname\/portfolio(.*)/);
     my @dir_list = &Apache::lonnet::dirlist($portfolio_path,$domain,$stuname,$portfolio_root);                      my $getpropath = 1;
       my @dir_list = &Apache::lonnet::dirlist($portfolio_root.$portfolio_path,$domain,$stuname,$getpropath);
     my $version = &get_next_version($answer_name, $answer_ext, \@dir_list);      my $version = &get_next_version($answer_name, $answer_ext, \@dir_list);
                     # fix file name                      # fix file name
                     my ($save_file_name) = (($directory.$answer_name.".$version.".$answer_ext) =~ /^.+\/${stuname}\/(.*)/);                      my ($save_file_name) = (($directory.$answer_name.".$version.".$answer_ext) =~ /^.+\/${stuname}\/(.*)/);
Line 2839  sub version_portfiles { Line 2923  sub version_portfiles {
     my $version_parts = join('|',@$v_flag);      my $version_parts = join('|',@$v_flag);
     my @returned_keys;      my @returned_keys;
     my $parts = join('|', @$parts_graded);      my $parts = join('|', @$parts_graded);
     my $portfolio_root = &propath($domain,$stu_name).      my $portfolio_root = '/userfiles/portfolio';
  '/userfiles/portfolio';  
     foreach my $key (keys(%$record)) {      foreach my $key (keys(%$record)) {
         my $new_portfiles;          my $new_portfiles;
         if ($key =~ /^resource\.($version_parts)\./ && $key =~ /\.portfiles$/ ) {          if ($key =~ /^resource\.($version_parts)\./ && $key =~ /\.portfiles$/ ) {
Line 2851  sub version_portfiles { Line 2934  sub version_portfiles {
                 my ($directory,$answer_file) =($file =~ /^(.*?)([^\/]*)$/);                  my ($directory,$answer_file) =($file =~ /^(.*?)([^\/]*)$/);
  my ($answer_name,$answer_ver,$answer_ext) =   my ($answer_name,$answer_ver,$answer_ext) =
     &file_name_version_ext($answer_file);      &file_name_version_ext($answer_file);
                 my @dir_list = &Apache::lonnet::dirlist($directory,$domain,$stu_name,$portfolio_root);                  my $getpropath = 1;    
                   my @dir_list = &Apache::lonnet::dirlist($portfolio_root.$directory,$domain,$stu_name,$getpropath);
                 my $version = &get_next_version($answer_name, $answer_ext, \@dir_list);                  my $version = &get_next_version($answer_name, $answer_ext, \@dir_list);
                 my $new_answer = &version_selected_portfile($domain, $stu_name, $directory, $answer_file, $version);                  my $new_answer = &version_selected_portfile($domain, $stu_name, $directory, $answer_file, $version);
                 if ($new_answer ne 'problem getting file') {                  if ($new_answer ne 'problem getting file') {
Line 3960  sub csvuploadassign { Line 4044  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 4681  my %bubble_lines_per_response;     # no. Line 4765  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 4689  sub save_bubble_lines { Line 4780  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 4701  sub restore_bubble_lines { Line 4796  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 4736  sub get_response_bubbles { Line 4835  sub get_response_bubbles {
 sub scantron_filenames {  sub scantron_filenames {
     my $cdom=$env{'course.'.$env{'request.course.id'}.'.domain'};      my $cdom=$env{'course.'.$env{'request.course.id'}.'.domain'};
     my $cname=$env{'course.'.$env{'request.course.id'}.'.num'};      my $cname=$env{'course.'.$env{'request.course.id'}.'.num'};
       my $getpropath = 1;
     my @files=&Apache::lonnet::dirlist('userfiles',$cdom,$cname,      my @files=&Apache::lonnet::dirlist('userfiles',$cdom,$cname,
     &propath($cdom,$cname));                                         $getpropath);
     my @possiblenames;      my @possiblenames;
     foreach my $filename (sort(@files)) {      foreach my $filename (sort(@files)) {
  ($filename)=split(/&/,$filename);   ($filename)=split(/&/,$filename);
Line 4780  sub scantron_uploads { Line 4880  sub scantron_uploads {
 =cut  =cut
   
 sub scantron_scantab {  sub scantron_scantab {
     my $fh=Apache::File->new($Apache::lonnet::perlvar{'lonTabDir'}.'/scantronformat.tab');  
     my $result='<select name="scantron_format">'."\n";      my $result='<select name="scantron_format">'."\n";
     $result.='<option></option>'."\n";      $result.='<option></option>'."\n";
     foreach my $line (<$fh>) {      my @lines = &get_scantronformat_file();
  my ($name,$descrip)=split(/:/,$line);      if (@lines > 0) {
  if ($name =~ /^\#/) { next; }          foreach my $line (@lines) {
  $result.='<option value="'.$name.'">'.$descrip.'</option>'."\n";              next if (($line =~ /^\#/) || ($line eq ''));
       my ($name,$descrip)=split(/:/,$line);
       $result.='<option value="'.$name.'">'.$descrip.'</option>'."\n";
           }
     }      }
     $result.='</select>'."\n";      $result.='</select>'."\n";
   
     return $result;      return $result;
 }  }
   
   =pod
   
   =item get_scantronformat_file
   
     Returns an array containing lines from the scantron format file for
     the domain of the course.
   
     If a url for a custom.tab file is listed in domain's configuration.db, 
     lines are from this file.
   
     Otherwise, if a default.tab has been published in RES space by the 
     domainconfig user, lines are from this file.
   
     Otherwise, fall back to getting lines from the legacy file on the
     local server:  /home/httpd/lonTabs/default_scantronformat.tab    
   
   =cut
   
   sub get_scantronformat_file {
       my $cdom= $env{'course.'.$env{'request.course.id'}.'.domain'};
       my %domconfig = &Apache::lonnet::get_dom('configuration',['scantron'],$cdom);
       my $gottab = 0;
       my @lines;
       if (ref($domconfig{'scantron'}) eq 'HASH') {
           if ($domconfig{'scantron'}{'scantronformat'} ne '') {
               my $formatfile = &Apache::lonnet::getfile($Apache::lonnet::perlvar{'lonDocRoot'}.$domconfig{'scantron'}{'scantronformat'});
               if ($formatfile ne '-1') {
                   @lines = split("\n",$formatfile,-1);
                   $gottab = 1;
               }
           }
       }
       if (!$gottab) {
           my $confname = $cdom.'-domainconfig';
           my $default = $Apache::lonnet::perlvar{'lonDocRoot'}.'/res/'.$cdom.'/'.$confname.'/default.tab';
           my $formatfile =  &Apache::lonnet::getfile($default);
           if ($formatfile ne '-1') {
               @lines = split("\n",$formatfile,-1);
               $gottab = 1;
           }
       }
       if (!$gottab) {
           my @domains = &Apache::lonnet::current_machine_domains();
           if (grep(/^\Q$cdom\E$/,@domains)) {
               my $fh=Apache::File->new($Apache::lonnet::perlvar{'lonTabDir'}.'/scantronformat.tab');
               @lines = <$fh>;
               close($fh);
           } else {
               my $fh=Apache::File->new($Apache::lonnet::perlvar{'lonTabDir'}.'/default_scantronformat.tab');
               @lines = <$fh>;
               close($fh);
           }
       }
       return @lines;
   }
   
 =pod   =pod 
   
 =item scantron_CODElist  =item scantron_CODElist
Line 4866  sub scantron_selectphase { Line 5023  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 5049  sub scantron_selectphase { Line 5208  sub scantron_selectphase {
   
 sub get_scantron_config {  sub get_scantron_config {
     my ($which) = @_;      my ($which) = @_;
     my $fh=Apache::File->new($Apache::lonnet::perlvar{'lonTabDir'}.'/scantronformat.tab');      my @lines = &get_scantronformat_file();
     my %config;      my %config;
     #FIXME probably should move to XML it has already gotten a bit much now      #FIXME probably should move to XML it has already gotten a bit much now
     foreach my $line (<$fh>) {      foreach my $line (@lines) {
  my ($name,$descrip)=split(/:/,$line);   my ($name,$descrip)=split(/:/,$line);
  if ($name ne $which ) { next; }   if ($name ne $which ) { next; }
  chomp($line);   chomp($line);
Line 5139  sub username_to_idmap { Line 5298  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 5187  sub scantron_fixup_scanline { Line 5348  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 5199  sub scantron_fixup_scanline { Line 5360  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 5371  sub scantron_parse_scanline { Line 5532  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 5670  sub scantron_process_corrections { Line 5883  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 5889  SCANTRONFORM Line 6103  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 5933  sub scantron_validate_file { Line 6151  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 5953  sub scantron_validate_file { Line 6171  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 5963  sub scantron_validate_file { Line 6181  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 5981  sub scantron_validate_file { Line 6198  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 6463  sub scantron_validate_ID { Line 6684  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 6485  sub scantron_get_correction { Line 6705  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 6580  ENDSCRIPT Line 6804  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 6592  ENDSCRIPT Line 6816  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 6609  ENDSCRIPT Line 6836  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 6635  sub questions_to_line_list { Line 6898  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 6657  for multi and missing bubble cases). Line 6935  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 6697  sub prompt_for_corrections { Line 7016  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 6904  sub scantron_validate_doublebubble { Line 7235  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 6931  sub scantron_validate_doublebubble { Line 7261  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 6960  sub scantron_get_maxbubble { Line 7293  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 
  ('grade_target' => 'analyze'),          # $analysis{'parts'} from lonnet::ssi.  
  ('grade_courseid' => $cid),          my %possible_part_ids; 
  ('grade_domain' => $udom),          if (ref($resource->parts()) eq 'ARRAY') { 
  ('grade_username' => $uname));              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_courseid' => $cid,
    'grade_domain' => $udom,
    'grade_username' => $uname));
  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 7037  sub scantron_validate_missingbubbles { Line 7436  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 7076  sub scantron_validate_missingbubbles { Line 7493  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 7099  SCANTRONFORM Line 7519  SCANTRONFORM
     my @delayqueue;      my @delayqueue;
     my %completedstudents;      my %completedstudents;
           
       my $lock=&Apache::lonnet::set_lock(&mt('Grading bubblesheet exam'));
     my $count=&get_todo_count($scanlines,$scan_data);      my $count=&get_todo_count($scanlines,$scan_data);
     my %prog_state=&Apache::lonhtmlcommon::Create_PrgWin($r,'Scantron Status',      my %prog_state=&Apache::lonhtmlcommon::Create_PrgWin($r,'Scantron Status',
      'Scantron Progress',$count,       'Scantron Progress',$count,
Line 7110  SCANTRONFORM Line 7531  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));
           &Apache::lonnet::remove_lock($lock);
    return ''; # Dunno why the other returns return '' rather than just returning.
       }
   
     while ($i<$scanlines->{'count'}) {      while ($i<$scanlines->{'count'}) {
   ($uname,$udom)=('','');    ($uname,$udom)=('','');
Line 7137  SCANTRONFORM Line 7570  SCANTRONFORM
   ($uname,$udom)=split(/:/,$uname);    ($uname,$udom)=split(/:/,$uname);
   
  &Apache::lonxml::clear_problem_counter();   &Apache::lonxml::clear_problem_counter();
   &Apache::lonnet::appenv(%$scan_record);    &Apache::lonnet::appenv($scan_record);
   
  if (&scantron_clear_skip($scanlines,$scan_data,$i)) {   if (&scantron_clear_skip($scanlines,$scan_data,$i)) {
     &scantron_putfile($scanlines,$scan_data);      &scantron_putfile($scanlines,$scan_data);
Line 7158  SCANTRONFORM Line 7591  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));
                   &Apache::lonnet::remove_lock($lock);
    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 7171  SCANTRONFORM Line 7611  SCANTRONFORM
  &Apache::lonnet::delenv('scantron\.');   &Apache::lonnet::delenv('scantron\.');
     }      }
     &Apache::lonhtmlcommon::Close_PrgWin($r,\%prog_state);      &Apache::lonhtmlcommon::Close_PrgWin($r,\%prog_state);
       &Apache::lonnet::remove_lock($lock);
 #    my $lasttime = &Time::HiRes::time()-$start;  #    my $lasttime = &Time::HiRes::time()-$start;
 #    $r->print("<p>took $lasttime</p>");  #    $r->print("<p>took $lasttime</p>");
   
Line 7463  sub grading_menu { Line 7904  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 7787  sub process_clicker { Line 8226  sub process_clicker {
     if (!$env{'form.upfiletype'}) { $env{'form.upfiletype'}='iclicker'; }      if (!$env{'form.upfiletype'}) { $env{'form.upfiletype'}='iclicker'; }
   
     my %checked;      my %checked;
     foreach my $gradingmechanism ('attendance','personnel','specific') {      foreach my $gradingmechanism ('attendance','personnel','specific','given') {
        if ($env{'form.gradingmechanism'} eq $gradingmechanism) {         if ($env{'form.gradingmechanism'} eq $gradingmechanism) {
           $checked{$gradingmechanism}="checked='checked'";            $checked{$gradingmechanism}="checked='checked'";
        }         }
Line 7798  sub process_clicker { Line 8237  sub process_clicker {
     my $attendance=&mt("Award points just for participation");      my $attendance=&mt("Award points just for participation");
     my $personnel=&mt("Correctness determined from response by course personnel");      my $personnel=&mt("Correctness determined from response by course personnel");
     my $specific=&mt("Correctness determined from response with clicker ID(s)");       my $specific=&mt("Correctness determined from response with clicker ID(s)"); 
       my $given=&mt("Correctness determined from given list of answers").' '.
                 '<font size="-2"><tt>('.&mt("Provide comma-separated list. Use '*' for any answer correct, '-' for skip").')</tt></font>';
     my $pcorrect=&mt("Percentage points for correct solution");      my $pcorrect=&mt("Percentage points for correct solution");
     my $pincorrect=&mt("Percentage points for incorrect solution");      my $pincorrect=&mt("Percentage points for incorrect solution");
     my $selectform=&Apache::loncommon::select_form($env{'form.upfiletype'},'upfiletype',      my $selectform=&Apache::loncommon::select_form($env{'form.upfiletype'},'upfiletype',
Line 7855  function sanitycheck() { Line 8296  function sanitycheck() {
 <br /><label><input type="radio" name="gradingmechanism" value="personnel" $checked{'personnel'} onClick="sanitycheck()" />$personnel</label>  <br /><label><input type="radio" name="gradingmechanism" value="personnel" $checked{'personnel'} onClick="sanitycheck()" />$personnel</label>
 <br /><label><input type="radio" name="gradingmechanism" value="specific" $checked{'specific'} onClick="sanitycheck()" />$specific </label>  <br /><label><input type="radio" name="gradingmechanism" value="specific" $checked{'specific'} onClick="sanitycheck()" />$specific </label>
 <input type="text" name="specificid" value="$env{'form.specificid'}" size="20" />  <input type="text" name="specificid" value="$env{'form.specificid'}" size="20" />
   <br /><label><input type="radio" name="gradingmechanism" value="given" $checked{'given'} onClick="sanitycheck()" />$given </label>
   <br />&nbsp;&nbsp;&nbsp;
   <input type="text" name="givenanswer" size="50" />
 <input type="hidden" name="waschecked" value="$env{'form.gradingmechanism'}" />  <input type="hidden" name="waschecked" value="$env{'form.gradingmechanism'}" />
 <br /><label>$pcorrect: <input type="text" name="pcorrect" size="4" value="$env{'form.pcorrect'}" onChange="sanitycheck()" /></label>  <br /><label>$pcorrect: <input type="text" name="pcorrect" size="4" value="$env{'form.pcorrect'}" onChange="sanitycheck()" /></label>
 <br /><label>$pincorrect: <input type="text" name="pincorrect" size="4" value="$env{'form.pincorrect'}" onChange="sanitycheck()" /></label>  <br /><label>$pincorrect: <input type="text" name="pincorrect" size="4" value="$env{'form.pincorrect'}" onChange="sanitycheck()" /></label>
Line 7881  sub process_clicker_file { Line 8325  sub process_clicker_file {
  $result.='<span class="LC_error">'.&mt('You need to specify a clicker ID for the correct answer').'</span>';   $result.='<span class="LC_error">'.&mt('You need to specify a clicker ID for the correct answer').'</span>';
  return $result.&show_grading_menu_form($symb);   return $result.&show_grading_menu_form($symb);
     }      }
       if (($env{'form.gradingmechanism'} eq 'given') && ($env{'form.givenanswer'}!~/\w/)) {
           $result.='<span class="LC_error">'.&mt('You need to specify the correct answer').'</span>';
           return $result.&show_grading_menu_form($symb);
       }
       if ($env{'form.gradingmechanism'} eq 'given') {
           $env{'form.givenanswer'}=~s/^\s*//gs;
           $env{'form.givenanswer'}=~s/\s*$//gs;
           $env{'form.givenanswer'}=~s/[^a-zA-Z0-9\.\*\-]+/\,/g;
           $env{'form.givenanswer'}=uc($env{'form.givenanswer'});
       }
     my %clicker_ids=&gather_clicker_ids();      my %clicker_ids=&gather_clicker_ids();
     my %correct_ids;      my %correct_ids;
     if ($env{'form.gradingmechanism'} eq 'personnel') {      if ($env{'form.gradingmechanism'} eq 'personnel') {
Line 7899  sub process_clicker_file { Line 8353  sub process_clicker_file {
     }      }
     if ($env{'form.gradingmechanism'} eq 'attendance') {      if ($env{'form.gradingmechanism'} eq 'attendance') {
  $result.=&mt('Score based on attendance only');   $result.=&mt('Score based on attendance only');
       } elsif ($env{'form.gradingmechanism'} eq 'given') {
           $result.=&mt('Score based on [_1]','<tt>'.$env{'form.givenanswer'}.'</tt>');
     } else {      } else {
  my $number=0;   my $number=0;
  $result.='<p><b>'.&mt('Correctness determined by the following IDs').'</b>';   $result.='<p><b>'.&mt('Correctness determined by the following IDs').'</b>';
Line 7941  sub process_clicker_file { Line 8397  sub process_clicker_file {
 <input type="hidden" name="probTitle" value="$env{'form.probTitle'}" />  <input type="hidden" name="probTitle" value="$env{'form.probTitle'}" />
 <input type="hidden" name="saveState"  value="$env{'form.saveState'}" />  <input type="hidden" name="saveState"  value="$env{'form.saveState'}" />
 <input type="hidden" name="gradingmechanism" value="$env{'form.gradingmechanism'}" />  <input type="hidden" name="gradingmechanism" value="$env{'form.gradingmechanism'}" />
   <input type="hidden" name="givenanswer" value="$env{'form.givenanswer'}" />
 <input type="hidden" name="pcorrect" value="$env{'form.pcorrect'}" />  <input type="hidden" name="pcorrect" value="$env{'form.pcorrect'}" />
 <input type="hidden" name="pincorrect" value="$env{'form.pincorrect'}" />  <input type="hidden" name="pincorrect" value="$env{'form.pincorrect'}" />
 ENDHEADER  ENDHEADER
Line 8002  ENDHEADER Line 8459  ENDHEADER
     }      }
     $result.='<hr />'.      $result.='<hr />'.
              &mt('Found [_1] registered and [_2] unregistered clickers.',$student_count,$unknown_count);               &mt('Found [_1] registered and [_2] unregistered clickers.',$student_count,$unknown_count);
     if ($env{'form.gradingmechanism'} ne 'attendance') {      if (($env{'form.gradingmechanism'} ne 'attendance') && ($env{'form.gradingmechanism'} ne 'given')) {
        if ($correct_count==0) {         if ($correct_count==0) {
           $errormsg.="Found no correct answers answers for grading!";            $errormsg.="Found no correct answers answers for grading!";
        } elsif ($correct_count>1) {         } elsif ($correct_count>1) {
Line 8203  sub handler { Line 8660  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 8216  sub handler { Line 8673  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 8303  sub handler { Line 8760  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.502  
changed lines
  Added in v.1.521

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