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

Diff for /loncom/homework/grades.pm between versions 1.496 and 1.497

version 1.496, 2007/11/19 10:57:23 version 1.497, 2007/11/21 12:16:42
Line 5064  sub get_scantron_config { Line 5064  sub get_scantron_config {
  $config{'IDstart'}=$config[5];   $config{'IDstart'}=$config[5];
  $config{'IDlength'}=$config[6];   $config{'IDlength'}=$config[6];
  $config{'Qstart'}=$config[7];   $config{'Qstart'}=$config[7];
  $config{'Qlength'}=$config[8];    $config{'Qlength'}=$config[8];
  $config{'Qoff'}=$config[9];   $config{'Qoff'}=$config[9];
  $config{'Qon'}=$config[10];   $config{'Qon'}=$config[10];
  $config{'PaperID'}=$config[11];   $config{'PaperID'}=$config[11];
Line 5150  sub username_to_idmap { Line 5150  sub username_to_idmap {
   
 sub scantron_fixup_scanline {  sub scantron_fixup_scanline {
     my ($scantron_config,$scan_data,$line,$whichline,$field,$args)=@_;      my ($scantron_config,$scan_data,$line,$whichline,$field,$args)=@_;
       
       
     if ($field eq 'ID') {      if ($field eq 'ID') {
  if (length($args->{'newid'}) > $$scantron_config{'IDlength'}) {   if (length($args->{'newid'}) > $$scantron_config{'IDlength'}) {
     return ($line,1,'New value too large');      return ($line,1,'New value too large');
Line 5182  sub scantron_fixup_scanline { Line 5180  sub scantron_fixup_scanline {
    $$scantron_config{'CODElength'})=$args->{'CODE'};     $$scantron_config{'CODElength'})=$args->{'CODE'};
  }   }
     } elsif ($field eq 'answer') {      } elsif ($field eq 'answer') {
  &scantron_get_maxbubble(); # Need the bubble counter info.   my $length=$scantron_config->{'Qlength'};
  my $length =$scantron_config->{'Qlength'};  
  my $off=$scantron_config->{'Qoff'};   my $off=$scantron_config->{'Qoff'};
  my $on=$scantron_config->{'Qon'};   my $on=$scantron_config->{'Qon'};
         my $question_number = $args->{'question'} -1;   my $answer=${off}x$length;
         my $first_position  = $first_bubble_line{$question_number};   if ($args->{'response'} eq 'none') {
  my $bubble_count    = $bubble_lines_per_response{$question_number};      &scan_data($scan_data,
         my $bubbles_per_line= $$scantron_config{'Qlength'};         "$whichline.no_bubble.".$args->{'question'},'1');
  my $answer=${off}x($bubbles_per_line*$bubble_count);   } else {
         my $final_answer;      if ($on eq 'letter') {
         if ($$scantron_config{'Qon'} eq 'letter'  ||   my @alphabet=('A'..'Z');
     $$scantron_config{'Qon'} eq 'number') {    $answer=$alphabet[$args->{'response'}];
     $bubbles_per_line = 10;      } elsif ($on eq 'number') {
  }   $answer=$args->{'response'}+1;
  if (defined $args->{'response'}) {   if ($answer == 10) { $answer = '0'; }
       
     if ($args->{'response'} eq 'none') {  
  &scan_data($scan_data,  
    "$whichline.no_bubble.".$args->{'question'},'1');  
     } else {      } else {
  my ($bubble_line, $bubble_number) = split(/:/,$args->{'response'});   substr($answer,$args->{'response'},1)=$on;
  if ($on eq 'letter') {  
     my @alphabet=('A'..'Z');  
     $answer=$alphabet[$bubble_number];  
  } elsif ($on eq 'number') {  
     $answer= $bubble_number+1;  
     if ($answer == 10) { $answer = '0'; }  
  } else {  
     substr($answer,$bubble_number+$bubble_line*$bubbles_per_line,1)=$on;  
     $final_answer = $answer;  
  }  
  &scan_data($scan_data,  
    "$whichline.no_bubble.".$args->{'question'},undef,'1');  
   
  # Positional notation already has the right final answer length..  
   
  if (($on eq 'letter') || ($on eq 'number')) {  
     for (my $l = 0; $l < $bubble_count; $l++) {  
  if ($l eq $bubble_line) {  
     $final_answer .= $answer;  
  } else {  
     $final_answer .= ' ';  
  }  
     }  
  }  
     }      }
     # $where=$length*($args->{'question'}-1)+$scantron_config->{'Qstart'};      &scan_data($scan_data,
     #substr($line,$where-1,$length)=$answer;         "$whichline.no_bubble.".$args->{'question'},undef,'1');
     substr($line,   
    $scantron_config->{'Qstart'}+$first_position-1,  
    $bubbles_per_line*$length) = $final_answer;  
  }   }
    my $where=$length*($args->{'question'}-1)+$scantron_config->{'Qstart'};
    substr($line,$where-1,$length)=$answer;
     }      }
     return $line;      return $line;
 }  }
Line 5701  sub scantron_process_corrections { Line 5669  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"}});
     if ($err) { last; }      if ($err) { last; }
  }   }
     }      }
Line 6612  ENDSCRIPT Line 6580  ENDSCRIPT
  $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 a some question(s)")."</p>\n");
   
    # The form field scantron_questions is acutally a list of line numbers.
    # represented by this form so:
   
    my $line_list = &questions_to_line_list($arg);
   
  $r->print('<input type="hidden" name="scantron_questions" value="'.   $r->print('<input type="hidden" name="scantron_questions" value="'.
   join(',',@{$arg}).'" />');    $line_list.'" />');
  $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}) {
     my $selected  = &get_response_bubbles($scan_record, $question);      &prompt_for_corrections($r, $question, $scan_config, $scan_record);
     my @select_array = split(/:/,$selected);  
     &scantron_bubble_selector($r,$scan_config,$question,  
       @select_array);  
  }   }
     } 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
    # a list of question numbers. Therefore:
    #
   
    my $line_list = &questions_to_line_list($arg);
   
  $r->print('<input type="hidden" name="scantron_questions" value="'.   $r->print('<input type="hidden" name="scantron_questions" value="'.
   join(',',@{$arg}).'" />');    $line_list.'" />');
  foreach my $question (@{$arg}) {   foreach my $question (@{$arg}) {
     my $selected = &get_response_bubbles($scan_record, $question);      &prompt_for_corrections($r, $question, $scan_config, $scan_record);
     my @select_array = split(/:/,$selected); # ought to be an array of empties.  
     &scantron_bubble_selector($r,$scan_config,$question, @select_array);  
  }   }
     } else {      } else {
  $r->print("\n<ul>");   $r->print("\n<ul>");
     }      }
     $r->print("\n</li></ul>");      $r->print("\n</li></ul>");
   }
   
   =pod
   
   =item  questions_to_line_list
   
   Converts a list of questions into a string of comma separated
   line numbers in the answer sheet used by the questions.  This is
   used to fill in the scantron_questions form field.
   
     Arguments:
        questions    - Reference to an array of questions.
   
   =cut
   
   
   sub questions_to_line_list {
       my ($questions) = @_;
       my @lines;
   
       foreach my $question (@{$questions}) {
    my $first   = $first_bubble_line{$question-1} + 1;
    my $count   = $bubble_lines_per_response{$question-1};
    my $last = $first+$count-1;
    push(@lines, ($first..$last));
       }
       return join(',', @lines);
   }
   
   =pod 
   
   =item prompt_for_corrections
   
   Prompts for a potentially multiline correction to the
   user's bubbling (factors out common code from scantron_get_correction
   for multi and missing bubble cases).
   
    Arguments:
      $r           - Apache request object.
      $question    - The question number to prompt for.
      $scan_config - The scantron file configuration hash.
      $scan_record - Reference to the hash that has the the parsed scanlines.
   
    Implicit inputs:
      %bubble_lines_per_response   - Starting line numbers for each question.
                                     Numbered from 0 (but question numbers are from
                                     1.
      %first_bubble_line           - Starting bubble line for each question.
   
   =cut
   
   sub prompt_for_corrections {
       my ($r, $question, $scan_config, $scan_record) = @_;
   
       my $lines        = $bubble_lines_per_response{$question-1};
       my $current_line = $first_bubble_line{$question-1} + 1 ;
   
       if ($lines > 1) {
    $r->print("The group of bubble lines below responds to a single question.  ");
    $r->print("Select at most one bubble in a single line and select 'No Bubble' ");
    $r->print("in all the other lines. <br />");
       }
       for (my $i =0; $i < $lines; $i++) {
    my $selected = $$scan_record{"scantron.$current_line.answer"};
    &scantron_bubble_selector($r, $scan_config, $current_line, 
     split('', $selected));
    $current_line++;
       }
       if ($lines > 1) {
    $r->print("<hr /><br />");
       }
 }  }
   
 =pod  =pod
