--- loncom/homework/grades.pm	2008/04/21 16:30:47	1.518
+++ 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.518 2008/04/21 16:30:47 raeburn Exp $
+# $Id: grades.pm,v 1.523 2008/06/24 17:42:01 raeburn Exp $
 #
 # Copyright Michigan State University Board of Trustees
 #
@@ -4908,7 +4908,7 @@ sub scantron_scantab {
   domainconfig user, lines are from this file.
 
   Otherwise, fall back to getting lines from the legacy file on the
-  local server:  /home/httpd/lonTabs/scantronformat.tab    
+  local server:  /home/httpd/lonTabs/default_scantronformat.tab    
 
 =cut
 
@@ -4936,9 +4936,16 @@ sub get_scantronformat_file {
         }
     }
     if (!$gottab) {
-        my $fh=Apache::File->new($Apache::lonnet::perlvar{'lonTabDir'}.'/scantronformat.tab');
-        @lines = <$fh>;
-        close($fh);
+        my @domains = &Apache::lonnet::current_machine_domains();
+        if (grep(/^\Q$cdom\E$/,@domains)) {
+            my $fh=Apache::File->new($Apache::lonnet::perlvar{'lonTabDir'}.'/scantronformat.tab');
+            @lines = <$fh>;
+            close($fh);
+        } else {
+            my $fh=Apache::File->new($Apache::lonnet::perlvar{'lonTabDir'}.'/default_scantronformat.tab');
+            @lines = <$fh>;
+            close($fh);
+        }
     }
     return @lines;
 }
@@ -5138,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
@@ -7293,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);
 
@@ -7328,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.
 
@@ -7367,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++) {
@@ -7376,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;
@@ -7512,6 +7556,7 @@ SCANTRONFORM
     my @delayqueue;
     my %completedstudents;
     
+    my $lock=&Apache::lonnet::set_lock(&mt('Grading bubblesheet exam'));
     my $count=&get_todo_count($scanlines,$scan_data);
     my %prog_state=&Apache::lonhtmlcommon::Create_PrgWin($r,'Scantron Status',
  				    'Scantron Progress',$count,
@@ -7532,6 +7577,7 @@ SCANTRONFORM
 	$r->print("</form>");
 	&ssi_print_error($r);
 	$r->print(&show_grading_menu_form($symb));
+        &Apache::lonnet::remove_lock($lock);
 	return '';		# Dunno why the other returns return '' rather than just returning.
     }
 
@@ -7589,6 +7635,7 @@ SCANTRONFORM
 		$r->print("</form>");
 		&ssi_print_error($r);
 		$r->print(&show_grading_menu_form($symb));
+                &Apache::lonnet::remove_lock($lock);
 		return '';	# Why return ''?  Beats me.
 	    }
 
@@ -7601,6 +7648,7 @@ SCANTRONFORM
 	&Apache::lonnet::delenv('scantron\.');
     }
     &Apache::lonhtmlcommon::Close_PrgWin($r,\%prog_state);
+    &Apache::lonnet::remove_lock($lock);
 #    my $lasttime = &Time::HiRes::time()-$start;
 #    $r->print("<p>took $lasttime</p>");
 
