[LON-CAPA-cvs] cvs: loncom(version_1_0_2_scantron) /homework grades.pm

albertel lon-capa-cvs@mail.lon-capa.org
Sat, 27 Sep 2003 01:59:10 -0000


This is a MIME encoded message

--albertel1064627950
Content-Type: text/plain

albertel		Fri Sep 26 21:59:10 2003 EDT

  Modified files:              (Branch: version_1_0_2_scantron)
    /loncom/homework	grades.pm 
  Log:
  - working on double bubbles
  
  
--albertel1064627950
Content-Type: text/plain
Content-Disposition: attachment; filename="albertel-20030926215910.txt"

Index: loncom/homework/grades.pm
diff -u loncom/homework/grades.pm:1.130.2.1.2.3 loncom/homework/grades.pm:1.130.2.1.2.4
--- loncom/homework/grades.pm:1.130.2.1.2.3	Thu Sep 25 04:30:57 2003
+++ loncom/homework/grades.pm	Fri Sep 26 21:59:10 2003
@@ -1,7 +1,7 @@
 # The LearningOnline Network with CAPA
 # The LON-CAPA Grading handler
 #
-# $Id: grades.pm,v 1.130.2.1.2.3 2003/09/25 08:30:57 albertel Exp $
+# $Id: grades.pm,v 1.130.2.1.2.4 2003/09/27 01:59:10 albertel Exp $
 #
 # Copyright Michigan State University Board of Trustees
 #
@@ -3299,7 +3299,7 @@
     }
     $record{'scantron.ID'}=substr($data,$$scantron_config{'IDstart'}-1,
 				  $$scantron_config{'IDlength'});
-    $record{'scantron.paperID'}=
+    $record{'scantron.PaperID'}=
 	substr($data,$$scantron_config{'PaperID'}-1,
 	       $$scantron_config{'PaperIDlength'});
     $record{'scantron.FirstName'}=
@@ -3316,17 +3316,20 @@
 	substr($questions,0,$$scantron_config{'Qlength'})='';
 	if (length($currentquest) < $$scantron_config{'Qlength'}) { next; }
 	my (@array)=split(/$$scantron_config{'Qon'}/,$currentquest);
-	if (scalar(@array) gt 2) {
-	    #FIXME do something intelligent with double bubbles
-	    #actually not a concern right now, should be taking care of later
-	    Apache->request->print("<br ><b>Wha!!!</b> <pre>".scalar(@array).
-				   '-'.$currentquest.'-'.$questnum.'</pre><br />');
-	}
 	if (length($array[0]) eq $$scantron_config{'Qlength'}) {
 	    $record{"scantron.$questnum.answer"}='';
 	} else {
 	    $record{"scantron.$questnum.answer"}=$alphabet[length($array[0])];
 	}
+	if (scalar(@array) gt 2) {
+	    push(@{$record{'scantron.doubleerror'}},$currentquest);
+	    my @ans=@array;
+	    my $i=length($ans[0]);shift(@ans);
+	    while (@ans) {
+		$i+=length($ans[0])+1;
+		$record{"scantron.$questnum.answer"}.=$alphabet[$i];
+	    }
+	}
     }
     $record{'scantron.maxquest'}=$questnum;
     return \%record;
@@ -3378,15 +3381,20 @@
 	my $classlist=&Apache::loncoursedata::get_classlist();
 	my $which=$ENV{'form.scantron_line'};
 	my $line=&scantron_get_line($scanlines,$which);
-	my $newstudent=$ENV{'form.scantron_username'}.':'.
-	    $ENV{'form.scantron_domain'};
-	my $newid=$classlist->{$newstudent}->[&Apache::loncoursedata::CL_ID];
-	($line,my $err,my $errmsg)=
-	    &scantron_fixup_scanline(\%scantron_config,$line,'ID',$newid);
+	my ($skip,$err,$errmsg);
+	if ($ENV{'form.scantron_skip_record'}) {
+	    $skip=1;
+	} else {
+	    my $newstudent=$ENV{'form.scantron_username'}.':'.
+		$ENV{'form.scantron_domain'};
+	    my $newid=$classlist->{$newstudent}->[&Apache::loncoursedata::CL_ID];
+	    ($line,$err,$errmsg)=
+		&scantron_fixup_scanline(\%scantron_config,$line,'ID',$newid);
+	}
 	if ($err) {
 	    $r->print("Unable to accept last correction, an error occurred :$errmsg:");
 	} else {
-	    &scantron_put_line($scanlines,$which,$line);
+	    &scantron_put_line($scanlines,$which,$line,$skip);
 	    &scantron_putfile($scanlines);
 	}
     }
@@ -3536,12 +3544,13 @@
 	if (!$line) { next; }
 	my $scan_record=&scantron_parse_scanline($line,\%scantron_config);
 	my $id=$$scan_record{'scantron.ID'};
-	$r->print("<p>Checking ID ".$$scan_record{'scantron.ID'}."</p>\n");
+	$r->print("<p>Checking ID ".$$scan_record{'scantron.ID'}.
+		  " on paper ID ".$$scan_record{'scantron.PaperID'}."</p>\n");
 	my $found;
 	foreach my $checkid (keys(%idmap)) {
 	    if (lc($checkid) eq lc($id)) {
 		if ($checkid ne $id) {
-		    $r->print("<p>Using $checkid for bubbled $id</p>\n");
+		    $r->print("<p>Using $checkid for encoded $id</p>\n");
 		}
 		$found=$checkid;last;
 	    }
@@ -3549,14 +3558,15 @@
 	if ($found) {
 	    if ($found{'ids'}{$found}) {
 		#FIXME store away line we prviously saw the ID on
-		&scantron_get_ID_correction($r,$i,$scan_record,
-					    'duplicateID',$found);
+		&scantron_get_correction($r,$i,$scan_record,$line,
+					 'duplicateID',$found);
 		return(1);
 	    } else {
 		$found{'ids'}{$found}++;
 	    }
 	} else {
-	    &scantron_get_ID_correction($r,$i,$scan_record,'incorrectID');
+	    &scantron_get_correction($r,$i,$scan_record,$line,
+				     'incorrectID');
 	    return(1);
 	}
     }
