--- loncom/homework/grades.pm	2008/05/01 16:03:34	1.519
+++ loncom/homework/grades.pm	2008/05/24 00:34:12	1.522
@@ -1,7 +1,7 @@
 # The LearningOnline Network with CAPA
 # The LON-CAPA Grading handler
 #
-# $Id: grades.pm,v 1.519 2008/05/01 16:03:34 raeburn Exp $
+# $Id: grades.pm,v 1.522 2008/05/24 00:34:12 www Exp $
 #
 # Copyright Michigan State University Board of Trustees
 #
@@ -7519,6 +7519,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,
@@ -7539,6 +7540,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.
     }
 
@@ -7596,6 +7598,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.
 	    }
 
@@ -7608,6 +7611,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>");
 
@@ -8222,7 +8226,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'";
        }
@@ -8233,6 +8237,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',
@@ -8290,6 +8296,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>
@@ -8316,6 +8325,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') {
@@ -8334,6 +8356,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>';
@@ -8379,6 +8403,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='';
@@ -8394,6 +8421,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++) {
@@ -8437,7 +8468,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) {
@@ -8582,10 +8613,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;
@@ -8595,7 +8631,7 @@ ENDHEADER
                 }
              }
           }
-          my $ave=$sum/(100*$number);
+          my $ave=$sum/(100*$realnumber);
 # Store
           my ($username,$domain)=split(/\:/,$user);
           my %grades=();