@@ -7791,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
@@ -7863,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 => "",
@@ -8215,7 +8528,7 @@ sub process_clicker {
     if (!$env{'form.upfiletype'}) { $env{'form.upfiletype'}='iclicker'; }
 
     my %checked;
-    foreach my $gradingmechanism ('attendance','personnel','specific') {
+    foreach my $gradingmechanism ('attendance','personnel','specific','given') {
        if ($env{'form.gradingmechanism'} eq $gradingmechanism) {
           $checked{$gradingmechanism}="checked='checked'";
        }
@@ -8226,6 +8539,8 @@ sub process_clicker {
     my $attendance=&mt("Award points just for participation");
     my $personnel=&mt("Correctness determined from response by course personnel");
     my $specific=&mt("Correctness determined from response with clicker ID(s)"); 
+    my $given=&mt("Correctness determined from given list of answers").' '.
+              '<font size="-2"><tt>('.&mt("Provide comma-separated list. Use '*' for any answer correct, '-' for skip").')</tt></font>';
     my $pcorrect=&mt("Percentage points for correct solution");
     my $pincorrect=&mt("Percentage points for incorrect solution");
     my $selectform=&Apache::loncommon::select_form($env{'form.upfiletype'},'upfiletype',
@@ -8283,6 +8598,9 @@ function sanitycheck() {
 <br /><label><input type="radio" name="gradingmechanism" value="personnel" $checked{'personnel'} onClick="sanitycheck()" />$personnel</label>
 <br /><label><input type="radio" name="gradingmechanism" value="specific" $checked{'specific'} onClick="sanitycheck()" />$specific </label>
 <input type="text" name="specificid" value="$env{'form.specificid'}" size="20" />
+<br /><label><input type="radio" name="gradingmechanism" value="given" $checked{'given'} onClick="sanitycheck()" />$given </label>
+<br />&nbsp;&nbsp;&nbsp;
+<input type="text" name="givenanswer" size="50" />
 <input type="hidden" name="waschecked" value="$env{'form.gradingmechanism'}" />
 <br /><label>$pcorrect: <input type="text" name="pcorrect" size="4" value="$env{'form.pcorrect'}" onChange="sanitycheck()" /></label>
 <br /><label>$pincorrect: <input type="text" name="pincorrect" size="4" value="$env{'form.pincorrect'}" onChange="sanitycheck()" /></label>
@@ -8309,6 +8627,19 @@ sub process_clicker_file {
 	$result.='<span class="LC_error">'.&mt('You need to specify a clicker ID for the correct answer').'</span>';
 	return $result.&show_grading_menu_form($symb);
     }
+    if (($env{'form.gradingmechanism'} eq 'given') && ($env{'form.givenanswer'}!~/\S/)) {
+        $result.='<span class="LC_error">'.&mt('You need to specify the correct answer').'</span>';
+        return $result.&show_grading_menu_form($symb);
+    }
+    my $foundgiven=0;
+    if ($env{'form.gradingmechanism'} eq 'given') {
+        $env{'form.givenanswer'}=~s/^\s*//gs;
+        $env{'form.givenanswer'}=~s/\s*$//gs;
+        $env{'form.givenanswer'}=~s/[^a-zA-Z0-9\.\*\-]+/\,/g;
+        $env{'form.givenanswer'}=uc($env{'form.givenanswer'});
+        my @answers=split(/\,/,$env{'form.givenanswer'});
+        $foundgiven=$#answers+1;
+    }
     my %clicker_ids=&gather_clicker_ids();
     my %correct_ids;
     if ($env{'form.gradingmechanism'} eq 'personnel') {
@@ -8327,6 +8658,8 @@ sub process_clicker_file {
     }
     if ($env{'form.gradingmechanism'} eq 'attendance') {
 	$result.=&mt('Score based on attendance only');
+    } elsif ($env{'form.gradingmechanism'} eq 'given') {
+        $result.=&mt('Score based on [_1] ([_2] answers)','<tt>'.$env{'form.givenanswer'}.'</tt>',$foundgiven);
     } else {
 	my $number=0;
 	$result.='<p><b>'.&mt('Correctness determined by the following IDs').'</b>';
@@ -8372,6 +8705,9 @@ sub process_clicker_file {
 <input type="hidden" name="pcorrect" value="$env{'form.pcorrect'}" />
 <input type="hidden" name="pincorrect" value="$env{'form.pincorrect'}" />
 ENDHEADER
+    if ($env{'form.gradingmechanism'} eq 'given') {
+       $result.='<input type="hidden" name="correct:given" value="'.$env{'form.givenanswer'}.'" />';
+    } 
     my %responses;
     my @questiontitles;
     my $errormsg='';
@@ -8387,6 +8723,10 @@ ENDHEADER
              &mt('Awarding [_1] percent for correct and [_2] percent for incorrect responses',
                  $env{'form.pcorrect'},$env{'form.pincorrect'}).
              '<br />';
+    if (($env{'form.gradingmechanism'} eq 'given') && ($number!=$foundgiven)) {
+       $result.='<span class="LC_error">'.&mt('Number of given answers does not agree with number of questions in file.').'</span>';
+       return $result.&show_grading_menu_form($symb);
+    } 
 # Remember Question Titles
 # FIXME: Possibly need delimiter other than ":"
     for (my $i=0;$i<$number;$i++) {
@@ -8430,7 +8770,7 @@ ENDHEADER
     }
     $result.='<hr />'.
              &mt('Found [_1] registered and [_2] unregistered clickers.',$student_count,$unknown_count);
-    if ($env{'form.gradingmechanism'} ne 'attendance') {
+    if (($env{'form.gradingmechanism'} ne 'attendance') && ($env{'form.gradingmechanism'} ne 'given')) {
        if ($correct_count==0) {
           $errormsg.="Found no correct answers answers for grading!";
        } elsif ($correct_count>1) {
@@ -8575,10 +8915,15 @@ ENDHEADER
        if ($user) { 
           my @answer=split(/\,/,$env{$key});
           my $sum=0;
+          my $realnumber=$number;
           for (my $i=0;$i<$number;$i++) {
              if ($answer[$i]) {
                 if ($gradingmechanism eq 'attendance') {
                    $sum+=$pcorrect;
+                } elsif ($answer[$i] eq '*') {
+                   $sum+=$pcorrect;
+                } elsif ($answer[$i] eq '-') {
+                   $realnumber--;
                 } else {
                    if ($answer[$i] eq $correct[$i]) {
                       $sum+=$pcorrect;
@@ -8588,7 +8933,7 @@ ENDHEADER
                 }
              }
           }
-          my $ave=$sum/(100*$number);
+          my $ave=$sum/(100*$realnumber);
 # Store
           my ($username,$domain)=split(/\:/,$user);
           my %grades=();
@@ -8727,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)");
 	}