--- loncom/homework/grades.pm 2008/12/10 21:30:38 1.528.2.1
+++ loncom/homework/grades.pm 2008/12/24 12:33:28 1.528.2.5
@@ -1,7 +1,7 @@
# The LearningOnline Network with CAPA
# The LON-CAPA Grading handler
#
-# $Id: grades.pm,v 1.528.2.1 2008/12/10 21:30:38 raeburn Exp $
+# $Id: grades.pm,v 1.528.2.5 2008/12/24 12:33:28 raeburn Exp $
#
# Copyright Michigan State University Board of Trustees
#
@@ -2796,8 +2796,10 @@ sub handback_files {
$newflg.'_'.$part_resp.'_returndoc'.$file_counter,
$save_file_name);
if ($result !~ m|^/uploaded/|) {
- $request->print('An error occurred ('.$result.
- ') while trying to upload '.$newflg.'_'.$part_resp.'_returndoc'.$file_counter.' ');
+ if ($scancode eq '') {
+ $r->print(&mt('Mismatch grading bubble sheet for user: [_1] with ID: [_2].',
+ $uname.':'.$udom,$scan_record->{'scantron.ID'}));
+ } else {
+ $r->print(&mt('Mismatch grading bubble sheet for user: [_1] with ID: [_2] and CODE: [_3].',
+ $uname.':'.$udom,$scan_record->{'scantron.ID'},$scancode));
+ }
+ $r->print('
');
+ $request->print('
'.
+ &mt('An error occurred ([_1]) while trying to upload [_2].',
+ $result,$newflg.'_'.$part_resp.'_returndoc'.$file_counter).
+ '');
} else {
# mark the file as read only
my @files = ($save_file_name);
@@ -7331,35 +7333,84 @@ sub scantron_get_maxbubble {
my $response_number = 0;
my $bubble_line = 0;
foreach my $resource (@resources) {
- my $symb = $resource->symb();
+ my ($analysis,$parts) = &scantron_partids_tograde($resource,$cid,$uname,$udom);
+ if ((ref($analysis) eq 'HASH') && (ref($parts) eq 'ARRAY')) {
+ foreach my $part_id (@{$parts}) {
+
+ my $lines;
+
+ # 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($numbub/$bubbles_per_line);
+ if (($numbub % $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/,$//;
+ $lines = $numshown * $inner_bubble_lines;
+ } else {
+ $lines = $analysis->{"$part_id.bubble_lines"};
+ }
- my (@parts,@allparts,@possible_parts);
+ $first_bubble_line{$response_number} = $bubble_line;
+ $bubble_lines_per_response{$response_number} = $lines;
+ $responsetype_per_response{$response_number} =
+ $analysis->{$part_id.'.type'};
+ $response_number++;
- # Need to retrieve part IDs and response IDs because essayresponse,
- # reactionresponse and organicresponse items are not included in
- # $analysis{'parts'} from lonnet::ssi.
- if (ref($resource->parts()) eq 'ARRAY') {
- 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) {
- my $part_id = $part.'.'.$id;
- push(@possible_parts,$part_id);
- }
- }
- }
+ $bubble_line += $lines;
+ $total_lines += $lines;
+ }
}
+ }
+ &Apache::lonnet::delenv('scantron\.');
+
+ &save_bubble_lines();
+ $env{'form.scantron_maxbubble'} =
+ $total_lines;
+ return $env{'form.scantron_maxbubble'};
+}
+sub scantron_partids_tograde {
+ my ($resource,$cid,$uname,$udom) = @_;
+ my (%analysis,@parts);
+
+ if (ref($resource)) {
+ my $symb = $resource->symb();
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) =
- split(/_HASH_REF__/,$result, 2);
-
- my %analysis = &Apache::lonnet::str2hash($an);
+ my (undef, $an) = split(/_HASH_REF__/,$result, 2);
+ %analysis = &Apache::lonnet::str2hash($an);
if (ref($analysis{'parts'}) eq 'ARRAY') {
foreach my $part (@{$analysis{'parts'}}) {
@@ -7369,79 +7420,8 @@ sub scantron_get_maxbubble {
}
}
}
- # Add part_ids for any essayresponse, reactionresponse or
- # organicresponse items.
- foreach my $part_id (@possible_parts) {
- if (grep(/^\Q$part_id\E$/,@parts)) {
- push(@allparts,$part_id);
- } else {
- if (($analysis{$part_id.'.type'} eq 'essayresponse') ||
- ($analysis{$part_id.'.type'} eq 'reactionresponse') ||
- ($analysis{$part_id.'.type'} eq 'organicresponse')) {
- push(@allparts,$part_id);
- }
- }
- }
-
- foreach my $part_id (@allparts) {
- my $lines;
-
- # 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($numbub/$bubbles_per_line);
- if (($numbub % $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/,$//;
- $lines = $numshown * $inner_bubble_lines;
- } else {
- $lines = $analysis{"$part_id.bubble_lines"};
- }
-
- $first_bubble_line{$response_number} = $bubble_line;
- $bubble_lines_per_response{$response_number} = $lines;
- $responsetype_per_response{$response_number} =
- $analysis{$part_id.'.type'};
- $response_number++;
-
- $bubble_line += $lines;
- $total_lines += $lines;
- }
-
}
- &Apache::lonnet::delenv('scantron\.');
-
- &save_bubble_lines();
- $env{'form.scantron_maxbubble'} =
- $total_lines;
- return $env{'form.scantron_maxbubble'};
+ return (\%analysis,\@parts);
}
=pod
@@ -7548,6 +7528,14 @@ sub scantron_process_students {
my $navmap=Apache::lonnavmaps::navmap->new();
my $map=$navmap->getResourceByUrl($sequence);
my @resources=$navmap->retrieveResources($map,\&scantron_filter,1,0);
+
+ my ($uname,$udom,%partids_by_symb);
+ foreach my $resource (@resources) {
+ my $ressymb = $resource->symb();
+ my ($analysis,$parts) =
+ &scantron_partids_tograde($resource,$env{'request.course.id'},$uname,$udom);
+ $partids_by_symb{$ressymb} = $parts;
+ }
# $r->print("geto ".scalar(@resources)."
");
my $result= <
');
my $start=&Time::HiRes::time();
my $i=-1;
- my ($uname,$udom,$started);
+ my $started;
&scantron_get_maxbubble(); # Need the bubble lines array to parse.
@@ -7584,6 +7573,9 @@ SCANTRONFORM
return ''; # Dunno why the other returns return '' rather than just returning.
}
+ my %lettdig = &letter_to_digits();
+ my $numletts = scalar(keys(%lettdig));
+
while ($i<$scanlines->{'count'}) {
($uname,$udom)=('','');
$i++;
@@ -7615,36 +7607,80 @@ SCANTRONFORM
if (&scantron_clear_skip($scanlines,$scan_data,$i)) {
&scantron_putfile($scanlines,$scan_data);
}
-
- my $i=0;
- foreach my $resource (@resources) {
- $i++;
- my %form=('submitted' =>'scantron',
- 'grade_target' =>'grade',
- 'grade_username'=>$uname,
- 'grade_domain' =>$udom,
- 'grade_courseid'=>$env{'request.course.id'},
- 'grade_symb' =>$resource->symb());
- if (exists($scan_record->{'scantron.CODE'})
- &&
- &Apache::lonnet::validCODE($scan_record->{'scantron.CODE'})) {
- $form{'CODE'}=$scan_record->{'scantron.CODE'};
- } else {
- $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("");
- &ssi_print_error($r);
- $r->print(&show_grading_menu_form($symb));
- &Apache::lonnet::remove_lock($lock);
- return ''; # Why return ''? Beats me.
- }
- if (&Apache::loncommon::connection_aborted($r)) { last; }
- }
+ my $scancode;
+ if ((exists($scan_record->{'scantron.CODE'})) &&
+ (&Apache::lonnet::validCODE($scan_record->{'scantron.CODE'}))) {
+ $scancode = $scan_record->{'scantron.CODE'};
+ } else {
+ $scancode = '';
+ }
+
+ if (&grade_student_bubbles($r,$uname,$udom,$scan_record,$scancode,
+ @resources) eq 'ssi_error') {
+ $ssi_error = 0; # So end of handler error message does not trigger.
+ $r->print("");
+ &ssi_print_error($r);
+ $r->print(&show_grading_menu_form($symb));
+ &Apache::lonnet::remove_lock($lock);
+ return ''; # Why return ''? Beats me.
+ }
+
$completedstudents{$uname}={'line'=>$line};
+ if ($env{'form.verifyrecord'}) {
+ my $lastpos = $env{'form.scantron_maxbubble'}*$scantron_config{'Qlength'};
+ my $studentdata = substr($line,$scantron_config{'Qstart'}-1,$lastpos);
+ chomp($studentdata);
+ $studentdata =~ s/\r$//;
+ my $studentrecord = '';
+ my $counter = -1;
+ foreach my $resource (@resources) {
+ ($counter,my $recording) =
+ &verify_scantron_grading($resource,$udom,$uname,$env{'request.course.id'},
+ $counter,$studentdata,\%partids_by_symb,
+ \%scantron_config,\%lettdig,$numletts);
+ $studentrecord .= $recording;
+ }
+ if ($studentrecord ne $studentdata) {
+ $counter = -1;
+ $studentrecord = '';
+ foreach my $resource (@resources) {
+ ($counter,my $recording) =
+ &verify_scantron_grading($resource,$udom,$uname,$env{'request.course.id'},
+ $counter,$studentdata,\%partids_by_symb,
+ \%scantron_config,\%lettdig,$numletts);
+ $studentrecord .= $recording;
+ }
+ if ($studentrecord ne $studentdata) {
+ $r->print('
'.&Apache::loncommon::start_data_table()."\n".
+ &Apache::loncommon::start_data_table_header_row()."\n".
+ ''.&mt('Source').' '.&mt('Bubbled responses').' '.
+ &Apache::loncommon::end_data_table_header_row()."\n".
+ &Apache::loncommon::start_data_table_row().
+ ''.&mt('Bubble Sheet').' '.
+ ''.$studentdata.' '.
+ &Apache::loncommon::end_data_table_row().
+ &Apache::loncommon::start_data_table_row().
+ 'Stored submissions '.
+ ''.$studentrecord.' '."\n".
+ &Apache::loncommon::end_data_table_row().
+ &Apache::loncommon::end_data_table().'