[LON-CAPA-cvs] cvs: loncom /homework grades.pm

foxr lon-capa-cvs-allow@mail.lon-capa.org
Wed, 21 Nov 2007 12:16:45 -0000


This is a MIME encoded message

--foxr1195647405
Content-Type: text/plain

foxr		Wed Nov 21 07:16:45 2007 EDT

  Modified files:              
    /loncom/homework	grades.pm 
  Log:
  BZ4074 - Fix up errors in the way scanlines were corrected.  Need to go 
           back and test a bunch of this stuffBZ4074 - Fix up errors in the way scanlines were corrected.  Need to go 
           back and test a bunch of this stuffBZ4074 - Fix up errors in the way scanlines were corrected.  Need to go 
           back and test a bunch of this stuffBZ4074 - Fix up errors in the way scanlines were corrected.  Need to go 
           back and test a bunch of this stuff
  
  
--foxr1195647405
Content-Type: text/plain
Content-Disposition: attachment; filename="foxr-20071121071645.txt"

Index: loncom/homework/grades.pm
diff -u loncom/homework/grades.pm:1.496 loncom/homework/grades.pm:1.497
--- loncom/homework/grades.pm:1.496	Mon Nov 19 05:57:23 2007
+++ loncom/homework/grades.pm	Wed Nov 21 07:16:42 2007
@@ -1,7 +1,7 @@
 # The LearningOnline Network with CAPA
 # The LON-CAPA Grading handler
 #
-# $Id: grades.pm,v 1.496 2007/11/19 10:57:23 foxr Exp $
+# $Id: grades.pm,v 1.497 2007/11/21 12:16:42 foxr Exp $
 #
 # Copyright Michigan State University Board of Trustees
 #
@@ -5064,7 +5064,7 @@
 	$config{'IDstart'}=$config[5];
 	$config{'IDlength'}=$config[6];
 	$config{'Qstart'}=$config[7];
-	$config{'Qlength'}=$config[8];
+ 	$config{'Qlength'}=$config[8];
 	$config{'Qoff'}=$config[9];
 	$config{'Qon'}=$config[10];
 	$config{'PaperID'}=$config[11];
@@ -5150,8 +5150,6 @@
 
 sub scantron_fixup_scanline {
     my ($scantron_config,$scan_data,$line,$whichline,$field,$args)=@_;
-    
-    
     if ($field eq 'ID') {
 	if (length($args->{'newid'}) > $$scantron_config{'IDlength'}) {
 	    return ($line,1,'New value too large');
@@ -5182,58 +5180,28 @@
 		   $$scantron_config{'CODElength'})=$args->{'CODE'};
 	}
     } 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 $on=$scantron_config->{'Qon'};
-        my $question_number = $args->{'question'} -1;
-        my $first_position  = $first_bubble_line{$question_number};
-	my $bubble_count    = $bubble_lines_per_response{$question_number};
-        my $bubbles_per_line= $$scantron_config{'Qlength'};
-	my $answer=${off}x($bubbles_per_line*$bubble_count);
-        my $final_answer;
-        if ($$scantron_config{'Qon'} eq 'letter'  ||
-	    $$scantron_config{'Qon'} eq 'number') { 
-	    $bubbles_per_line = 10;
-	}
-	if (defined $args->{'response'}) {
-	    
-	    if ($args->{'response'} eq 'none') {
-		&scan_data($scan_data,
-			   "$whichline.no_bubble.".$args->{'question'},'1');
+	my $answer=${off}x$length;
+	if ($args->{'response'} eq 'none') {
+	    &scan_data($scan_data,
+		       "$whichline.no_bubble.".$args->{'question'},'1');
+	} else {
+	    if ($on eq 'letter') {
+		my @alphabet=('A'..'Z');
+		$answer=$alphabet[$args->{'response'}];
+	    } elsif ($on eq 'number') {
+		$answer=$args->{'response'}+1;
+		if ($answer == 10) { $answer = '0'; }
 	    } else {
-		my ($bubble_line, $bubble_number) = split(/:/,$args->{'response'});
-		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 .= ' ';
-			}
-		    }
-		}
+		substr($answer,$args->{'response'},1)=$on;
 	    }
-	    # $where=$length*($args->{'question'}-1)+$scantron_config->{'Qstart'};
-	    #substr($line,$where-1,$length)=$answer;
-	    substr($line, 
-		   $scantron_config->{'Qstart'}+$first_position-1,
-		   $bubbles_per_line*$length) = $final_answer;
+	    &scan_data($scan_data,
+		       "$whichline.no_bubble.".$args->{'question'},undef,'1');
 	}
