--- loncom/homework/grades.pm 2003/09/27 01:59:10 1.130.2.1.2.4 +++ loncom/homework/grades.pm 2003/10/13 22:36:59 1.130.2.1.2.8 @@ -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.8 2003/10/13 22:36:59 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,23 +3276,52 @@ sub username_to_idmap { } sub scantron_fixup_scanline { - my ($scantron_config,$line,$field,$newvalue) = @_; + 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 ($args->{'response'} eq 'none') { + &scan_data($scan_data, + "$whichline.no_bubble.".$args->{'question'},'1'); + } else { + substr($answer,$args->{'response'},1)=$on; + &scan_data($scan_data, + "$whichline.no_bubble.".$args->{'question'},undef,'1'); + } + my $where=$length*($args->{'question'}-1)+$scantron_config->{'Qstart'}; + substr($line,$where-1,$length)=$answer; } 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); @@ -3315,19 +3351,24 @@ 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); + 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'}},$currentquest); + Apache->request->print("snippet is 
$currentquest
"); + 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); } } } @@ -3345,8 +3386,11 @@ sub scantron_add_delay { } 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('
checking studnet -'.$id.'- againt -'.$scanID.'-
'); if (lc($id) eq lc($scanID)) { @@ -3365,41 +3409,44 @@ sub scantron_filter { 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) = @_; - 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,$which, + '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,$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, + $which,'answer', + { 'question'=>$question, + 'response'=>$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); @@ -3413,10 +3460,10 @@ sub scantron_validate_file { $r->print(&Apache::loncommon::studentbrowser_javascript()); my $result= < - + $default_form_data SCANTRONFORM $r->print($result); @@ -3436,52 +3483,60 @@ SCANTRONFORM } my $stop=0; while (!$stop && $currentphase < scalar(@validate_phases)) { + $r->print("

Validating ".$validate_phases[$currentphase]."

"); + $r->rflush(); my $which="scantron_validate_".$validate_phases[$currentphase]; { no strict 'refs'; ($stop,$currentphase)=&$which($r,$currentphase); } } - $r->print(""); + if (!$stop) { + $r->print("Validation process complete, click 'Submit' to start proccssing"); + $r->print(''); + } else { + $r->print(''); + $r->print(""); + } + $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 $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 + #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; - $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)]; + $scanlines{'corrected'}=[(split("\n",$lines,-1))]; } - $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)]; + $scanlines{'skipped'}=[(split("\n",$lines,-1))]; } - 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 +3550,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_'. @@ -3512,6 +3565,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 { @@ -3523,7 +3577,10 @@ sub scantron_get_line { 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; } @@ -3536,38 +3593,60 @@ 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'}. - " on paper ID ".$$scan_record{'scantron.PaperID'}."

\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 encoded $id

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

Using $checkid for encoded $id

\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,$line, - 'duplicateID',$found); + &scantron_get_correction($r,$i,$scan_record,\%scantron_config, + $line,'duplicateID',$found); + return(1); + } elsif ($found{'usernames'}{$username}) { + &scantron_get_correction($r,$i,$scan_record,\%scantron_config, + $line,'duplicateID',$username); return(1); - } else { - $found{'ids'}{$found}++; } + #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,$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); + } } } @@ -3575,13 +3654,13 @@ sub scantron_validate_ID { } 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("

This scantron record has an error."); + $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"); @@ -3609,20 +3688,49 @@ sub scantron_get_correction { #could do partial userID matches $r->print(&Apache::loncommon::selectstudent_link('scantronupload', 'scantron_username','scantron_domain')); + $r->print(''); } elsif ($error eq 'doublebubble') { - $r->print("There have been muttiple bubbles scanned for a single question\n"); + $r->print("

$line
"); + $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(''); foreach my $question (@{$arg}) { my $selected=$$scan_record{"scantron.$question.answer"}; - $r->print("

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 - + $r->print("

For question $question, selected bubbles were ". + join(" ",split('',$selected,-1)). + "
Please pick which one should be used for grading
"); + &scantron_bubble_selector($r,$scan_config,$question); + } + } elsif ($error eq 'missingbubble') { + $r->print("Some questions have no scanned bubbles\n"); + $r->print(''); + foreach my $question (@{$arg}) { + my $selected=$$scan_record{"scantron.$question.answer"}; + $r->print("

Question $question, Please select a bubble to use "); + &scantron_bubble_selector($r,$scan_config,$question); } + } else { + $r->print("\n

"); - &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(''.$alphabet[$i]); + } + $r->print(' Nothing'); + $r->print('
'); } sub scantron_validate_CODE { @@ -3639,22 +3747,51 @@ sub scantron_validate_doublebubble { #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,$i,\%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_end_validate_form { - my ($r) = @_; - $r->print(''); +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,$i,\%scantron_config, + $scan_data); + if (!defined($$scan_record{'scantron.missingerror'})) { next; } + my @to_correct; + foreach my $missing (@{$$scan_record{'scantron.missingerror'}}) { + if ($missing > $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_process_students { @@ -3665,8 +3802,7 @@ sub scantron_process_students { 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,18 +3819,25 @@ SCANTRONFORM 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=-1; + while ($i<$scanlines->{'count'}) { + $i++; + my $line=&scantron_get_line($scanlines,$i); $r->print('
line is'.$line.'
'); - - chomp($line); - my $scan_record=&scantron_parse_scanline($line,\%scantron_config); + 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; @@ -3774,6 +3917,18 @@ SCANTRONFORM $navmap->untieHashes(); } + +sub scantron_upload_scantron_data { + my ($r)=@_; + $r->print(&Apache::loncommon::coursebrowser_javascript($ENV{'request.role.domain'})); + $r->print(&Apache::loncommon::selectcourse_link('rules', + 'courseid','domain')); + $r->print("Course: "); + $r->print("Domain: "); + + return ''; + +} #-------- end of section for handling grading scantron forms ------- # #------------------------------------------------------------------- @@ -4001,7 +4156,6 @@ sub handler { delete($perm{'mgr'}); } } - if ($command eq 'submission' && $perm{'vgr'}) { ($ENV{'form.student'} eq '' ? &listStudents($request) : &submission($request,0,0)); } elsif ($command eq 'pickStudentPage' && $perm{'vgr'}) { @@ -4045,6 +4199,8 @@ sub handler { $request->print(&scantron_validate_file($request)); } elsif ($command eq 'scantron_process' && $perm{'mgr'}) { $request->print(&scantron_process_students($request)); + } elsif ($command eq 'scantronupload' && &Apache::lonnet::allowed('usc',$ENV{'request.role.domain'})) { + $request->print(&scantron_upload_scantron_data($request)); } elsif ($command) { $request->print("Access Denied"); } @@ -4062,6 +4218,7 @@ sub send_header { #remotewindow.close(); #"); $request->print(&Apache::loncommon::bodytag('Grading')); + $request->rflush(); } sub send_footer {