--- loncom/homework/grades.pm 2003/09/25 08:30:57 1.130.2.1.2.3
+++ loncom/homework/grades.pm 2003/09/29 21:31:30 1.130.2.1.2.6
@@ -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.6 2003/09/29 21:31:30 albertel Exp $
#
# Copyright Michigan State University Board of Trustees
#
@@ -3214,6 +3214,13 @@ sub scantron_selectphase {
Format of data file: $format_selector
</td>
</tr>
+ <tr bgcolor="#ffffe6">
+ <td>
+<!-- FIXME this is lazy, a single parse of the set should let me know what this is -->
+ Last line to expect an answer on:
+ <input type="text" name="scantron_maxbubble" />
+ </td>
+ </tr>
</table>
</td>
</tr>
@@ -3269,7 +3276,7 @@ sub username_to_idmap {
}
sub scantron_fixup_scanline {
- my ($scantron_config,$line,$field,$newvalue) = @_;
+ my ($scantron_config,$scan_data,$line,$whichline,$field,$newvalue,$arg)=@_;
if ($field eq 'ID') {
if ($newvalue > $$scantron_config{'IDlength'}) {
return ($line,1,'New value to large');
@@ -3280,12 +3287,38 @@ sub scantron_fixup_scanline {
}
substr($line,$$scantron_config{'IDstart'}-1,
$$scantron_config{'IDlength'})=$newvalue;
+ } elsif ($field eq 'answer') {
+ my $length=$scantron_config->{'Qlength'};
+ my $off=$scantron_config->{'Qoff'};
+ my $on=$scantron_config->{'Qon'};
+ my $answer=${off}x$length;
+ if ($arg eq 'none') {
+ &scan_data($scan_data,"$whichline.no_bubble.$newvalue",'1');
+ } else {
+ substr($answer,$arg,1)=$on;
+ &scan_data($scan_data,"$whichline.no_bubble.$newvalue",undef,'1');
+ }
+ my $where=$length*($newvalue-1)+$scantron_config->{'Qstart'};
+ Apache->request->print("where $where arg $arg ");
+ Apache->request->print('b:<pre>'.$line.'</pre>');
+ substr($line,$where-1,$length)=$answer;
+ Apache->request->print('a:<pre>'.$line.'</pre>');
}
return $line;
}
+sub scan_data {
+ my ($scan_data,$key,$value,$delete)=@_;
+ my $filename=$ENV{'form.scantron_selectfile'};
+ if (defined($value)) {
+ $scan_data->{$filename.'_'.$key} = $value;
+ }
+ if ($delete) { delete($scan_data->{$filename.'_'.$key}); }
+ return $scan_data->{$filename.'_'.$key};
+}
+
sub scantron_parse_scanline {
- my ($line,$scantron_config)=@_;
+ my ($line,$whichline,$scantron_config,$scan_data)=@_;
my %record;
my $questions=substr($line,$$scantron_config{'Qstart'}-1);
my $data=substr($line,0,$$scantron_config{'Qstart'}-1);
@@ -3299,7 +3332,7 @@ sub scantron_parse_scanline {
}
$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'}=
@@ -3315,18 +3348,25 @@ sub scantron_parse_scanline {
my $currentquest=substr($questions,0,$$scantron_config{'Qlength'});
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 />');
- }
+ my @array=split($$scantron_config{'Qon'},$currentquest,-1);
if (length($array[0]) eq $$scantron_config{'Qlength'}) {
$record{"scantron.$questnum.answer"}='';
+ if (!&scan_data($scan_data,"$whichline.no_bubble.$questnum")) {
+ push(@{$record{"scantron.missingerror"}},$questnum);
+ }
} else {
$record{"scantron.$questnum.answer"}=$alphabet[length($array[0])];
}
+ if (scalar(@array) gt 2) {
+ push(@{$record{'scantron.doubleerror'}},$questnum);
+ my @ans=@array;
+ my $i=length($ans[0]);shift(@ans);
+ while (@ans) {
+ $i+=length($ans[0])+1;
+ $record{"scantron.$questnum.answer"}.=$alphabet[$i];
+ shift(@ans);
+ }
+ }
}
$record{'scantron.maxquest'}=$questnum;
return \%record;
@@ -3372,26 +3412,39 @@ sub scantron_filter {
sub scantron_process_corrections {
my ($r) = @_;
- if ($ENV{'form.scantron_corrections'} =~ /^(duplicate|incorrect)ID$/) {
- my %scantron_config=&get_scantron_config($ENV{'form.scantron_format'});
- my $scanlines=&scantron_getfile();
- my $classlist=&Apache::loncoursedata::get_classlist();
- my $which=$ENV{'form.scantron_line'};
- my $line=&scantron_get_line($scanlines,$which);
+ my %scantron_config=&get_scantron_config($ENV{'form.scantron_format'});
+ my ($scanlines,$scan_data)=&scantron_getfile();
+ my $classlist=&Apache::loncoursedata::get_classlist();
+ my $which=$ENV{'form.scantron_line'};
+ my $line=&scantron_get_line($scanlines,$which);
+ my ($skip,$err,$errmsg);
+ if ($ENV{'form.scantron_skip_record'}) {
+ $skip=1;
+ } elsif ($ENV{'form.scantron_corrections'} =~ /^(duplicate|incorrect)ID$/) {
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);
- if ($err) {
- $r->print("Unable to accept last correction, an error occurred :$errmsg:");
- } else {
- &scantron_put_line($scanlines,$which,$line);
- &scantron_putfile($scanlines);
+ ($line,$err,$errmsg)=
+ &scantron_fixup_scanline(\%scantron_config,$scan_data,$line,$which,
+ 'ID',$newid);
+ } elsif ($ENV{'form.scantron_corrections'} =~ /^(missing|double)bubble$/) {
+ foreach my $question (split(',',$ENV{'form.scantron_questions'})) {
+ ($line,$err,$errmsg)=
+ &scantron_fixup_scanline(\%scantron_config,$scan_data,$line,
+ $which,'answer',$question,
+ $ENV{"form.scantron_correct_Q_$question"});
+ if ($err) { last; }
}
}
+ if ($err) {
+ $r->print("Unable to accept last correction, an error occurred :$errmsg:");
+ } else {
+ &scantron_put_line($scanlines,$which,$line,$skip);
+ &scantron_putfile($scanlines,$scan_data);
+ }
}
+
sub scantron_validate_file {
my ($r) = @_;
my ($symb,$url)=&get_symb_and_url($r);
@@ -3409,6 +3462,7 @@ sub scantron_validate_file {
<input type="hidden" name="selectpage" value="$ENV{'form.selectpage'}" />
<input type="hidden" name="scantron_format" value="$ENV{'form.scantron_format'}" />
<input type="hidden" name="scantron_selectfile" value="$ENV{'form.scantron_selectfile'}" />
+ <input type="hidden" name="scantron_maxbubble" value="$ENV{'form.scantron_maxbubble'}" />
$default_form_data
SCANTRONFORM
$r->print($result);
@@ -3442,10 +3496,10 @@ sub scantron_getfile {
#my $scanlines=Apache::File->new($Apache::lonnet::perlvar{'lonScansDir'}."/$ENV{'form.scantron_selectfile'}");
#FIXME really would prefer a scantron directory but tokenwrapper
# doesn't allow access to subdirs of userfiles
+ my $cname=$ENV{'course.'.$ENV{'request.course.id'}.'.num'};
+ my $cdom=$ENV{'course.'.$ENV{'request.course.id'}.'.domain'};
my $lines;
- $lines=&Apache::lonnet::getfile('/uploaded/'.
- $ENV{'course.'.$ENV{'request.course.id'}.'.domain'}.'/'.
- $ENV{'course.'.$ENV{'request.course.id'}.'.num'}.'/'.
+ $lines=&Apache::lonnet::getfile('/uploaded/'.$cdom.'/'.$cname.'/'.
'scantron_orig_'.$ENV{'form.scantron_selectfile'});
if ($lines eq '-1') {
#FIXME need to actually replicate file to course space
@@ -3455,25 +3509,24 @@ sub scantron_getfile {
my $temp=$scanlines{'orig'};
$scanlines{'count'}=$#$temp;
- $lines=&Apache::lonnet::getfile('/uploaded/'.
- $ENV{'course.'.$ENV{'request.course.id'}.'.domain'}.'/'.
- $ENV{'course.'.$ENV{'request.course.id'}.'.num'}.'/'.
+ $lines=&Apache::lonnet::getfile('/uploaded/'.$cdom.'/'.$cname.'/'.
'scantron_corrected_'.$ENV{'form.scantron_selectfile'});
if ($lines eq '-1') {
$scanlines{'corrected'}=[];
} else {
$scanlines{'corrected'}=[split("\n",$lines)];
}
- $lines=&Apache::lonnet::getfile('/uploaded/'.
- $ENV{'course.'.$ENV{'request.course.id'}.'.domain'}.'/'.
- $ENV{'course.'.$ENV{'request.course.id'}.'.num'}.'/'.
+ $lines=&Apache::lonnet::getfile('/uploaded/'.$cdom.'/'.$cname.'/'.
'scantron_skipped_'.$ENV{'form.scantron_selectfile'});
if ($lines eq '-1') {
$scanlines{'skipped'}=[];
} else {
$scanlines{'skipped'}=[split("\n",$lines)];
}
- return \%scanlines;
+ my @tmp=&Apache::lonnet::dump('scantrondata',$cdom,$cname);
+ if ($tmp[0] =~ /^(error:|no_such_host)/) { @tmp=(); }
+ my %scan_data = @tmp;
+ return (\%scanlines,\%scan_data);
}
sub lonnet_putfile {
@@ -3487,13 +3540,11 @@ sub lonnet_putfile {
}
sub scantron_putfile {
- my ($scanlines) = @_;
+ my ($scanlines,$scan_data) = @_;
#FIXME really would prefer a scantron directory but tokenwrapper
# doesn't allow access to subdirs of userfiles
- my $prefix='/uploaded/'.
- $ENV{'course.'.$ENV{'request.course.id'}.'.domain'}.'/'.
- $ENV{'course.'.$ENV{'request.course.id'}.'.num'}.'/'.
- 'scantron_';
+ my $cname=$ENV{'course.'.$ENV{'request.course.id'}.'.num'};
+ my $cdom=$ENV{'course.'.$ENV{'request.course.id'}.'.domain'};
my $prefix='scantron_';
# no need to update orig, shouldn't change
# &lonnet_putfile(join("\n",@{$scanlines->{'orig'}}),$prefix.'orig_'.
@@ -3504,6 +3555,7 @@ sub scantron_putfile {
&lonnet_putfile(join("\n",@{$scanlines->{'skipped'}}),
$prefix.'skipped_'.
$ENV{'form.scantron_selectfile'});
+ &Apache::lonnet::put('scantrondata',$scan_data,$cdom,$cname);
}
sub scantron_get_line {
@@ -3528,20 +3580,22 @@ sub scantron_validate_ID {
#get scantron line setup
my %scantron_config=&get_scantron_config($ENV{'form.scantron_format'});
- my $scanlines=&scantron_getfile();
+ my ($scanlines,$scan_data)=&scantron_getfile();
my %found=('ids'=>{},'usernames'=>{});
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);
+ my $scan_record=&scantron_parse_scanline($line,$i,\%scantron_config,
+ $scan_data);
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 +3603,15 @@ sub scantron_validate_ID {
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,\%scantron_config,
+ $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,\%scantron_config,
+ $line,'incorrectID');
return(1);
}
}
@@ -3564,31 +3619,144 @@ sub scantron_validate_ID {
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,$scan_config,$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 ($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'));
+ $r->print('</li>');
+ } elsif ($error eq 'doublebubble') {
+ $r->print("There have been multiple bubbles scanned for a single question\n");
+ $r->print('<input type="hidden" name="scantron_questions" value="'.
+ join(',',@{$arg}).'" />');
+ foreach my $question (@{$arg}) {
+ my $selected=$$scan_record{"scantron.$question.answer"};
+ $r->print("<p> For question $question, selected bubbles were ".
+ join(" ",split('',$selected)).
+ " <br />Please pick which one should be used for grading<br />");
+ &scantron_bubble_selector($r,$scan_config,$question);
+ }
+ } elsif ($error eq 'missingbubble') {
+ $r->print("Some questions have no scanned bubbles\n");
+ $r->print('<input type="hidden" name="scantron_questions" value="'.
+ join(',',@{$arg}).'" />');
+ foreach my $question (@{$arg}) {
+ my $selected=$$scan_record{"scantron.$question.answer"};
+ $r->print("<p>Question $question, Please select a bubble to use ");
+ &scantron_bubble_selector($r,$scan_config,$question);
+ }
+ } else {
+ $r->print("\n<ul>");
+ }
+ $r->print("<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_bubble_selector {
+ my ($r,$scan_config,$quest)=@_;
+ my $max=$$scan_config{'Qlength'};
+ my @alphabet=('A'..'Z');
+ for (my $i=0;$i<$max;$i++) {
+ $r->print('<input type="radio" name="scantron_correct_Q_'.$quest.
+ '" value="'.$i.'" />'.$alphabet[$i]);
+ }
+ $r->print('<input type="radio" name="scantron_correct_Q_'.$quest.
+ '" value="none" /> Nothing');
+ $r->print('<br />');
+}
+
+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,$scan_data)=&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,$i,\%scantron_config,
+ $scan_data);
+ if (!defined($$scan_record{'scantron.doubleerror'})) { next; }
+ &scantron_get_correction($r,$i,$scan_record,\%scantron_config,$line,
+ 'doublebubble',
+ $$scan_record{'scantron.doubleerror'});
+ return (1,$currentphase);
+ }
+ return (0,$currentphase+1);
+}
+
+sub scantron_validate_missingbubbles {
+ 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,$scan_data)=&scantron_getfile();
+ my $max_bubble=$ENV{'form.scantron_maxbubble'};
+ if (!$max_bubble) { $max_bubble=2**31; }
+ 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,$i,\%scantron_config,
+ $scan_data);
+ if (!defined($$scan_record{'scantron.missingerror'})) { next; }
+ my @to_correct;
+ foreach my $missing (@{$$scan_record{'scantron.missingerror'}}) {
+ if ($missing gt $max_bubble) { next; }
+ push(@to_correct,$missing);
+ }
+ if (@to_correct) {
+ &scantron_get_correction($r,$i,$scan_record,\%scantron_config,
+ $line,'missingbubble',\@to_correct);
+ return (1,$currentphase);
+ }
+
+ }
+ return (0,$currentphase+1);
+}
+
sub scantron_end_validate_form {
my ($r) = @_;
$r->print('<input type="submit" name="submit" /></form></body></html>');
@@ -3602,8 +3770,7 @@ sub scantron_process_students {
my $default_form_data=&defaultFormData($symb,$url);
my %scantron_config=&get_scantron_config($ENV{'form.scantron_format'});
- my $scanlines=Apache::File->new($Apache::lonnet::perlvar{'lonScansDir'}."/$ENV{'form.scantron_selectfile'}");
- my @scanlines=<$scanlines>;
+ my ($scanlines,$scan_data)=&scantron_getfile();
my $classlist=&Apache::loncoursedata::get_classlist();
my %idmap=&username_to_idmap($classlist);
my $navmap=Apache::lonnavmaps::navmap->new($ENV{'request.course.fn'}.'.db',$ENV{'request.course.fn'}.'_parms.db',1, 1);
@@ -3620,16 +3787,19 @@ SCANTRONFORM
my @delayqueue;
my %completedstudents;
- my %prog_state=&Apache::lonhtmlcommon::Create_PrgWin($r,
- 'Scantron Status','Scantron Progress',scalar(@scanlines));
+ my %prog_state=&Apache::lonhtmlcommon::Create_PrgWin($r,'Scantron Status',
+ 'Scantron Progress',$scanlines->{'count'});
&Apache::lonhtmlcommon::Update_PrgWin($r,\%prog_state,
'Processing first student');
my $start=&Time::HiRes::time();
- foreach my $line (@scanlines) {
+ my $i=0;
+ while ($i<=$scanlines->{'count'}) {
+ $i++;
+ my $line=&scantron_get_line($scanlines,$i);
+ if (!$line) { next; }
$r->print('<pre>line is'.$line.'</pre>');
-
- chomp($line);
- my $scan_record=&scantron_parse_scanline($line,\%scantron_config);
+ my $scan_record=&scantron_parse_scanline($line,$i,\%scantron_config,
+ $scan_data);
my ($uname,$udom);
unless ($uname=&scantron_find_student($scan_record,\%idmap)) {
&scantron_add_delay(\@delayqueue,$line,
@@ -3999,6 +4169,7 @@ sub send_header {
#remotewindow.close();
#</script>");
$request->print(&Apache::loncommon::bodytag('Grading'));
+ $request->rflush();
}
sub send_footer {