+	my $where=$length*($args->{'question'}-1)+$scantron_config->{'Qstart'};
+	substr($line,$where-1,$length)=$answer;
     }
     return $line;
 }
@@ -5701,7 +5669,7 @@
 		&scantron_fixup_scanline(\%scantron_config,$scan_data,$line,
 					 $which,'answer',
 					 { 'question'=>$question,
-		       'response'=>$env{"form.scantron_correct_Q_$question"}});
+		      		   'response'=>$env{"form.scantron_correct_Q_$question"}});
 	    if ($err) { last; }
 	}
     }
@@ -6612,33 +6580,111 @@
 	$r->print("\n<br /><br />");
     } elsif ($error eq 'doublebubble') {
 	$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="'.
-		  join(',',@{$arg}).'" />');
+		  $line_list.'" />');
 	$r->print($message);
 	$r->print("<p>".&mt("Please indicate which bubble should be used for grading")."</p>");
 	foreach my $question (@{$arg}) {
-	    my $selected  = &get_response_bubbles($scan_record, $question);
-	    my @select_array = split(/:/,$selected);
-	    &scantron_bubble_selector($r,$scan_config,$question,
-				      @select_array);
+	    &prompt_for_corrections($r, $question, $scan_config, $scan_record);
 	}
     } elsif ($error eq 'missingbubble') {
 	$r->print("<p>".&mt("There have been <b>no</b> bubbles scanned for some question(s)")."</p>\n");
 	$r->print($message);
 	$r->print("<p>".&mt("Please indicate which bubble should be used for grading.")."</p>");
 	$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="'.
-		  join(',',@{$arg}).'" />');
+		  $line_list.'" />');
 	foreach my $question (@{$arg}) {
-	    my $selected = &get_response_bubbles($scan_record, $question);
-	    my @select_array = split(/:/,$selected); # ought to be an array of empties.
-	    &scantron_bubble_selector($r,$scan_config,$question, @select_array);
+	    &prompt_for_corrections($r, $question, $scan_config, $scan_record);
 	}
     } else {
 	$r->print("\n<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
@@ -6651,70 +6697,35 @@
  Arguments:
     $r           - Apache request object
     $scan_config - hash from &get_scantron_config()
-    $quest       - number of the bubble line to make a corrector for
-    @lines       - array of answer lines.
+    $line        - Number of the line being displayed.
+    @selected    - Array of bubbles picked on this line.
 
 =cut
 
 sub scantron_bubble_selector {
-    my ($r,$scan_config,$quest,@lines)=@_;
+    my ($r,$scan_config,$line,@selected)=@_;
     my $max=$$scan_config{'Qlength'};
 
-
     my $scmode=$$scan_config{'Qon'};
-
-    my $bubble_length = scalar(@lines);
-
-
     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');
-
-    $r->print("<table border='1'>\n");
-
-    for (my $l = 0; $l < $lines; $l++) {
-	$r->print("<tr><td></td>\n");
-	my @selected = split(//,$lines[$l]);
-	for (my $i=0;$i<$max;$i++) {
-	    $r->print("\n".'<td align="center">');
-	    if ($selected[0] eq $alphabet[$i]) { 
-		$r->print('X'); 
-		shift(@selected) ;
-	    } else { 
-		$r->print('&nbsp;'); 
-	    }
-	    $r->print('</td>');
-	    
-	}
-
-	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>');
+    $r->print("<table border='1'><tr><td rowspan='2'>$line</td>");
+    for (my $i=0;$i<$max+1;$i++) {
+	$r->print("\n".'<td align="center">');
+	if ($selected[0] eq $alphabet[$i]) { $r->print('X'); shift(@selected) }
+	else { $r->print('&nbsp;'); }
+	$r->print('</td>');
+    }
+    $r->print('</tr><tr>');
+    for (my $i=0;$i<$max;$i++) {
+	$r->print("\n".
+		  '<td><label><input type="radio" name="scantron_correct_Q_'.
+		  $line.'" value="'.$i.'" />'.$alphabet[$i]."</label></td>");
+    }
+    $r->print('<td><label><input type="radio" name="scantron_correct_Q_'.
+	      $line.'" value="none" /> No bubble </label></td>');
+    $r->print('</tr></table>');
 }
 
 =pod

--foxr1195647405--