--- loncom/homework/grades.pm	2008/05/24 00:34:12	1.522
+++ loncom/homework/grades.pm	2008/06/24 17:42:01	1.523
@@ -1,7 +1,7 @@
 # The LearningOnline Network with CAPA
 # The LON-CAPA Grading handler
 #
-# $Id: grades.pm,v 1.522 2008/05/24 00:34:12 www Exp $
+# $Id: grades.pm,v 1.523 2008/06/24 17:42:01 raeburn Exp $
 #
 # Copyright Michigan State University Board of Trustees
 #
@@ -5145,8 +5145,37 @@ sub scantron_selectphase {
 ');
 
     &Apache::lonpickcode::code_list($r,2);
+
+    $r>print('<br /><form method="post" name="checkscantron">'.
+             $default_form_data."\n".
+             &Apache::loncommon::start_data_table('LC_scantron_action')."\n".
+             &Apache::loncommon::start_data_table_header_row()."\n".
+             '<th colspan="2">
+              &nbsp;'.&mt('Review scantron data and submissions for a previously graded folder/sequence')."\n".
+             '</th>'."\n".
+              &Apache::loncommon::end_data_table_header_row()."\n".
+              &Apache::loncommon::start_data_table_row()."\n".
+              '<td> '.&mt('Graded folder/sequence:').' </td>'."\n".
+              '<td> '.$sequence_selector.' </td>'.
+              &Apache::loncommon::end_data_table_row()."\n".
+              &Apache::loncommon::start_data_table_row()."\n".
+              '<td> '.&mt('Filename of scoring office file:').' </td>'."\n".
+              '<td> '.$file_selector.' </td>'."\n".
+              &Apache::loncommon::end_data_table_row()."\n".
+              &Apache::loncommon::start_data_table_row()."\n".
+              '<td> '.&mt('Format of data file:').' </td>'."\n".
+              '<td> '.$format_selector.' </td>'."\n".
+              &Apache::loncommon::end_data_table_row()."\n".
+              &Apache::loncommon::start_data_table_row()."\n".
+              '<td colspan="2">'."\n".
+              '<input type="hidden" name="command" value="checksubmissions" />'."\n".
+              '<input type="submit" value="'.&mt('Review Scantron Data and Submission Records').'" />'."\n".
+              '</td>'."\n".
+              &Apache::loncommon::end_data_table_row()."\n".
+              &Apache::loncommon::end_data_table()."\n".
+              '</form><br />');
     $r->print($grading_menu_button);
-    return
+    return;
 }
 
 =pod
@@ -7300,30 +7329,32 @@ sub scantron_get_maxbubble {
     my $bubble_line     = 0;
     foreach my $resource (@resources) {
         my $symb = $resource->symb();
+
+        my (@parts,@allparts,@possible_parts);
+
         # Need to retrieve part IDs and response IDs because essayresponse,
         # reactionresponse and organicresponse items are not included in 
         # $analysis{'parts'} from lonnet::ssi.  
-        my %possible_part_ids; 
-        if (ref($resource->parts()) eq 'ARRAY') { 
+        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) {
-                        $possible_part_ids{$part.'.'.$id} = 1;
+                        my $part_id = $part.'.'.$id;
+                        push(@possible_parts,$part_id);
                     }
                 }
             }
         }
-	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 @parts;
+        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);
 
@@ -7335,19 +7366,22 @@ sub scantron_get_maxbubble {
                 }
             }
         }
