--- 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 + + + + Last line to expect an answer on: + + + @@ -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:
'.$line.'
'); + substr($line,$where-1,$length)=$answer; + Apache->request->print('a:
'.$line.'
'); } 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("
Wha!!! 
".scalar(@array).
-				   '-'.$currentquest.'-'.$questnum.'

'); - } + 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 { + $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("

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; } @@ -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("

need to correct ID

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

This scantron record has an error ($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 'unknownID') { - $r->print("

Unknown ID

\n"); - } elsif ($error eq 'duplicateID') { - $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')); + 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