[LON-CAPA-cvs] cvs: loncom(version_1_0_2_scantron) /homework grades.pm
albertel
lon-capa-cvs@mail.lon-capa.org
Mon, 29 Sep 2003 20:58:50 -0000
This is a MIME encoded message
--albertel1064869130
Content-Type: text/plain
albertel Mon Sep 29 16:58:50 2003 EDT
Modified files: (Branch: version_1_0_2_scantron)
/loncom/homework grades.pm
Log:
- double bubble correction working
- missing bubble detection/correction working
- creates database scantrondata in course directory
--albertel1064869130
Content-Type: text/plain
Content-Disposition: attachment; filename="albertel-20030929165850.txt"
Index: loncom/homework/grades.pm
diff -u loncom/homework/grades.pm:1.130.2.1.2.4 loncom/homework/grades.pm:1.130.2.1.2.5
--- loncom/homework/grades.pm:1.130.2.1.2.4 Fri Sep 26 21:59:10 2003
+++ loncom/homework/grades.pm Mon Sep 29 16:58:50 2003
@@ -1,7 +1,7 @@
# The LearningOnline Network with CAPA
# The LON-CAPA Grading handler
#
-# $Id: grades.pm,v 1.130.2.1.2.4 2003/09/27 01:59:10 albertel Exp $
+# $Id: grades.pm,v 1.130.2.1.2.5 2003/09/29 20:58:50 albertel Exp $
#
# Copyright Michigan State University Board of Trustees
#
@@ -3214,6 +3214,13 @@
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 scantron_fixup_scanline {
- my ($scantron_config,$line,$field,$newvalue) = @_;
+ my ($scantron_config,$scan_data,$line,$field,$newvalue,$arg) = @_;
if ($field eq 'ID') {
if ($newvalue > $$scantron_config{'IDlength'}) {
return ($line,1,'New value to large');
@@ -3280,12 +3287,38 @@
}
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 ne 'none') {
+ substr($answer,$arg,1)=$on;
+ &scan_data($scan_data,"no_bubble.$newvalue",undef,'1');
+ } else {
+ &scan_data($scan_data,"no_bubble.$newvalue",'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,$scantron_config,$scan_data)=@_;
my %record;
my $questions=substr($line,$$scantron_config{'Qstart'}-1);
my $data=substr($line,0,$$scantron_config{'Qstart'}-1);
@@ -3315,19 +3348,23 @@
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);
+ 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,"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'}},$currentquest);
+ 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);
}
}
}
@@ -3375,31 +3412,39 @@
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 ($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];
+ 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,$err,$errmsg)=
+ &scantron_fixup_scanline(\%scantron_config,$scan_data,$line,'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,$line,'ID',$newid);
- }
- if ($err) {
- $r->print("Unable to accept last correction, an error occurred :$errmsg:");
- } else {
- &scantron_put_line($scanlines,$which,$line,$skip);
- &scantron_putfile($scanlines);
+ &scantron_fixup_scanline(\%scantron_config,$scan_data,$line,
+ '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);
@@ -3417,6 +3462,7 @@
<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);
@@ -3450,10 +3496,10 @@
#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
@@ -3463,25 +3509,24 @@
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 {
@@ -3495,13 +3540,11 @@
}
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_'.
@@ -3512,6 +3555,7 @@
&lonnet_putfile(join("\n",@{$scanlines->{'skipped'}}),
$prefix.'skipped_'.
$ENV{'form.scantron_selectfile'});
+ &Apache::lonnet::put('scantrondata',$scan_data,$cdom,$cname);
}
sub scantron_get_line {
@@ -3536,13 +3580,13 @@
#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,\%scantron_config,$scan_data);
my $id=$$scan_record{'scantron.ID'};
$r->print("<p>Checking ID ".$$scan_record{'scantron.ID'}.
" on paper ID ".$$scan_record{'scantron.PaperID'}."</p>\n");
@@ -3558,15 +3602,15 @@
if ($found) {
if ($found{'ids'}{$found}) {
#FIXME store away line we prviously saw the ID on
- &scantron_get_correction($r,$i,$scan_record,$line,
- 'duplicateID',$found);
+ &scantron_get_correction($r,$i,$scan_record,\%scantron_config,
+ $line,'duplicateID',$found);
return(1);
} else {
$found{'ids'}{$found}++;
}
} else {
- &scantron_get_correction($r,$i,$scan_record,$line,
- 'incorrectID');
+ &scantron_get_correction($r,$i,$scan_record,\%scantron_config,
+ $line,'incorrectID');
return(1);
}
}
@@ -3575,13 +3619,13 @@
}
sub scantron_get_correction {
- my ($r,$i,$scan_record,$line,$error,$arg)=@_;
+ 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.");
+ $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");
@@ -3609,22 +3653,48 @@
#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 muttiple bubbles scanned for a single question\n");
+ $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".
+ $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
-
+ " <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> <li>Skip this scanline saving it for later ");
+ $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
@@ -3639,19 +3709,51 @@
#get scantron line setup
my %scantron_config=&get_scantron_config($ENV{'form.scantron_format'});
- my $scanlines=&scantron_getfile();
+ 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,\%scantron_config);
+ my $scan_record=&scantron_parse_scanline($line,\%scantron_config,$scan_data);
if (!defined($$scan_record{'scantron.doubleerror'})) { next; }
- &scantron_get_correction($r,$i,$scan_record,$line,'double',
+ &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,\%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>');
@@ -3665,8 +3767,7 @@
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);
@@ -3683,16 +3784,18 @@
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,\%scantron_config,$scan_data);
my ($uname,$udom);
unless ($uname=&scantron_find_student($scan_record,\%idmap)) {
&scantron_add_delay(\@delayqueue,$line,
--albertel1064869130--