[LON-CAPA-cvs] cvs: loncom(version_1_0_2_scantron) /homework grades.pm
albertel
lon-capa-cvs@mail.lon-capa.org
Tue, 30 Sep 2003 06:35:20 -0000
This is a MIME encoded message
--albertel1064903720
Content-Type: text/plain
albertel Tue Sep 30 02:35:20 2003 EDT
Modified files: (Branch: version_1_0_2_scantron)
/loncom/homework grades.pm
Log:
- seems to almost work, graded the PHY232 Quiz with it
- now handles cases where ID number on paper, but no id number in the classlist for the correct user
- removed some FIXMES where it is now fixed
--albertel1064903720
Content-Type: text/plain
Content-Disposition: attachment; filename="albertel-20030930023520.txt"
Index: loncom/homework/grades.pm
diff -u loncom/homework/grades.pm:1.130.2.1.2.6 loncom/homework/grades.pm:1.130.2.1.2.7
--- loncom/homework/grades.pm:1.130.2.1.2.6 Mon Sep 29 17:31:30 2003
+++ loncom/homework/grades.pm Tue Sep 30 02:35:20 2003
@@ -1,7 +1,7 @@
# The LearningOnline Network with CAPA
# The LON-CAPA Grading handler
#
-# $Id: grades.pm,v 1.130.2.1.2.6 2003/09/29 21:31:30 albertel Exp $
+# $Id: grades.pm,v 1.130.2.1.2.7 2003/09/30 06:35:20 albertel Exp $
#
# Copyright Michigan State University Board of Trustees
#
@@ -3276,33 +3276,36 @@
}
sub scantron_fixup_scanline {
- my ($scantron_config,$scan_data,$line,$whichline,$field,$newvalue,$arg)=@_;
+ my ($scantron_config,$scan_data,$line,$whichline,$field,$args)=@_;
if ($field eq 'ID') {
- if ($newvalue > $$scantron_config{'IDlength'}) {
+ if (length($args->{'newid'}) > $$scantron_config{'IDlength'}) {
return ($line,1,'New value to large');
}
- if ($newvalue < $$scantron_config{'IDlength'}) {
- $newvalue=sprintf('%-'.$$scantron_config{'IDlength'}.'s',
- $newvalue);
+ if (length($args->{'newid'}) < $$scantron_config{'IDlength'}) {
+ $args->{'newid'}=sprintf('%-'.$$scantron_config{'IDlength'}.'s',
+ $args->{'newid'});
}
substr($line,$$scantron_config{'IDstart'}-1,
- $$scantron_config{'IDlength'})=$newvalue;
+ $$scantron_config{'IDlength'})=$args->{'newid'};
+ if ($args->{'newid'}=~/^\s*$/) {
+ &scan_data($scan_data,"$whichline.user",
+ $args->{'username'}.':'.$args->{'domain'});
+ }
} 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');
+ if ($args->{'response'} eq 'none') {
+ &scan_data($scan_data,
+ "$whichline.no_bubble.".$args->{'question'},'1');
} else {
- substr($answer,$arg,1)=$on;
- &scan_data($scan_data,"$whichline.no_bubble.$newvalue",undef,'1');
+ substr($answer,$args->{'response'},1)=$on;
+ &scan_data($scan_data,
+ "$whichline.no_bubble.".$args->{'question'},undef,'1');
}
- my $where=$length*($newvalue-1)+$scantron_config->{'Qstart'};
- Apache->request->print("where $where arg $arg ");
- Apache->request->print('b:<pre>'.$line.'</pre>');
+ my $where=$length*($args->{'question'}-1)+$scantron_config->{'Qstart'};
substr($line,$where-1,$length)=$answer;
- Apache->request->print('a:<pre>'.$line.'</pre>');
}
return $line;
}
@@ -3358,10 +3361,11 @@
$record{"scantron.$questnum.answer"}=$alphabet[length($array[0])];
}
if (scalar(@array) gt 2) {
+ Apache->request->print("snippet is <pre>$currentquest</pre>");
push(@{$record{'scantron.doubleerror'}},$questnum);
my @ans=@array;
my $i=length($ans[0]);shift(@ans);
- while (@ans) {
+ while ($#ans) {
$i+=length($ans[0])+1;
$record{"scantron.$questnum.answer"}.=$alphabet[$i];
shift(@ans);
@@ -3382,8 +3386,11 @@
}
sub scantron_find_student {
- my ($scantron_record,$idmap)=@_;
+ my ($scantron_record,$scan_data,$idmap,$line)=@_;
my $scanID=$$scantron_record{'scantron.ID'};
+ if ($scanID =~ /^\s*$/) {
+ return &scan_data($scan_data,"$line.user");
+ }
foreach my $id (keys(%$idmap)) {
#Apache->request->print('<pre>checking studnet -'.$id.'- againt -'.$scanID.'- </pre>');
if (lc($id) eq lc($scanID)) {
@@ -3402,14 +3409,6 @@
return 0;
}
-#FIXME I think I am doing this in the wrong order, I think it would be
-#better to make a several passes analyzing all of the lines in the
-#file for common errors wrong/invalid PID/username duplicated
-#PID/username, missing bubbles, double bubbles, missing/invalid CODE
-#and then get the instructor to fix all of these errors, then grade
-#the corrected one, I'll still need to catch error conditions, but
-#maybe most will taken care even before we start
-
sub scantron_process_corrections {
my ($r) = @_;
my %scantron_config=&get_scantron_config($ENV{'form.scantron_format'});
@@ -3426,13 +3425,16 @@
my $newid=$classlist->{$newstudent}->[&Apache::loncoursedata::CL_ID];
($line,$err,$errmsg)=
&scantron_fixup_scanline(\%scantron_config,$scan_data,$line,$which,
- 'ID',$newid);
+ 'ID',{'newid'=>$newid,
+ 'username'=>$ENV{'form.scantron_username'},
+ 'domain'=>$ENV{'form.scantron_domain'}});
} 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"});
+ $which,'answer',
+ { 'question'=>$question,
+ 'response'=>$ENV{"form.scantron_correct_Q_$question"}});
if ($err) { last; }
}
}
@@ -3458,7 +3460,6 @@
$r->print(&Apache::loncommon::studentbrowser_javascript());
my $result= <<SCANTRONFORM;
<form method="post" enctype="multipart/form-data" action="/adm/grades" name="scantronupload">
- <input type="hidden" name="command" value="scantron_validate" />
<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'}" />
@@ -3482,18 +3483,26 @@
}
my $stop=0;
while (!$stop && $currentphase < scalar(@validate_phases)) {
+ $r->print("<p> Validating ".$validate_phases[$currentphase]."</p>");
+ $r->rflush();
my $which="scantron_validate_".$validate_phases[$currentphase];
{
no strict 'refs';
($stop,$currentphase)=&$which($r,$currentphase);
}
}
- $r->print("<input type='hidden' name='validatepass' value='".$currentphase."' />");
+ if (!$stop) {
+ $r->print("Validation process complete, click 'Submit' to start proccssing");
+ $r->print('<input type="hidden" name="command" value="scantron_process" />');
+ } else {
+ $r->print('<input type="hidden" name="command" value="scantron_validate" />');
+ $r->print("<input type='hidden' name='validatepass' value='".$currentphase."' />");
+ }
+ $r->print('<input type="submit" name="submit" /></form></body></html>');
return '';
}
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'};
@@ -3502,10 +3511,11 @@
$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
+ #FIXME need to actually replicate file to course space
+ #FIXME when replicating strip CRLF to LF or CR to LF
}
my %scanlines;
- $scanlines{'orig'}=[split("\n",$lines)];
+ $scanlines{'orig'}=[(split("\n",$lines,-1))];
my $temp=$scanlines{'orig'};
$scanlines{'count'}=$#$temp;
@@ -3514,14 +3524,14 @@
if ($lines eq '-1') {
$scanlines{'corrected'}=[];
} else {
- $scanlines{'corrected'}=[split("\n",$lines)];
+ $scanlines{'corrected'}=[(split("\n",$lines,-1))];
}
$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)];
+ $scanlines{'skipped'}=[(split("\n",$lines,-1))];
}
my @tmp=&Apache::lonnet::dump('scantrondata',$cdom,$cname);
if ($tmp[0] =~ /^(error:|no_such_host)/) { @tmp=(); }
@@ -3567,7 +3577,10 @@
sub scantron_put_line {
my ($scanlines,$i,$newline,$skip)=@_;
- if ($skip) { $scanlines->{'skipped'}[$i]=$newline;return; }
+ if ($skip) {
+ $scanlines->{'skipped'}[$i]=$newline;
+ return;
+ }
$scanlines->{'corrected'}[$i]=$newline;
}
@@ -3589,30 +3602,51 @@
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'}.
- " on paper ID ".$$scan_record{'scantron.PaperID'}."</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 encoded $id</p>\n");
+ #$r->print("<p>Using $checkid for encoded $id</p>\n");
}
$found=$checkid;last;
}
}
if ($found) {
+ my $username=$idmap{$found};
if ($found{'ids'}{$found}) {
- #FIXME store away line we prviously saw the ID on
&scantron_get_correction($r,$i,$scan_record,\%scantron_config,
$line,'duplicateID',$found);
return(1);
- } else {
- $found{'ids'}{$found}++;
+ } elsif ($found{'usernames'}{$username}) {
+ &scantron_get_correction($r,$i,$scan_record,\%scantron_config,
+ $line,'duplicateID',$username);
+ return(1);
}
+ #FIXME store away line we prviously saw the ID on to use above
+ $found{'ids'}{$found}++;
+ $found{'usernames'}{$username}++;
} else {
- &scantron_get_correction($r,$i,$scan_record,\%scantron_config,
- $line,'incorrectID');
- return(1);
+ if ($id =~ /^\s*$/) {
+ my $username=&scan_data($scan_data,"$i.user");
+ if (defined($username) && $found{'usernames'}{$username}) {
+ &scantron_get_correction($r,$i,$scan_record,
+ \%scantron_config,
+ $line,'duplicateID',$username);
+ return(1);
+ } elsif (!defined($username)) {
+ &scantron_get_correction($r,$i,$scan_record,
+ \%scantron_config,
+ $line,'incorrectID');
+ return(1);
+ }
+ $found{'usernames'}{$username}++;
+ } else {
+ &scantron_get_correction($r,$i,$scan_record,\%scantron_config,
+ $line,'incorrectID');
+ return(1);
+ }
}
}
@@ -3656,13 +3690,17 @@
'scantron_username','scantron_domain'));
$r->print('</li>');
} elsif ($error eq 'doublebubble') {
+ $r->print("<pre>$line</pre>");
+ $Apache::lonxml::debug=1;
+ &Apache::lonhomework::showhashsubset($scan_record,'.');
+ $Apache::lonxml::debug=0;
$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)).
+ join(" ",split('',$selected,-1)).
" <br />Please pick which one should be used for grading<br />");
&scantron_bubble_selector($r,$scan_config,$question);
}
@@ -3680,7 +3718,6 @@
}
$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 {
@@ -3744,7 +3781,7 @@
if (!defined($$scan_record{'scantron.missingerror'})) { next; }
my @to_correct;
foreach my $missing (@{$$scan_record{'scantron.missingerror'}}) {
- if ($missing gt $max_bubble) { next; }
+ if ($missing > $max_bubble) { next; }
push(@to_correct,$missing);
}
if (@to_correct) {
@@ -3757,11 +3794,6 @@
return (0,$currentphase+1);
}
-sub scantron_end_validate_form {
- my ($r) = @_;
- $r->print('<input type="submit" name="submit" /></form></body></html>');
-}
-
sub scantron_process_students {
my ($r) = @_;
my (undef,undef,$sequence)=split(/___/,$ENV{'form.selectpage'});
@@ -3792,16 +3824,20 @@
&Apache::lonhtmlcommon::Update_PrgWin($r,\%prog_state,
'Processing first student');
my $start=&Time::HiRes::time();
- my $i=0;
- while ($i<=$scanlines->{'count'}) {
+ my $i=-1;
+ while ($i<$scanlines->{'count'}) {
$i++;
my $line=&scantron_get_line($scanlines,$i);
- if (!$line) { next; }
$r->print('<pre>line is'.$line.'</pre>');
+ if (!defined($line)) {
+ $r->print('skipping');
+ next;
+ }
my $scan_record=&scantron_parse_scanline($line,$i,\%scantron_config,
$scan_data);
my ($uname,$udom);
- unless ($uname=&scantron_find_student($scan_record,\%idmap)) {
+ unless ($uname=&scantron_find_student($scan_record,$scan_data,
+ \%idmap,$i)) {
&scantron_add_delay(\@delayqueue,$line,
'Unable to find a student that matches',1);
next;
--albertel1064903720--