-        # Add part_ids for any essayresponse items. 
-        foreach my $part_id (keys(%possible_part_ids)) {
-            if (($analysis{$part_id.'.type'} eq 'essayresponse') ||
-                ($analysis{$part_id.'.type'} eq 'reactionresponse') ||
-                ($analysis{$part_id.'.type'} eq 'organicresponse')) {
-                if (!grep(/^\Q$part_id\E$/,@parts)) {
-                    push (@parts,$part_id);
+        # 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 (@parts) {
-            my $lines = $analysis{"$part_id.bubble_lines"};
+	foreach my $part_id (@allparts) {
+            my $lines;
 
 	    # TODO - make this a persistent hash not an array.
 
@@ -7374,8 +7408,8 @@ sub scantron_get_maxbubble {
                     $numshown = scalar(@{$analysis{$part_id.'.shown'}});
                 }
                 my $bubbles_per_line = 10;
-                my $inner_bubble_lines = int($numshown/$bubbles_per_line);
-                if (($numshown % $bubbles_per_line) != 0) {
+                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++) {
@@ -7383,6 +7417,9 @@ sub scantron_get_maxbubble {
                         $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;
@@ -7802,6 +7839,271 @@ sub scantron_download_scantron_data {
     return '';
 }
 
+sub checkscantron_results {
+    my ($r) = @_;
+    my ($symb)=&get_symb($r);
+    if (!$symb) {return '';}
+    my $grading_menu_button=&show_grading_menu_form($symb);
+    my $cid = $env{'request.course.id'};
+    my %lettdig = (
+                    A => 1,
+                    B => 2,
+                    C => 3,
+                    D => 4,
+                    E => 5,
+                    F => 6,
+                    G => 7,
+                    H => 8,
+                    I => 9,
+                    J => 0,
+                  );
+    my $numletts = scalar(keys(%lettdig));
+    my $cnum = $env{'course.'.$cid.'.num'};
+    my $cdom = $env{'course.'.$cid.'.domain'};
+    my (undef, undef, $sequence) = &Apache::lonnet::decode_symb($env{'form.selectpage'});
+    my %record;
+    my %scantron_config =
+        &Apache::grades::get_scantron_config($env{'form.scantron_format'});
+    my ($scanlines,$scan_data)=&Apache::grades::scantron_getfile();
+    my $classlist=&Apache::loncoursedata::get_classlist();
+    my %idmap=&Apache::grades::username_to_idmap($classlist);
+    my $navmap=Apache::lonnavmaps::navmap->new();
+    my $map=$navmap->getResourceByUrl($sequence);
+    my @resources=$navmap->retrieveResources($map,undef,1,0);
+    my (%scandata,%lastname,%bylast);
+    $r->print('
+<form method="post" enctype="multipart/form-data" action="/adm/grades" name="checkscantron">'."\n");
+
+    my @delayqueue;
+    my %completedstudents;
+
+    my $count=&Apache::grades::get_todo_count($scanlines,$scan_data);
+    my %prog_state=&Apache::lonhtmlcommon::Create_PrgWin($r,'Scantron/Submissions Comparison Status',
+                                    'Progress of Scantron Data/Submission Records Comparison',$count,
+                                    'inline',undef,'checkscantron');
+    my ($username,$domain,$uname,$started);
+
+    &Apache::grades::scantron_get_maxbubble();  # Need the bubble lines array to parse.
+
+    &Apache::lonhtmlcommon::Update_PrgWin($r,\%prog_state,
+                                          'Processing first student');
+    my $start=&Time::HiRes::time();
+    my $i=-1;
+
+    while ($i<$scanlines->{'count'}) {
+        ($username,$domain,$uname)=('','','');
+        $i++;
+        my $line=&Apache::grades::scantron_get_line($scanlines,$scan_data,$i);
+        if ($line=~/^[\s\cz]*$/) { next; }
+        if ($started) {
+            &Apache::lonhtmlcommon::Increment_PrgWin($r,\%prog_state,
+                                                     'last student');
+        }
+        $started=1;
+        my $scan_record=
+            &Apache::grades::scantron_parse_scanline($line,$i,\%scantron_config,
+                                                     $scan_data);
+        unless ($uname=&Apache::grades::scantron_find_student($scan_record,$scan_data,
+                                                              \%idmap,$i)) {
+            &Apache::grades::scantron_add_delay(\@delayqueue,$line,
+                                'Unable to find a student that matches',1);
+            next;
+        }
+        if (exists $completedstudents{$uname}) {
+            &Apache::grades::scantron_add_delay(\@delayqueue,$line,
+                                'Student '.$uname.' has multiple sheets',2);
+            next;
+        }
+        my $pid = $scan_record->{'scantron.ID'};
+        $lastname{$pid} = $scan_record->{'scantron.LastName'};
+        push(@{$bylast{$lastname{$pid}}},$pid);
+        my $lastpos = $env{'form.scantron_maxbubble'}*$scantron_config{'Qlength'};
+        $scandata{$pid} = substr($line,$scantron_config{'Qstart'}-1,$lastpos);
+        chomp($scandata{$pid});
+        $scandata{$pid} =~ s/\r$//;
+        ($username,$domain)=split(/:/,$uname);
+        my $counter = -1;
+        my (%expected,%startpos);
+        foreach my $resource (@resources) {
+            next if (!$resource->is_problem());
+            my $symb = $resource->symb();
+            my $partsref = $resource->parts();
+            my @parts;
+            my @part_ids = ();
+            if (ref($partsref) eq 'ARRAY') {
+               @parts = @{$partsref};
+               foreach my $part (@parts) {
+                   my @resp_ids = $resource->responseIds($part);
+                   foreach my $resp (@resp_ids) {
+                       $counter ++;
+                       my $part_id = $part.'.'.$resp;
+                       $expected{$part_id} = 0;
+                       push(@part_ids,$part_id);
+                       if ($env{"form.scantron.sub_bubblelines.$counter"}) {
+                           my @sub_lines = split(/,/,$env{"form.scantron.sub_bubblelines.$counter"});
+                           foreach my $item (@sub_lines) {
+                               $expected{$part_id} += $item;
+                           }
+                       } else {
+                           $expected{$part_id} = $env{"form.scantron.bubblelines.$counter"};
+                       }
+                       $startpos{$part_id} = $env{"form.scantron.first_bubble_line.$counter"};
+                   }
+                }
+            }
+            if ($symb) {
+                my %recorded;
+                my (%returnhash) =
+                    &Apache::lonnet::restore($symb,$cid,$domain,$username);
+                if ($returnhash{'version'}) {
+                    my %lasthash=();
+                    my $version;
+                    for ($version=1;$version<=$returnhash{'version'};$version++) {
+                        foreach my $key (sort(split(/\:/,$returnhash{$version.':keys'}))) {
+                            $lasthash{$key}=$returnhash{$version.':'.$key};
+                        }
+                    }
+                    foreach my $key (keys(%lasthash)) {
+                        if ($key =~ /\.scantron$/) {
+                            my $value = &unescape($lasthash{$key});
+                            my ($part_id) = ($key =~ /^resource\.(.+)\.scantron$/);
+                            if ($value eq '') {
+                                for (my $i=0; $i<$expected{$part_id}; $i++) {
+                                    for (my $j=0; $j<$scantron_config{'length'}; $j++) {
+                                        $recorded{$part_id} .= $;
+                                    }
+                                }
+                            } else {
+                                my @tocheck;
+                                my @items = split(//,$value);
+                                if (($scantron_config{'Qon'} eq 'letter') ||
+                                    ($scantron_config{'Qon'} eq 'number')) {
+                                    if (@items < $expected{$part_id}) {
+                                        my $fragment = substr($scandata{$pid},$startpos{$part_id},$expected{$part_id});
+                                        my @singles = split(//,$fragment);
+                                        foreach my $pos (@singles) {
+                                            if ($pos eq ' ') {
+                                                push(@tocheck,$pos);
+                                            } else {
+                                                my $next = shift(@items);
+                                                push(@tocheck,$next);
+                                            }
+                                        }
+                                    } else {
+                                        @tocheck = @items;
+                                    }
+                                    foreach my $letter (@tocheck) {
+                                        if ($scantron_config{'Qon'} eq 'letter') {
+                                            if ($letter !~ /^[A-J]$/) {
+                                                $letter = $scantron_config{'Qoff'};
+                                            }
+                                            $recorded{$part_id} .= $letter;
+                                        } elsif ($scantron_config{'Qon'} eq 'number') {
+                                            my $digit;
+                                            if ($letter !~ /^[A-J]$/) {
+                                                $digit = $scantron_config{'Qoff'};
+                                            } else {
+                                                $digit = $lettdig{$letter};
+                                            }
+                                            $recorded{$part_id} .= $digit;
+                                        }
+                                    }
+                                } else {
+                                    @tocheck = @items;
+                                    for (my $i=0; $i<$expected{$part_id}; $i++) {
+                                        my $curr_sub = shift(@tocheck);
+                                        my $digit;
+                                        if ($curr_sub =~ /^[A-J]$/) {
+                                            $digit = $lettdig{$curr_sub}-1;
+                                        }
+                                        if ($curr_sub eq 'J') {
+                                            $digit += scalar($numletts);
+                                        }
+                                        for (my $j=0; $j<$scantron_config{'Qlength'}; $j++) {
+                                            if ($j == $digit) {
+                                                $recorded{$part_id} .= $scantron_config{'Qon'};
+                                            } else {
+                                                $recorded{$part_id} .= $scantron_config{'Qoff'};
+                                            }
+                                        }
+                                    }
+                                }
+                            }
+                        }
+                    }
+                }
+                foreach my $part_id (@part_ids) {
+                    if ($recorded{$part_id} eq '') {
+                        for (my $i=0; $i<$expected{$part_id}; $i++) {
+                            for (my $j=0; $j<$scantron_config{'Qlength'}; $j++) {
+                                $recorded{$part_id} .= $scantron_config{'Qoff'};
+                            }
+                        }
+                    }
+                    $record{$pid} .= $recorded{$part_id};
+                }
+            }
+        }
+    }
+    &Apache::lonhtmlcommon::Close_PrgWin($r,\%prog_state);
+    $r->print('<br />');
+    my ($okstudents,$badstudents,$numstudents,$passed,$failed);
+    $passed = 0;
+    $failed = 0;
+    $numstudents = 0;
+    foreach my $last (sort(keys(%bylast))) {
+        if (ref($bylast{$last}) eq 'ARRAY') {
+            foreach my $pid (sort(@{$bylast{$last}})) {
+                my $showscandata = $scandata{$pid};
+                my $showrecord = $record{$pid};
+                $showscandata =~ s/\s/&nbsp;/g;
+                $showrecord =~ s/\s/&nbsp;/g;
+                if ($scandata{$pid} eq $record{$pid}) {
+                    my $css_class = ($passed % 2)?'LC_odd_row':'LC_even_row';
+                    $okstudents .= '<tr class="'.$css_class.'">'.
+'<td>'.&mt('Scantron').'</td><td>'.$showscandata.'</td><td rowspan="2">'.$last.'</td><td rowspan="2">'.$pid.'</td>'."\n".
+'</tr>'."\n".
+'<tr class="'.$css_class.'">'."\n".
+'<td>Submissions</td><td>'.$showrecord.'</td></tr>'."\n";
+                    $passed ++;
+                } else {
+                    my $css_class = ($failed % 2)?'LC_odd_row':'LC_even_row';
+                    $badstudents .= '<tr class="'.$css_class.'"><td>'.&mt('Scantron').'</td><td><span class="LC_nobreak">'.$scandata{$pid}.'</span></td><td rowspan="2">'.$last.'</td><td rowspan="2">'.$pid.'</td>'."\n".
+'</tr>'."\n".
+'<tr class="'.$css_class.'">'."\n".
+'<td>Submissions</td><td><span class="LC_nobreak">'.$record{$pid}.'</span></td>'."\n".
+'</tr>'."\n";
+                    $failed ++;
+                }
+                $numstudents ++;
+            }
+        }
+    }
+    $r->print('<p>'.&mt('Comparison of scantron data (including corrections) with corresponding submission records (most recent submission) for <b>[quant,_1,student]</b>  ([_2] scantron lines/student).',$numstudents,$env{'form.scantron_maxbubble'}).'</p>');
+    $r->print('<p>'.&mt('Exact matches for <b>[quant,_1,student]</b>.',$passed).'<br />'.&mt('Discrepancies detected for <b>[quant,_1,student]</b>.',$failed).'</p>');
+    if ($passed) {
+        $r->print(&mt('Students with exact correspondence between scantron data and submissions are as follows:').'<br /><br />');
+        $r->print(&Apache::loncommon::start_data_table()."\n".
+                 &Apache::loncommon::start_data_table_header_row()."\n".
+                 '<th>'.&mt('Source').'</th><th>'.&mt('Bubble records').'</th><th>'.&mt('Name').'</th><th>'.&mt('ID').'</th>'.
+                 &Apache::loncommon::end_data_table_header_row()."\n".
+                 $okstudents."\n".
+                 &Apache::loncommon::end_data_table().'<br />');
+    }
+    if ($failed) {
+        $r->print(&mt('Students with differences between scantron data and submissions are as follows:').'<br /><br />');
+        $r->print(&Apache::loncommon::start_data_table()."\n".
+                 &Apache::loncommon::start_data_table_header_row()."\n".
+                 '<th>'.&mt('Source').'</th><th>'.&mt('Bubble records').'</th><th>'.&mt('Name').'</th><th>'.&mt('ID').'</th>'.
+                 &Apache::loncommon::end_data_table_header_row()."\n".
+                 $badstudents."\n".
+                 &Apache::loncommon::end_data_table()).'<br />'.
+                 &mt('Differences can occur if submissions were modified using manual grading after a scantron grading pass.').'<br />'.&mt('If unexpected discrepancies were detected, it is recommended that you inspect the original scantron sheets.');  
+    }
+    $r->print('</form><br />'.$grading_menu_button);
+    return;
+}
+
 =pod
 
 =back
@@ -7874,9 +8176,9 @@ sub grading_menu {
     $fields{'command'} = 'scantron_selectphase';
     $url = &Apache::lonhtmlcommon::build_url('grades/',\%fields);
     push (@menu, { url => $url,
-                   name => &mt('Grade/Manage Scantron Forms'),
+                   name => &mt('Grade/Manage/Review Scantron Forms'),
                    short_description => 
-            &mt('')});
+            &mt('Grade scantron exams, upload/download scantron data files, and review previously graded scantron exams.')});
     $fields{'command'} = 'verify';
     $url = &Apache::lonhtmlcommon::build_url('grades/',\%fields);
     push (@menu, { url => "",
@@ -8770,6 +9072,8 @@ sub handler {
  	} elsif ($command eq 'scantron_download' &&
 		 &Apache::lonnet::allowed('usc',$env{'request.course.id'})) {
  	    $request->print(&scantron_download_scantron_data($request));
+        } elsif ($command eq 'checksubmissions' && $perm{'vgr'}) {
+            $request->print(&checkscantron_results($request));     
 	} elsif ($command) {
 	    $request->print("Access Denied ($command)");
 	}