--- loncom/homework/grades.pm 2007/11/19 10:57:23 1.496 +++ loncom/homework/grades.pm 2007/11/21 12:16:42 1.497 @@ -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 @@ sub get_scantron_config { $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 username_to_idmap { 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 @@ sub scantron_fixup_scanline { $$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 @@ sub scantron_process_corrections { &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 @@ ENDSCRIPT $r->print("\n

"); } elsif ($error eq 'doublebubble') { $r->print("

".&mt("There have been multiple bubbles scanned for a some question(s)")."

\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(''); + $line_list.'" />'); $r->print($message); $r->print("

".&mt("Please indicate which bubble should be used for grading")."

"); 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("

".&mt("There have been no bubbles scanned for some question(s)")."

\n"); $r->print($message); $r->print("

".&mt("Please indicate which bubble should be used for grading.")."

"); $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(''); + $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"); +} + +=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.
"); + } + 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("

"); + } } =pod @@ -6651,70 +6697,35 @@ ENDSCRIPT 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("\n"); - - for (my $l = 0; $l < $lines; $l++) { - $r->print("\n"); - my @selected = split(//,$lines[$l]); - for (my $i=0;$i<$max;$i++) { - $r->print("\n".''); - - } - - if ($l == 0) { - my $lspan = $total_lines * 2; # 2 table rows per bubble line. - - $r->print(''); - - } - - $r->print(""); - - # 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". - '"); - } - $r->print(''); - $line_number++; - - } - $r->print('
'); - if ($selected[0] eq $alphabet[$i]) { - $r->print('X'); - shift(@selected) ; - } else { - $r->print(' '); - } - $r->print('
$line_number
'); + $r->print(""); + for (my $i=0;$i<$max+1;$i++) { + $r->print("\n".''); + } + $r->print(''); + for (my $i=0;$i<$max;$i++) { + $r->print("\n". + '"); + } + $r->print(''); + $r->print('
$line'); + if ($selected[0] eq $alphabet[$i]) { $r->print('X'); shift(@selected) } + else { $r->print(' '); } + $r->print('
'); } =pod