--- loncom/homework/grades.pm 2003/09/25 02:46:19 1.130.2.1.2.2 +++ loncom/homework/grades.pm 2003/09/27 01:59:10 1.130.2.1.2.4 @@ -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.4 2003/09/27 01:59:10 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; @@ -3283,7 +3299,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'}= @@ -3300,17 +3316,20 @@ sub scantron_parse_scanline { 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("
Wha!!! 
".scalar(@array).
-				   '-'.$currentquest.'-'.$questnum.'

'); - } 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; @@ -3354,6 +3373,33 @@ 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 ($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,$skip); + &scantron_putfile($scanlines); + } + } +} + sub scantron_validate_file { my ($r) = @_; my ($symb,$url)=&get_symb_and_url($r); @@ -3397,6 +3443,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,39 +3536,37 @@ 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"); + $r->print("

Checking ID ".$$scan_record{'scantron.ID'}. + " on paper ID ".$$scan_record{'scantron.PaperID'}."

\n"); my $found; foreach my $checkid (keys(%idmap)) { if (lc($checkid) eq lc($id)) { if ($checkid ne $id) { - $r->print("

Using $checkid for bubbled $id

\n"); + $r->print("

Using $checkid for encoded $id

\n"); } $found=$checkid;last; } } 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_correction($r,$i,$scan_record,$line, + 'duplicateID',$found); return(1); } else { $found{'ids'}{$found}++; } } else { - &scantron_get_ID_correction($r,$line,$scan_record,'incorrect'); + &scantron_get_correction($r,$i,$scan_record,$line, + 'incorrectID'); return(1); } } @@ -3448,30 +3574,84 @@ sub scantron_validate_ID { return (0,$currentphase+1); } -sub scantron_get_ID_correction { - my ($r,$line,$scan_record,$error,$arg)=@_; - $r->print("

need to correct ID

\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("

This scantron record has an error."); + if ( defined($$scan_record{'scantron.PaperID'}) ) { + $r->print("The current PaperID is ". + $$scan_record{'scantron.PaperID'}." \n"); + } else { + $r->print("The current scanline is 

".
+		  $line."
\n"); + } $r->print(''."\n"); - $r->print(''."\n"); - if ($error eq 'unknown') { - $r->print("

Unknown ID

\n"); - } elsif ($error eq 'duplicate') { - $r->print("

Duplicated ID

\n"); - } - $r->print("

Original ID is ".$$scan_record{'scantron.ID'}."

\n"); - $r->print("

Name on paper is ".$$scan_record{'scantron.LastName'}.",". - $$scan_record{'scantron.FirstName'}."

"); - $r->print("Corrected User -- "); - $r->print("\nusername:"); - $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(''."\n"); + if ($error =~ /ID$/) { + if ($error eq 'unknownID') { + $r->print("The encoded ID is not in the classlist

\n"); + } elsif ($error eq 'duplicateID') { + $r->print("The encoded ID has also been used by a previous paper $arg

\n"); + } + $r->print("

Original ID is ".$$scan_record{'scantron.ID'}. + "
\n"); + $r->print("Name on paper is ".$$scan_record{'scantron.LastName'}.",". + $$scan_record{'scantron.FirstName'}."

"); + $r->print("

Please correct
\n"); + $r->print("\n

"); &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 { my ($r) = @_; $r->print('');