--- loncom/homework/grades.pm 2003/09/25 02:46:19 1.130.2.1.2.2
+++ loncom/homework/grades.pm 2003/09/25 08:30:57 1.130.2.1.2.3
@@ -1,7 +1,7 @@
# The LearningOnline Network with CAPA
# The LON-CAPA Grading handler
#
-# $Id: grades.pm,v 1.130.2.1.2.2 2003/09/25 02:46:19 albertel Exp $
+# $Id: grades.pm,v 1.130.2.1.2.3 2003/09/25 08:30:57 albertel Exp $
#
# Copyright Michigan State University Board of Trustees
#
@@ -3268,6 +3268,22 @@ sub username_to_idmap {
return %idmap;
}
+sub scantron_fixup_scanline {
+ my ($scantron_config,$line,$field,$newvalue) = @_;
+ if ($field eq 'ID') {
+ if ($newvalue > $$scantron_config{'IDlength'}) {
+ return ($line,1,'New value to large');
+ }
+ if ($newvalue < $$scantron_config{'IDlength'}) {
+ $newvalue=sprintf('%-'.$$scantron_config{'IDlength'}.'s',
+ $newvalue);
+ }
+ substr($line,$$scantron_config{'IDstart'}-1,
+ $$scantron_config{'IDlength'})=$newvalue;
+ }
+ return $line;
+}
+
sub scantron_parse_scanline {
my ($line,$scantron_config)=@_;
my %record;
@@ -3354,6 +3370,28 @@ sub scantron_filter {
#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) = @_;
+ 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 $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);
+ }
+ }
+}
+
sub scantron_validate_file {
my ($r) = @_;
my ($symb,$url)=&get_symb_and_url($r);
@@ -3397,6 +3435,88 @@ SCANTRONFORM
}
}
$r->print("");
+ 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 $lines;
+ $lines=&Apache::lonnet::getfile('/uploaded/'.
+ $ENV{'course.'.$ENV{'request.course.id'}.'.domain'}.'/'.
+ $ENV{'course.'.$ENV{'request.course.id'}.'.num'}.'/'.
+ 'scantron_orig_'.$ENV{'form.scantron_selectfile'});
+ if ($lines eq '-1') {
+ #FIXME need to actually replicate file to course space
+ }
+ my %scanlines;
+ $scanlines{'orig'}=[split("\n",$lines)];
+ 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'}.'/'.
+ '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'}.'/'.
+ 'scantron_skipped_'.$ENV{'form.scantron_selectfile'});
+ if ($lines eq '-1') {
+ $scanlines{'skipped'}=[];
+ } else {
+ $scanlines{'skipped'}=[split("\n",$lines)];
+ }
+ return \%scanlines;
+}
+
+sub lonnet_putfile {
+ my ($contents,$filename)=@_;
+ my $docuname=$ENV{'course.'.$ENV{'request.course.id'}.'.num'};
+ my $docudom=$ENV{'course.'.$ENV{'request.course.id'}.'.domain'};
+ my $docuhome=$ENV{'course.'.$ENV{'request.course.id'}.'.home'};
+ $ENV{'form.sillywaytopassafilearound'}=$contents;
+ &Apache::lonnet::finishuserfileupload($docuname,$docudom,$docuhome,'sillywaytopassafilearound',$filename);
+
+}
+
+sub scantron_putfile {
+ my ($scanlines) = @_;
+ #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 $prefix='scantron_';
+# no need to update orig, shouldn't change
+# &lonnet_putfile(join("\n",@{$scanlines->{'orig'}}),$prefix.'orig_'.
+# $ENV{'form.scantron_selectfile'});
+ &lonnet_putfile(join("\n",@{$scanlines->{'corrected'}}),
+ $prefix.'corrected_'.
+ $ENV{'form.scantron_selectfile'});
+ &lonnet_putfile(join("\n",@{$scanlines->{'skipped'}}),
+ $prefix.'skipped_'.
+ $ENV{'form.scantron_selectfile'});
+}
+
+sub scantron_get_line {
+ my ($scanlines,$i)=@_;
+ if ($scanlines->{'skipped'}[$i]) {return undef;}
+ if ($scanlines->{'corrected'}[$i]) {return $scanlines->{'corrected'}[$i];}
+ return $scanlines->{'orig'}[$i];
+}
+
+sub scantron_put_line {
+ my ($scanlines,$i,$newline,$skip)=@_;
+ if ($skip) { $scanlines->{'skipped'}[$i]=$newline;return; }
+ $scanlines->{'corrected'}[$i]=$newline;
}
sub scantron_validate_ID {
@@ -3408,18 +3528,12 @@ sub scantron_validate_ID {
#get scantron line setup
my %scantron_config=&get_scantron_config($ENV{'form.scantron_format'});
- #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 $scanlines=&Apache::lonnet::getfile('/uploaded/'.
- $ENV{'course.'.$ENV{'request.course.id'}.'.domain'}.'/'.
- $ENV{'course.'.$ENV{'request.course.id'}.'.num'}.'/'.
- 'scantron_'.$ENV{'form.scantron_selectfile'});
-
- my @scanlines=split("\n",$scanlines);
+ my $scanlines=&scantron_getfile();
my %found=('ids'=>{},'usernames'=>{});
- foreach my $line (@scanlines) {
+ 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 $id=$$scan_record{'scantron.ID'};
$r->print("
Checking ID ".$$scan_record{'scantron.ID'}."
\n");
@@ -3434,13 +3548,15 @@ sub scantron_validate_ID {
}
if ($found) {
if ($found{'ids'}{$found}) {
- &scantron_get_ID_correction($r,$line,$scan_record,'duplicate',$found);
+ #FIXME store away line we prviously saw the ID on
+ &scantron_get_ID_correction($r,$i,$scan_record,
+ 'duplicateID',$found);
return(1);
} else {
$found{'ids'}{$found}++;
}
} else {
- &scantron_get_ID_correction($r,$line,$scan_record,'incorrect');
+ &scantron_get_ID_correction($r,$i,$scan_record,'incorrectID');
return(1);
}
}
@@ -3449,13 +3565,14 @@ sub scantron_validate_ID {
}
sub scantron_get_ID_correction {
- my ($r,$line,$scan_record,$error,$arg)=@_;
+ 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("
need to correct ID
\n");
$r->print(''."\n");
- $r->print(''."\n");
- if ($error eq 'unknown') {
+ $r->print(''."\n");
+ if ($error eq 'unknownID') {
$r->print("