@@ -3564,29 +3574,82 @@
     return (0,$currentphase+1);
 }
 
-sub scantron_get_ID_correction {
-    my ($r,$i,$scan_record,$error,$arg)=@_;
-#FIXME allow th poosibility of skipping a line, or in the case of a duplicated ID the previous line, probaly need to show both the current line and the previous one.
-    $r->print("<p>need to correct ID</p>\n");
+sub scantron_get_correction {
+    my ($r,$i,$scan_record,$line,$error,$arg)=@_;
+
+#FIXME in the case of a duplicated ID the previous line, probaly need
+#to show both the current line and the previous one and allow skipping
+#the previous one or the current one
+
+    $r->print("<p>This scantron record has an error.");
+    if ( defined($$scan_record{'scantron.PaperID'}) ) {
+	$r->print("The current PaperID is <tt>".
+		  $$scan_record{'scantron.PaperID'}."</tt> \n");
+    } else {
+	$r->print("The current scanline is <pre>".
+		  $line."</pre> \n");
+    }
     $r->print('<input type="hidden" name="scantron_corrections" value="'.$error.'" />'."\n");
     $r->print('<input type="hidden" name="scantron_line" value="'.$i.'" />'."\n");
-    if ($error eq 'unknownID') {
-	$r->print("<p> Unknown ID </p>\n");
-    } elsif ($error eq 'duplicateID') {
-	$r->print("<p> Duplicated ID </p>\n");
-    }
-    $r->print("<p>Original ID is ".$$scan_record{'scantron.ID'}."</p>\n");
-    $r->print("<p>Name on paper is ".$$scan_record{'scantron.LastName'}.",".
-	      $$scan_record{'scantron.FirstName'}."</p>");
-    $r->print("Corrected User -- ");
-    $r->print("\nusername:<input type='text' name='scantron_username' value='' />");
-    $r->print("\ndomain:".
-	      &Apache::loncommon::select_dom_form(undef,'scantron_domain'));
-    #FIXME it would be nice if this sent back the user ID and
-    #could do partial userID matches
-    $r->print(&Apache::loncommon::selectstudent_link('scantronupload',
-				       'scantron_username','scantron_domain'));
+    if ($error =~ /ID$/) {
+	if ($error eq 'unknownID') {
+	    $r->print("The encoded ID is not in the classlist</p>\n");
+	} elsif ($error eq 'duplicateID') {
+	    $r->print("The encoded ID has also been used by a previous paper $arg</p>\n");
+	}
+	$r->print("<p>Original ID is <tt>".$$scan_record{'scantron.ID'}.
+		  "</tt><br />\n");
+	$r->print("Name on paper is ".$$scan_record{'scantron.LastName'}.",".
+		  $$scan_record{'scantron.FirstName'}."</p>");
+	$r->print("<p>Please correct <br /> \n");
+	$r->print("\n<ul><li> Pick a specific user -- username:<input type='text' name='scantron_username' value='' />");
+	$r->print("\ndomain:".
+		 &Apache::loncommon::select_dom_form(undef,'scantron_domain'));
+	#FIXME it would be nice if this sent back the user ID and
+	#could do partial userID matches
+	$r->print(&Apache::loncommon::selectstudent_link('scantronupload',
+				      'scantron_username','scantron_domain'));
+    } elsif ($error eq 'doublebubble') {
+	$r->print("There have been muttiple bubbles scanned for a single question\n");
+	foreach my $question (@{$arg}) {
+	    my $selected=$$scan_record{"scantron.$question.answer"};
+	    $r->print("<p> For question $question, selected bubbles were".
+		      join(" ",split('',$selected)).
+		      " Please pick which one should be used for grading");
+	    #FIXMENEXT need to have radio buttons to chose which one to use
+	    
+	}
+    }
+    $r->print("</li> <li>Skip this scanline saving it for later  ");
+    $r->print("\n<input type='checkbox' name='scantron_skip_record' /> </li></ul>");
     &scantron_end_validate_form($r);
+}
+
+sub scantron_validate_CODE {
+    my ($r,$currentphase) = @_;
+    #FIXME doesn't do anything yet
+    return (0,$currentphase+1);
+}
+
+sub scantron_validate_doublebubble {
+    my ($r,$currentphase) = @_;
+    #get student info
+    my $classlist=&Apache::loncoursedata::get_classlist();
+    my %idmap=&username_to_idmap($classlist);
+
+    #get scantron line setup
+    my %scantron_config=&get_scantron_config($ENV{'form.scantron_format'});
+    my $scanlines=&scantron_getfile();
+    for (my $i=0;$i<=$scanlines->{'count'};$i++) {
+	my $line=&scantron_get_line($scanlines,$i);
+	if (!$line) { next; }
+	my $scan_record=&scantron_parse_scanline($line,\%scantron_config);
+	if (!defined($$scan_record{'scantron.doubleerror'})) { next; }
+	&scantron_get_correction($r,$i,$scan_record,$line,'double',
+				 $$scan_record{'scantron.doubleerror'});
+    	return (1,$currentphase);
+    }
+    return (0,$currentphase+1);
 }
 
 sub scantron_end_validate_form {

--albertel1064627950--