version 1.492, 2007/11/16 07:56:15
|
version 1.499, 2007/12/05 18:40:59
|
Line 48 use POSIX qw(floor);
|
Line 48 use POSIX qw(floor);
|
|
|
|
|
my %perm=(); |
my %perm=(); |
my %bubble_lines_per_response = (); # no. bubble lines for each response. |
|
# index is "symb.part_id" |
|
|
|
my %first_bubble_line = (); # First bubble line no. for each bubble. |
|
|
|
# Save and restore the bubble lines array to the form env. |
|
|
|
|
|
sub save_bubble_lines { |
|
foreach my $line (keys(%bubble_lines_per_response)) { |
|
$env{"form.scantron.bubblelines.$line"} = $bubble_lines_per_response{$line}; |
|
$env{"form.scantron.first_bubble_line.$line"} = |
|
$first_bubble_line{$line}; |
|
} |
|
} |
|
|
|
|
|
sub restore_bubble_lines { |
|
my $line = 0; |
|
%bubble_lines_per_response = (); |
|
while ($env{"form.scantron.bubblelines.$line"}) { |
|
my $value = $env{"form.scantron.bubblelines.$line"}; |
|
$bubble_lines_per_response{$line} = $value; |
|
$first_bubble_line{$line} = |
|
$env{"form.scantron.first_bubble_line.$line"}; |
|
$line++; |
|
} |
|
|
|
} |
|
|
|
# Given the parsed scanline, get the response for |
|
# 'answer' number n: |
|
|
|
sub get_response_bubbles { |
|
my ($parsed_line, $response) = @_; |
|
|
|
|
|
my $bubble_line = $first_bubble_line{$response-1} +1; |
|
my $bubble_lines= $bubble_lines_per_response{$response-1}; |
|
|
|
my $selected = ""; |
|
|
|
for (my $bline = 0; $bline < $bubble_lines; $bline++) { |
|
$selected .= $$parsed_line{"scantron.$bubble_line.answer"}.":"; |
|
$bubble_line++; |
|
} |
|
return $selected; |
|
} |
|
|
|
|
|
# ----- These first few routines are general use routines.---- |
|
|
|
# Return the number of occurences of a pattern in a string. |
|
|
|
sub occurence_count { |
|
my ($string, $pattern) = @_; |
|
|
|
my @matches = ($string =~ /$pattern/g); |
|
|
|
return scalar(@matches); |
|
} |
|
|
|
|
|
# Take a string known to have digits and convert all the |
|
# digits into letters in the range J,A..I. |
|
|
|
sub digits_to_letters { |
|
my ($input) = @_; |
|
|
|
my @alphabet = ('J', 'A'..'I'); |
|
|
|
my @input = split(//, $input); |
|
my $output =''; |
|
for (my $i = 0; $i < scalar(@input); $i++) { |
|
if ($input[$i] =~ /\d/) { |
|
$output .= $alphabet[$input[$i]]; |
|
} else { |
|
$output .= $input[$i]; |
|
} |
|
} |
|
return $output; |
|
} |
|
|
|
# |
# |
# --- Retrieve the parts from the metadata file.--- |
# --- Retrieve the parts from the metadata file.--- |
Line 4757 sub getSequenceDropDown {
|
Line 4675 sub getSequenceDropDown {
|
return $result; |
return $result; |
} |
} |
|
|
|
my %bubble_lines_per_response; # no. bubble lines for each response. |
|
# index is "symb.part_id" |
|
|
|
my %first_bubble_line; # First bubble line no. for each bubble. |
|
|
|
# Save and restore the bubble lines array to the form env. |
|
|
|
|
|
sub save_bubble_lines { |
|
foreach my $line (keys(%bubble_lines_per_response)) { |
|
$env{"form.scantron.bubblelines.$line"} = $bubble_lines_per_response{$line}; |
|
$env{"form.scantron.first_bubble_line.$line"} = |
|
$first_bubble_line{$line}; |
|
} |
|
} |
|
|
|
|
|
sub restore_bubble_lines { |
|
my $line = 0; |
|
%bubble_lines_per_response = (); |
|
while ($env{"form.scantron.bubblelines.$line"}) { |
|
my $value = $env{"form.scantron.bubblelines.$line"}; |
|
$bubble_lines_per_response{$line} = $value; |
|
$first_bubble_line{$line} = |
|
$env{"form.scantron.first_bubble_line.$line"}; |
|
$line++; |
|
} |
|
|
|
} |
|
|
|
# Given the parsed scanline, get the response for |
|
# 'answer' number n: |
|
|
|
sub get_response_bubbles { |
|
my ($parsed_line, $response) = @_; |
|
|
|
|
|
my $bubble_line = $first_bubble_line{$response-1} +1; |
|
my $bubble_lines= $bubble_lines_per_response{$response-1}; |
|
|
|
my $selected = ""; |
|
|
|
for (my $bline = 0; $bline < $bubble_lines; $bline++) { |
|
$selected .= $$parsed_line{"scantron.$bubble_line.answer"}.":"; |
|
$bubble_line++; |
|
} |
|
return $selected; |
|
} |
|
|
=pod |
=pod |
|
|
Line 5098 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 5184 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 5216 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 5301 sub scan_data {
|
Line 5235 sub scan_data {
|
return $scan_data->{$filename.'_'.$key}; |
return $scan_data->{$filename.'_'.$key}; |
} |
} |
|
|
|
# ----- These first few routines are general use routines.---- |
|
|
|
# Return the number of occurences of a pattern in a string. |
|
|
|
sub occurence_count { |
|
my ($string, $pattern) = @_; |
|
|
|
my @matches = ($string =~ /$pattern/g); |
|
|
|
return scalar(@matches); |
|
} |
|
|
|
|
|
# Take a string known to have digits and convert all the |
|
# digits into letters in the range J,A..I. |
|
|
|
sub digits_to_letters { |
|
my ($input) = @_; |
|
|
|
my @alphabet = ('J', 'A'..'I'); |
|
|
|
my @input = split(//, $input); |
|
my $output =''; |
|
for (my $i = 0; $i < scalar(@input); $i++) { |
|
if ($input[$i] =~ /\d/) { |
|
$output .= $alphabet[$input[$i]]; |
|
} else { |
|
$output .= $input[$i]; |
|
} |
|
} |
|
return $output; |
|
} |
|
|
=pod |
=pod |
|
|
=item scantron_parse_scanline |
=item scantron_parse_scanline |
Line 5403 sub scantron_parse_scanline {
|
Line 5370 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; |
|
|
$questnum++; |
$questnum++; |
my $currentquest = substr($questions,0,$answer_length); |
my $currentquest = substr($questions,0,$answer_length); |
Line 5702 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 6613 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 |
=pod |
|
|
=item scantron_bubble_selector |
=item questions_to_line_list |
|
|
Generates the html radiobuttons to correct a single bubble line |
|
possibly showing the existing the selected bubbles if known |
|
|
|
Arguments: |
Converts a list of questions into a string of comma separated |
$r - Apache request object |
line numbers in the answer sheet used by the questions. This is |
$scan_config - hash from &get_scantron_config() |
used to fill in the scantron_questions form field. |
$quest - number of the bubble line to make a corrector for |
|
@lines - array of answer lines. |
Arguments: |
|
questions - Reference to an array of questions. |
|
|
=cut |
=cut |
|
|
sub scantron_bubble_selector { |
|
my ($r,$scan_config,$quest,@lines)=@_; |
|
my $max=$$scan_config{'Qlength'}; |
|
|
|
|
sub questions_to_line_list { |
|
my ($questions) = @_; |
|
my @lines; |
|
|
my $scmode=$$scan_config{'Qon'}; |
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); |
|
} |
|
|
my $bubble_length = scalar(@lines); |
=pod |
|
|
|
=item prompt_for_corrections |
|
|
if ($scmode eq 'number' || $scmode eq 'letter') { $max=10; } |
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). |
|
|
my $response = $quest-1; |
Arguments: |
my $lines = $bubble_lines_per_response{$response}; |
$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. |
|
|
my $total_lines = $lines*2; |
Implicit inputs: |
my @alphabet=('A'..'Z'); |
%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. |
|
|
$r->print("<table border='1'><tr><td rowspan='".$total_lines."'>$quest</td>"); |
=cut |
|
|
for (my $l = 0; $l < $lines; $l++) { |
sub prompt_for_corrections { |
if ($l != 0) { |
my ($r, $question, $scan_config, $scan_record) = @_; |
$r->print('<tr>'); |
|
} |
|
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(' '); |
|
} |
|
$r->print('</td>'); |
|
|
|
} |
|
|
|
if ($l == 0) { |
my $lines = $bubble_lines_per_response{$question-1}; |
my $lspan = $total_lines * 2; # 2 table rows per bubble line. |
my $current_line = $first_bubble_line{$question-1} + 1 ; |
|
|
$r->print('<td rowspan='.$lspan.'><label><input type="radio" name="scantron_correct_Q_'. |
if ($lines > 1) { |
$quest.'" value="none" /> '.&mt('No bubble').' </label></td>'); |
$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 />"); |
|
} |
} |
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 />"); |
|
} |
|
} |
|
|
$r->print('</tr><tr>'); |
=pod |
|
|
# FIXME: This may have to be a bit more clever for |
=item scantron_bubble_selector |
# multiline questions (different values e.g..). |
|
|
Generates the html radiobuttons to correct a single bubble line |
|
possibly showing the existing the selected bubbles if known |
|
|
for (my $i=0;$i<$max;$i++) { |
Arguments: |
my $value = "$l:$i"; # Relative bubble line #: Bubble in line. |
$r - Apache request object |
$r->print("\n". |
$scan_config - hash from &get_scantron_config() |
'<td><label><input type="radio" name="scantron_correct_Q_'. |
$line - Number of the line being displayed. |
$quest.'" value="'.$value.'" />'.$alphabet[$i]."</label></td>"); |
@selected - Array of bubbles picked on this line. |
} |
|
$r->print('</tr>'); |
|
|
|
|
=cut |
} |
|
$r->print('</table>'); |
sub scantron_bubble_selector { |
|
my ($r,$scan_config,$line,@selected)=@_; |
|
my $max=$$scan_config{'Qlength'}; |
|
|
|
my $scmode=$$scan_config{'Qon'}; |
|
if ($scmode eq 'number' || $scmode eq 'letter') { $max=10; } |
|
|
|
my @alphabet=('A'..'Z'); |
|
$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(' '); } |
|
$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 |
=pod |
Line 6959 sub scantron_get_maxbubble {
|
Line 6965 sub scantron_get_maxbubble {
|
my $bubble_line = 0; |
my $bubble_line = 0; |
foreach my $resource (@resources) { |
foreach my $resource (@resources) { |
my $symb = $resource->symb(); |
my $symb = $resource->symb(); |
&Apache::lonxml::clear_bubble_lines_for_part(); |
|
my $result=&Apache::lonnet::ssi($resource->src(), |
my $result=&Apache::lonnet::ssi($resource->src(), |
('symb' => $resource->symb()), |
('symb' => $resource->symb()), |
('grade_target' => 'analyze'), |
('grade_target' => 'analyze'), |
Line 7671 GRADINGMENUJS
|
Line 7676 GRADINGMENUJS
|
</div> |
</div> |
</div> |
</div> |
</form>'; |
</form>'; |
|
$result .= &show_grading_menu_form($symb); |
return $result; |
return $result; |
} |
} |
|
|