Line 6651  ENDSCRIPT Line 6697  ENDSCRIPT
  Arguments:   Arguments:
     $r           - Apache request object      $r           - Apache request object
     $scan_config - hash from &get_scantron_config()      $scan_config - hash from &get_scantron_config()
     $quest       - number of the bubble line to make a corrector for      $line        - Number of the line being displayed.
     @lines       - array of answer lines.      @selected    - Array of bubbles picked on this line.
   
 =cut  =cut
   
 sub scantron_bubble_selector {  sub scantron_bubble_selector {
     my ($r,$scan_config,$quest,@lines)=@_;      my ($r,$scan_config,$line,@selected)=@_;
     my $max=$$scan_config{'Qlength'};      my $max=$$scan_config{'Qlength'};
   
   
     my $scmode=$$scan_config{'Qon'};      my $scmode=$$scan_config{'Qon'};
   
     my $bubble_length = scalar(@lines);  
   
   
     if ($scmode eq 'number' || $scmode eq 'letter') { $max=10; }           if ($scmode eq 'number' || $scmode eq 'letter') { $max=10; }     
   
     my $response = $quest-1;  
     my $lines       = $bubble_lines_per_response{$response};  
     my $line_number = $first_bubble_line{$response} +1;  
   
     my $total_lines = $lines*2;  
     my @alphabet=('A'..'Z');      my @alphabet=('A'..'Z');
       $r->print("<table border='1'><tr><td rowspan='2'>$line</td>");
     $r->print("<table border='1'>\n");      for (my $i=0;$i<$max+1;$i++) {
    $r->print("\n".'<td align="center">');
     for (my $l = 0; $l < $lines; $l++) {   if ($selected[0] eq $alphabet[$i]) { $r->print('X'); shift(@selected) }
  $r->print("<tr><td></td>\n");   else { $r->print('&nbsp;'); }
  my @selected = split(//,$lines[$l]);   $r->print('</td>');
  for (my $i=0;$i<$max;$i++) {      }
     $r->print("\n".'<td align="center">');      $r->print('</tr><tr>');
     if ($selected[0] eq $alphabet[$i]) {       for (my $i=0;$i<$max;$i++) {
  $r->print('X');    $r->print("\n".
  shift(@selected) ;    '<td><label><input type="radio" name="scantron_correct_Q_'.
     } else {     $line.'" value="'.$i.'" />'.$alphabet[$i]."</label></td>");
  $r->print('&nbsp;');       }
     }      $r->print('<td><label><input type="radio" name="scantron_correct_Q_'.
     $r->print('</td>');        $line.'" value="none" /> No bubble </label></td>');
           $r->print('</tr></table>');
  }  
   
  if ($l == 0) {  
     my $lspan = $total_lines * 2;   #  2 table rows per bubble line.  
   
     $r->print('<td rowspan='.$lspan.'><label><input type="radio" name="scantron_correct_Q_'.  
       $quest.'" value="none" /> '.&mt('No bubble').' </label></td>');  
   
  }  
   
  $r->print("</tr><tr><td>$line_number</td>");  
   
  # FIXME: This may have to be a bit more clever for  
  #        multiline questions (different values e.g..).  
  for (my $i=0;$i<$max;$i++) {  
     my $value = "$l:$i"; # Relative bubble line #: Bubble in line.  
     $r->print("\n".  
       '<td><label><input type="radio" name="scantron_correct_Q_'.  
       $quest.'" value="'.$value.'" />'.$alphabet[$i]."</label></td>");  
  }  
  $r->print('</tr>');  
  $line_number++;  
       
     }  
     $r->print('</table>');  
 }  }
   
 =pod  =pod
Removed from v.1.496  
changed lines
  Added in v.1.497

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