--- loncom/homework/grades.pm 2003/11/07 08:56:52 1.148 +++ loncom/homework/grades.pm 2004/05/10 23:18:27 1.199 @@ -1,7 +1,7 @@ # The LearningOnline Network with CAPA # The LON-CAPA Grading handler # -# $Id: grades.pm,v 1.148 2003/11/07 08:56:52 albertel Exp $ +# $Id: grades.pm,v 1.199 2004/05/10 23:18:27 albertel Exp $ # # Copyright Michigan State University Board of Trustees # @@ -48,6 +48,7 @@ use Apache::lonhomework; use Apache::loncoursedata; use Apache::lonmsg qw(:user_normal_msg); use Apache::Constants qw(:common); +use Apache::lonlocal; use String::Similarity; my %oldessays=(); @@ -88,10 +89,15 @@ sub getpartlist { # --- Get the symbolic name of a problem and the url sub get_symb_and_url { - my ($request) = @_; + my ($request,$silent) = @_; (my $url=$ENV{'form.url'}) =~ s-^http://($ENV{'SERVER_NAME'}|$ENV{'HTTP_HOST'})--; my $symb=($ENV{'form.symb'} ne '' ? $ENV{'form.symb'} : (&Apache::lonnet::symbread($url))); - if ($symb eq '') { $request->print("Unable to handle ambiguous references:$url:."); return ''; } + if ($symb eq '') { + if (!$silent) { + $request->print("Unable to handle ambiguous references:$url:."); + return (); + } + } return ($symb,$url); } @@ -132,6 +138,10 @@ sub response_type { my ($url,$symb) = shift; $symb=($ENV{'form.symb'} ne '' ? $ENV{'form.symb'} : (&Apache::lonnet::symbread($url))) if ($symb eq ''); my $allkeys = &Apache::lonnet::metadata($url,'keys'); + my %vPart; + foreach my $partid (&Apache::loncommon::get_env_multiple('form.vPart')) { + $vPart{$partid}=1; + } my %seen = (); my (@partlist,%handgrade,%responseType); foreach (split(/,/,&Apache::lonnet::metadata($url,'packages'))) { @@ -141,6 +151,9 @@ sub response_type { if (&Apache::loncommon::check_if_partid_hidden($partid,$symb)) { next; } + if (%vPart && !exists($vPart{$partid})) { + next; + } $responsetype =~ s/response$//; # make it compatible w/ navmaps - should move to that!! my ($value) = &Apache::lonnet::EXT('resource.'.$part.'.handgrade',$symb); $handgrade{$part} = ($value eq 'yes' ? 'yes' : 'no'); @@ -157,18 +170,31 @@ sub response_type { #--- Show resource title #--- and parts and response type sub showResourceInfo { - my ($url,$probTitle) = @_; + my ($url,$probTitle,$checkboxes) = @_; + my $col=3; + if ($checkboxes) { $col=4; } my $result =''. - ''."\n"; + ''."\n"; my ($partlist,$handgrade,$responseType) = &response_type($url); my %resptype = (); my $hdgrade='no'; + my %partsseen; for my $part_resID (sort keys(%$handgrade)) { my $handgrade=$$handgrade{$part_resID}; my ($partID,$resID) = split(/_/,$part_resID); my $responsetype = $responseType->{$partID}->{$resID}; $hdgrade = $handgrade if ($handgrade eq 'yes'); - $result.=''; + if ($checkboxes) { + if (exists($partsseen{$partID})) { + $result.=""; + } else { + $result.=""; + } + $partsseen{$partID}=1; + } + $result.=''. ''; # ''; @@ -189,8 +215,7 @@ sub get_order { ('grade_courseid' => $ENV{'request.course.id'}), ('grade_username' => $uname)); - (my $debug,$subresult)=split(/_HASH_REF__/,$subresult,2); - Apache->request->print($debug); + (undef,$subresult)=split(/_HASH_REF__/,$subresult,2); my %analyze=&Apache::lonnet::str2hash($subresult); return ($analyze{"$partid.$respid.shown"}); } @@ -271,7 +296,8 @@ sub cleanRecord { $ENV{'form.kwstyle'} = $keyhash{$loginuser.'_kwstyle'} ne '' ? $keyhash{$loginuser.'_kwstyle'} : ''; $ENV{'form.'.$symb} = 1; # so that we don't have to read it from disk for multiple sub of the same prob. } - return '

'.&keywords_highlight($answer).'
'; + $answer =~ s-\n-
-g; + return '

'.&keywords_highlight($answer).'
'; } return $answer; } @@ -485,7 +511,7 @@ sub verifyreceipt { my $request = shift; my $courseid = $ENV{'request.course.id'}; - my $receipt = unpack("%32C*",$Apache::lonnet::perlvar{'lonHostID'}).'-'. + my $receipt = &Apache::lonnet::recprefix($courseid).'-'. $ENV{'form.receipt'}; $receipt =~ s/[^\-\d]//g; my $url = $ENV{'form.url'}; @@ -500,18 +526,27 @@ sub verifyreceipt { my ($string,$contents,$matches) = ('','',0); my (undef,undef,$fullname) = &getclasslist('all','0'); - + + my $receiptparts=0; + if ($ENV{"course.$courseid.receiptalg"} eq 'receipt2') { $receiptparts=1; } + my $parts=['0']; + if ($receiptparts) { ($parts)=&response_type($url,$symb); } foreach (sort {lc($$fullname{$a}) cmp lc($$fullname{$b}) } keys %$fullname) { my ($uname,$udom)=split(/\:/); - if ($receipt eq - &Apache::lonnet::ireceipt($uname,$udom,$courseid,$symb)) { - $contents.=''."\n". - ''. - ''."\n"; - - $matches++; + foreach my $part (@$parts) { + if ($receipt eq &Apache::lonnet::ireceipt($uname,$udom,$courseid,$symb,$part)) { + $contents.=''."\n". + ''. + ''; + if ($receiptparts) { + $contents.=''; + } + $contents.=''."\n"; + + $matches++; + } } } if ($matches == 0) { @@ -524,8 +559,11 @@ sub verifyreceipt { '
Current Resource: '.$probTitle.'
'.&mt('Current Resource').': '. + $probTitle.'
Part '.$partID.' '. + $result.='
 Part '.$partID.' '. $resID.'Type: '.$responsetype.'
Handgrade: '.$handgrade.'
 '."\n". - ''.$$fullname{$_}.'  '.$uname.'  '.$udom.' 
 '."\n". + ''.$$fullname{$_}.'  '.$uname.'  '.$udom.'  '.$part.' 
'."\n". ''."\n". ''."\n". - ''."\n". - $contents. + ''; + if ($receiptparts) { + $string.=''; + } + $string.=''."\n".$contents. '
 Fullname  Username  Domain 
 Domain  Problem Part 
'."\n"; } return $string.&show_grading_menu_form($symb,$url); @@ -551,8 +589,7 @@ sub listStudents { my $result='

 '.$viewgrade. ' Submissions for a Student or a Group of Students

'; - my ($table,undef,$hdgrade,$partlist,$handgrade) = &showResourceInfo($url,$ENV{'form.probTitle'}); - $result.=$table; + my ($table,undef,$hdgrade,$partlist,$handgrade) = &showResourceInfo($url,$ENV{'form.probTitle'},($ENV{'form.showgrading'} eq 'yes')); $request->print(< @@ -592,7 +629,8 @@ LISTJAVASCRIPT my $checkhdgrade = ($ENV{'form.handgrade'} eq 'yes' && scalar(@$partlist) > 1 ) ? 'checked' : ''; my $checklastsub = $checkhdgrade eq '' ? 'checked' : ''; - my $gradeTable='
'."\n". + my $gradeTable=''. + "\n".$table. ' View Problem Text: no '."\n". ' one student '."\n". ' all students
'."\n". @@ -659,20 +697,25 @@ LISTJAVASCRIPT if ($ENV{'form.showgrading'} eq 'yes' && $submitonly ne 'all') { (%status) =&student_gradeStatus($url,$symb,$udom,$uname,$partlist); my $submitted = 0; - my $graded = 1; + my $graded = 0; foreach (keys(%status)) { $submitted = 1 if ($status{$_} ne 'nothing'); - $graded = 0 if ($status{$_} =~ /^correct/); + $graded = 1 if ($status{$_} !~ /^correct/); + my ($foo,$partid,$foo1) = split(/\./,$_); if ($status{'resource.'.$partid.'.submitted_by'} ne '') { $submitted = 0; + my ($part)=split(/\./,$partid); $gradeTable.=''; } } - next if (!$submitted && ($submitonly eq 'yes' || $submitonly eq 'graded')); - next if (!$graded && $submitonly eq 'graded'); + next if (!$submitted && ($submitonly eq 'yes' || + $submitonly eq 'incorrect' || + $submitonly eq 'graded')); + next if (!$graded && ($submitonly eq 'graded' || + $submitonly eq 'incorrect')); } $ctr++; @@ -712,9 +755,12 @@ LISTJAVASCRIPT if ($num_students eq 0) { $gradeTable='
 There are no students currently enrolled.'; } else { + my $submissions='submissions'; + if ($submitonly eq 'incorrect') { $submissions = 'incorrect submissions'; } + if ($submitonly eq 'graded' ) { $submissions = 'ungraded submissions'; } $gradeTable='
 '. - 'No submissions found for this resource for any students. ('.$num_students. - ' checked for submissions)
'; + 'No '.$submissions.' found for this resource for any students. ('.$num_students. + ' students checked for '.$submissions.')
'; } } elsif ($ctr == 1) { $gradeTable =~ s/type=checkbox/type=checkbox checked/; @@ -729,8 +775,7 @@ LISTJAVASCRIPT sub processGroup { my ($request) = shift; my $ctr = 0; - my @stuchecked = (ref($ENV{'form.stuinfo'}) ? @{$ENV{'form.stuinfo'}} - : ($ENV{'form.stuinfo'})); + my @stuchecked = &Apache::loncommon::get_env_multiple('form.stuinfo'); my $total = scalar(@stuchecked)-1; foreach (@stuchecked) { @@ -1250,10 +1295,10 @@ sub gradeBox { my $ctr = 0; $result.=''."\n"; # display radio buttons in a nice table 10 across while ($ctr<=$wgt) { - $result.= '\n"; + ($score eq $ctr ? 'checked':'').' /> '.$ctr."\n"; $result.=(($ctr+1)%10 == 0 ? '' : ''); $ctr++; } @@ -1353,7 +1398,9 @@ sub submission { return; } - $ENV{'form.lastSub'} = ($ENV{'form.lastSub'} eq '' ? 'datesub' : $ENV{'form.lastSub'}); + if (!$ENV{'form.lastSub'}) { $ENV{'form.lastSub'} = 'datesub'; } + if (!$ENV{'form.vProb'}) { $ENV{'form.vProb'} = 'yes'; } + if (!$ENV{'form.vAns'}) { $ENV{'form.vAns'} = 'yes'; } my $last = ($ENV{'form.lastSub'} eq 'last' ? 'last' : ''); my $checkIcon = ''; @@ -1435,6 +1482,9 @@ sub submission { ''."\n". ''."\n". ''."\n"); + foreach my $partid (&Apache::loncommon::get_env_multiple('form.vPart')) { + $request->print(''."\n"); + } } my ($cts,$prnmsg) = (1,''); @@ -1533,8 +1583,10 @@ KEYWORDS $result.=$$fullname{$_}.'     '; } $result.='
'."\n"; + my ($part)=split(/\./,$_); $result.=''."\n"; + '" value="'.$part.':'.(join ':',@goodcollaborators).'" />'. + "\n"; } if (scalar(@badcollaborators) > 0) { $result.='
'.$ctr."
\n"; - if ($$timestamp eq '') { - $lastsubonly.='\n"; + if ($$timestamp eq '') { + $lastsubonly.='
'; @@ -1560,76 +1612,77 @@ KEYWORDS # (3) Last submission plus the parts info # (4) The whole record for this student if ($ENV{'form.lastSub'} =~ /^(lastonly|hdgrade)$/) { - if ($ENV{'form.'.$uname.':'.$udom.':submitted_by'}) { - my $submitby=''. - 'Collaborative submission by: '. - ''. - $$fullname{$ENV{'form.'.$uname.':'.$udom.':submitted_by'}}.''; - $request->print($submitby); - } else { - my ($string,$timestamp)= &get_last_submission(\%record); - my $lastsubonly=''. - ($$timestamp eq '' ? '' : 'Date Submitted: '. - $$timestamp)."
'.$$string[0]; - } else { - for my $part (sort keys(%$handgrade)) { - my ($partid,$respid) = split(/_/,$part); - my $responsetype = $responseType->{$partid}->{$respid}; - if (!exists($record{'resource.'.$partid.'.'.$respid.'.submission'})) { + my ($string,$timestamp)= &get_last_submission(\%record); + my $lastsubonly=''. + ($$timestamp eq '' ? '' : 'Date Submitted: '. + $$timestamp)."
'.$$string[0]; + } else { + my %seenparts; + for my $part (sort keys(%$handgrade)) { + my ($partid,$respid) = split(/_/,$part); + if ($ENV{"form.$uname:$udom:$partid:submitted_by"}) { + if (exists($seenparts{$partid})) { next; } + $seenparts{$partid}=1; + my $submitby='Part '.$partid. + ' Collaborative submission by: '. + ''. + $$fullname{$ENV{"form.$uname:$udom:$partid:submitted_by"}}.'
'; + $request->print($submitby); + next; + } + my $responsetype = $responseType->{$partid}->{$respid}; + if (!exists($record{"resource.$partid.$respid.submission"})) { + $lastsubonly.='
Part '. + $partid.' ( ID '.$respid. + ' )   '. + 'Nothing submitted - no attempts

'; + next; + } + foreach (@$string) { + my ($partid,$respid) = /^resource\.([^\.]*)\.([^\.]*)\.submission/; + if ($part ne ($partid.'_'.$respid)) { next; } + my ($ressub,$subval) = split(/:/,$_,2); + # Similarity check + my $similar=''; + if($ENV{'form.checkPlag'}){ + my ($oname,$odom,$ocrsid,$oessay,$osim)= + &most_similar($uname,$udom,$subval); + if ($osim) { + $osim=int($osim*100.0); + $similar="

Essay". + " is $osim% similar to an essay by ". + &Apache::loncommon::plainname($oname,$odom). + '

'. + &keywords_highlight($oessay). + '

'; + } + } + my $order=&get_order($partid,$respid,$symb,$uname,$udom); + if ($ENV{'form.lastSub'} eq 'lastonly' || + ($ENV{'form.lastSub'} eq 'hdgrade' && + $$handgrade{$part} eq 'yes')) { $lastsubonly.='
Part '. $partid.' ( ID '.$respid. - ' )   '. - 'Nothing submitted - no attempts

'; - } else { - foreach (@$string) { - my ($partid,$respid) = /^resource\.([^\.]*)\.([^\.]*)\.submission/; - if ($part eq ($partid.'_'.$respid)) { - my ($ressub,$subval) = split(/:/,$_,2); - # Similarity check - my $similar=''; - my $oname; - my $odom; - my $ocrsid; - my $oessay; - my $osim; - if($ENV{'form.checkPlag'}){ - ($oname,$odom,$ocrsid,$oessay,$osim)=&most_similar($uname,$udom,$subval); - if ($osim) { - $osim=int($osim*100.0); - $similar='

Essay is '.$osim. - '% similar to an essay by '.&Apache::loncommon::plainname($oname,$odom). - '

'. - &keywords_highlight($oessay).'

'; - } - } - my $order=&get_order($partid,$respid,$symb,$uname,$udom); - $lastsubonly.='
Part '. - $partid.' ( ID '.$respid. - ' )   '. - ($record{"resource.$partid.$respid.uploadedurl"}? - ' File uploaded by student '. - 'Like all files provided by users, '. - 'this file may contain virusses
':''). - 'Submitted Answer: '. - &cleanRecord($subval,$responsetype,$symb,$partid,$respid,\%record,$order). - '

'.$similar."\n" - if ($ENV{'form.lastSub'} eq 'lastonly' || - ($ENV{'form.lastSub'} eq 'hdgrade' && - $$handgrade{$part} =~ /:yes$/)); - } + ' )   '; + if ($record{"resource.$partid.$respid.uploadedurl"}) { + &Apache::lonnet::allowuploaded('/adm/grades', + $record{"resource.$partid.$respid.uploadedurl"}); + $lastsubonly.=' File uploaded by student Like all files provided by users, this file may contain virusses
'; } + $lastsubonly.='Submitted Answer: '. + &cleanRecord($subval,$responsetype,$symb,$partid, + $respid,\%record,$order); + if ($similar) {$lastsubonly.="

$similar\n";} } } } - $lastsubonly.='
'."\n"; - $request->print($lastsubonly); } + $lastsubonly.='
'."\n"; + $request->print($lastsubonly); } elsif ($ENV{'form.lastSub'} eq 'datesub') { my (undef,$responseType,undef,$parts) = &showResourceInfo($url); $request->print(&displaySubByDates($symb,\%record,$parts,$responseType,$checkIcon,$uname,$udom)); @@ -1648,12 +1701,15 @@ KEYWORDS my $toGrade.='  '."\n" if (&canmodify($usec)); - $toGrade.='
'."\n"; - $toGrade.=&show_grading_menu_form($symb,$url) - if (($ENV{'form.command'} eq 'submission') || - ($ENV{'form.command'} eq 'processGroup' && $counter == $total)); - $request = print($toGrade); + $toGrade.=''."\n"; + if (($ENV{'form.command'} eq 'submission') || + ($ENV{'form.command'} eq 'processGroup' && $counter == $total)) { + $toGrade.=''.&show_grading_menu_form($symb,$url) + } + $request->print($toGrade); return; + } else { + $request->print(''."\n"); } # essay grading message center @@ -1805,18 +1861,21 @@ sub processHandGrade { $ENV{'form.msgsub'},$message); } if ($ENV{'form.collaborator'.$ctr}) { - my (@collaborators) = split(/:/,$ENV{'form.collaborator'.$ctr}); - foreach (@collaborators) { - my ($errorflag,$pts,$wgt) = - &saveHandGrade($request,$url,$symb,$_,$udom,$ctr,$ENV{'form.unamedom'.$ctr}); - if ($errorflag eq 'not_allowed') { - $request->print("Not allowed to modify grades for $_:$udom"); - next; - } else { - if ($message ne '') { - $msgstatus = &Apache::lonmsg::user_normal_msg ($_,$udom, - $ENV{'form.msgsub'}, - $message); + my @collabstrs=&Apache::loncommon::get_env_multiple("form.collaborator$ctr"); + foreach my $collabstr (@collabstrs) { + my ($part,@collaborators) = split(/:/,$collabstr); + foreach (@collaborators) { + my ($errorflag,$pts,$wgt) = + &saveHandGrade($request,$url,$symb,$_,$udom,$ctr, + $ENV{'form.unamedom'.$ctr},$part); + if ($errorflag eq 'not_allowed') { + $request->print("Not allowed to modify grades for $_:$udom"); + next; + } else { + if ($message ne '') { + $msgstatus = &Apache::lonmsg::user_normal_msg($_,$udom,$ENV{'form.msgsub'},$message); + } + } } } @@ -1924,7 +1983,7 @@ sub processHandGrade { foreach my $student (@parsedlist) { my $submitonly=$ENV{'form.submitonly'}; my ($uname,$udom) = split(/:/,$student); - if ($submitonly =~ /^(yes|graded)$/) { + if ($submitonly =~ /^(yes|graded|incorrect)$/) { # my %record = &Apache::lonnet::restore($symb,$ENV{'request.course.id'},$udom,$uname); my %status=&student_gradeStatus($url,$symb,$udom,$uname,$partlist); my $submitted = 0; @@ -1937,8 +1996,11 @@ sub processHandGrade { $submitted = 0; } } - next if (!$submitted && ($submitonly eq 'yes' || $submitonly eq 'graded')); - next if (!$graded && $submitonly eq 'graded'); + next if (!$submitted && ($submitonly eq 'yes' || + $submitonly eq 'incorrect' || + $submitonly eq 'graded')); + next if (!$graded && ($submitonly eq 'graded' || + $submitonly eq 'incorrect')); } push @nextlist,$student if ($ctr < $ntstu); last if ($ctr == $ntstu); @@ -1968,7 +2030,7 @@ sub processHandGrade { #---- Save the score and award for each student, if changed sub saveHandGrade { - my ($request,$url,$symb,$stuname,$domain,$newflg,$submitter) = @_; + my ($request,$url,$symb,$stuname,$domain,$newflg,$submitter,$part) = @_; my $usec = &Apache::lonnet::getsection($domain,$stuname, $ENV{'request.course.id'}); if (!&canmodify($usec)) { return('not_allowed'); } @@ -1976,6 +2038,8 @@ sub saveHandGrade { my %newrecord = (); my ($pts,$wgt) = ('',''); foreach (split(/:/,$ENV{'form.partlist'.$newflg})) { + #collaborator may vary for different parts + if ($submitter && $_ ne $part) { next; } my $dropMenu = $ENV{'form.GD_SEL'.$newflg.'_'.$_}; if ($dropMenu eq 'excused') { if ($record{'resource.'.$_.'.solved'} ne 'excused') { @@ -1987,36 +2051,46 @@ sub saveHandGrade { } } elsif ($dropMenu eq 'reset status' && exists($record{'resource.'.$_.'.solved'})) { #don't bother if no old records -> no attempts - $newrecord{'resource.'.$_.'.tries'} = 0; - $newrecord{'resource.'.$_.'.solved'} = ''; - $newrecord{'resource.'.$_.'.award'} = ''; - $newrecord{'resource.'.$_.'.awarded'} = 0; - $newrecord{'resource.'.$_.'.regrader'}="$ENV{'user.name'}:$ENV{'user.domain'}"; + foreach my $key (keys (%record)) { + if ($key=~/^resource\.\Q$_\E\./) { $newrecord{$key} = ''; } + } + $newrecord{'resource.'.$_.'.regrader'}= + "$ENV{'user.name'}:$ENV{'user.domain'}"; } elsif ($dropMenu eq '') { $pts = ($ENV{'form.GD_BOX'.$newflg.'_'.$_} ne '' ? $ENV{'form.GD_BOX'.$newflg.'_'.$_} : $ENV{'form.RADVAL'.$newflg.'_'.$_}); - return 'no_score' if ($pts eq '' && $ENV{'form.GD_SEL'.$newflg.'_'.$_} eq ''); + if ($pts eq '' && $ENV{'form.GD_SEL'.$newflg.'_'.$_} eq '') { + next; + } $wgt = $ENV{'form.WGT'.$newflg.'_'.$_} eq '' ? 1 : $ENV{'form.WGT'.$newflg.'_'.$_}; my $partial= $pts/$wgt; - next if ($partial eq $record{'resource.'.$_.'.awarded'}); #do not update score for part if not changed. - $newrecord{'resource.'.$_.'.awarded'} = $partial - if ($record{'resource.'.$_.'.awarded'} ne $partial); + if ($partial eq $record{'resource.'.$_.'.awarded'}) { + #do not update score for part if not changed. + next; + } + if ($record{'resource.'.$_.'.awarded'} ne $partial) { + $newrecord{'resource.'.$_.'.awarded'} = $partial; + } my $reckey = 'resource.'.$_.'.solved'; if ($partial == 0) { - $newrecord{$reckey} = 'incorrect_by_override' - if ($record{$reckey} ne 'incorrect_by_override'); + if ($record{$reckey} ne 'incorrect_by_override') { + $newrecord{$reckey} = 'incorrect_by_override'; + } } else { - $newrecord{$reckey} = 'correct_by_override' - if ($record{$reckey} ne 'correct_by_override'); + if ($record{$reckey} ne 'correct_by_override') { + $newrecord{$reckey} = 'correct_by_override'; + } + } + if ($submitter && + ($record{'resource.'.$_.'.submitted_by'} ne $submitter)) { + $newrecord{'resource.'.$_.'.submitted_by'} = $submitter; } - $newrecord{'resource.'.$_.'.submitted_by'} = $submitter - if ($submitter && ($record{'resource.'.$_.'.submitted_by'} ne $submitter)); - $newrecord{'resource.'.$_.'.regrader'}="$ENV{'user.name'}:$ENV{'user.domain'}"; + $newrecord{'resource.'.$_.'.regrader'}= + "$ENV{'user.name'}:$ENV{'user.domain'}"; } } - if (scalar(keys(%newrecord)) > 0) { &Apache::lonnet::cstore(\%newrecord,$symb, $ENV{'request.course.id'},$domain,$stuname); @@ -2199,8 +2273,14 @@ sub viewgrades { &viewgrades_js($request); my ($symb,$url) = ($ENV{'form.symb'},$ENV{'form.url'}); - my $result='

Manual Grading

'; + #need to make sure we have the correct data for later EXT calls, + #thus invalidate the cache + &Apache::lonnet::devalidatecourseresdata( + $ENV{'course.'.$ENV{'request.course.id'}.'.num'}, + $ENV{'course.'.$ENV{'request.course.id'}.'.domain'}); + &Apache::lonnet::clear_EXT_cache_status(); + my $result='

'.&mt('Manual Grading').'

'; $result.='Current Resource: '.$ENV{'form.probTitle'}.''."\n"; #view individual student submission form - called using Javascript viewOneStudent @@ -2796,7 +2876,9 @@ sub csvuploadassign { foreach my $grade (@gradedata) { my %entries=&Apache::loncommon::record_sep($grade); my $username=$entries{$fields{'username'}}; + $username=~s/\s//g; my $domain=$entries{$fields{'domain'}}; + $domain=~s/\s//g; if (!exists($$classlist{"$username:$domain"})) { push(@skipped,"$username:$domain"); next; @@ -2981,6 +3063,14 @@ sub displayPage { my ($classlist,undef,$fullname) = &getclasslist($getsec,'1'); my ($uname,$udom) = split(/:/,$ENV{'form.student'}); my $usec=$classlist->{$ENV{'form.student'}}[5]; + + #need to make sure we have the correct data for later EXT calls, + #thus invalidate the cache + &Apache::lonnet::devalidatecourseresdata( + $ENV{'course.'.$ENV{'request.course.id'}.'.num'}, + $ENV{'course.'.$ENV{'request.course.id'}.'.domain'}); + &Apache::lonnet::clear_EXT_cache_status(); + if (!&canview($usec)) { $request->print('Unable to view requested student.('.$ENV{'form.student'}.')'); $request->print(&show_grading_menu_form($symb,$url)); @@ -3020,7 +3110,7 @@ sub displayPage { ' Prob. '. ' '.($ENV{'form.vProb'} eq 'no' ? 'Title' : 'Problem Text').'/Grade'; - my ($depth,$question) = (1,1); + my ($depth,$question,$prob) = (1,1,1); $iterator->next(); # skip the first BEGIN_MAP my $curRes = $iterator->next(); # for "current resource" while ($depth > 0) { @@ -3031,7 +3121,7 @@ sub displayPage { my $parts = $curRes->parts(); my $title = $curRes->compTitle(); my $symbx = $curRes->symb(); - $studentTable.=''.$question. + $studentTable.=''.$prob. (scalar(@{$parts}) == 1 ? '' : '
('.scalar(@{$parts}).' parts)').''; $studentTable.=''; if ($ENV{'form.vProb'} eq 'yes' ) { @@ -3081,6 +3171,7 @@ sub displayPage { $studentTable.=''."\n"; $question++; } + $prob++; } $studentTable.=''; @@ -3123,7 +3214,8 @@ sub displaySubByDates { my @matchKey = sort(grep /^resource\.\Q$partid\E\..*?\.submission$/,@versionKeys); # next if ($$record{"$version:resource.$partid.solved"} eq ''); foreach my $matchKey (@matchKey) { - if (exists $$record{$version.':'.$matchKey}) { + if (exists($$record{$version.':'.$matchKey}) && + $$record{$version.':'.$matchKey} ne '') { my ($responseId)=($matchKey=~ /^resource\.\Q$partid\E\.(.*?)\.submission$/); $displaySub[0].='Part '.$partid.' '; $displaySub[0].='(ID '. @@ -3152,7 +3244,7 @@ sub displaySubByDates { } if (exists $$record{"$version:resource.$partid.regrader"}) { $displaySub[2].=$$record{"$version:resource.$partid.regrader"}. - ' (Part: '.$partid.')'; + ' ('.&mt('Part').': '.$partid.')'; } } # needed because old essay regrader has not parts info @@ -3207,7 +3299,7 @@ sub updateGradeByPage { $iterator->next(); # skip the first BEGIN_MAP my $curRes = $iterator->next(); # for "current resource" - my ($depth,$question,$changeflag)= (1,1,0); + my ($depth,$question,$prob,$changeflag)= (1,1,1,0); while ($depth > 0) { if($curRes == $iterator->BEGIN_MAP) { $depth++; } if($curRes == $iterator->END_MAP) { $depth--; } @@ -3216,7 +3308,7 @@ sub updateGradeByPage { my $parts = $curRes->parts(); my $title = $curRes->compTitle(); my $symbx = $curRes->symb(); - $studentTable.=''.$question. + $studentTable.=''.$prob. (scalar(@{$parts}) == 1 ? '' : '
('.scalar(@{$parts}).' parts)').''; $studentTable.=' '.$title.' '; @@ -3277,6 +3369,7 @@ sub updateGradeByPage { ''.$displayPts[1].''. ''; + $prob++; } $curRes = $iterator->next(); } @@ -3330,13 +3423,17 @@ sub getSequenceDropDown { sub scantron_uploads { if (!-e $Apache::lonnet::perlvar{'lonScansDir'}) { return ''}; my $result= '"; return $result; } @@ -3344,6 +3441,7 @@ sub scantron_uploads { sub scantron_scantab { my $fh=Apache::File->new($Apache::lonnet::perlvar{'lonTabDir'}.'/scantronformat.tab'); my $result=''.$namechoice.''; + return $namechoice; +} + +sub scantron_CODEunique { + my $result=' + Yes + + + No + '; + return $result; +} + sub scantron_selectphase { my ($r) = @_; my ($symb,$url)=&get_symb_and_url($r); @@ -3363,51 +3486,156 @@ sub scantron_selectphase { my $grading_menu_button=&show_grading_menu_form($symb,$url); my $file_selector=&scantron_uploads(); my $format_selector=&scantron_scantab(); + my $CODE_selector=&scantron_CODElist(); + my $CODE_unique=&scantron_CODEunique(); my $result; + #FIXME allow instructor to be able to download the scantron file + # and to upload it, $result.= < - - $default_form_data - +
+ +SCANTRONFORM + + $r->print($result); + + if (&Apache::lonnet::allowed('usc',$ENV{'request.role.domain'}) || + &Apache::lonnet::allowed('usc',$ENV{'request.course.id'})) { + + $r->print(< + +SCANTRONFORM + } + $r->print(< + + +SCANTRONFORM + + $r->print(< - $grading_menu_button SCANTRONFORM - return $result; + return } sub get_scantron_config { my ($which) = @_; my $fh=Apache::File->new($Apache::lonnet::perlvar{'lonTabDir'}.'/scantronformat.tab'); my %config; + #FIXME probably should move to XML it has already gotten a bit much now foreach my $line (<$fh>) { my ($name,$descrip)=split(/:/,$line); if ($name ne $which ) { next; } @@ -3424,6 +3652,12 @@ sub get_scantron_config { $config{'Qlength'}=$config[8]; $config{'Qoff'}=$config[9]; $config{'Qon'}=$config[10]; + $config{'PaperID'}=$config[11]; + $config{'PaperIDlength'}=$config[12]; + $config{'FirstName'}=$config[13]; + $config{'FirstNamelength'}=$config[14]; + $config{'LastName'}=$config[15]; + $config{'LastNamelength'}=$config[16]; last; } return %config; @@ -3439,21 +3673,99 @@ sub username_to_idmap { return %idmap; } +sub scantron_fixup_scanline { + my ($scantron_config,$scan_data,$line,$whichline,$field,$args)=@_; + if ($field eq 'ID') { + if (length($args->{'newid'}) > $$scantron_config{'IDlength'}) { + return ($line,1,'New value too large'); + } + 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'})=$args->{'newid'}; + if ($args->{'newid'}=~/^\s*$/) { + &scan_data($scan_data,"$whichline.user", + $args->{'username'}.':'.$args->{'domain'}); + } + } elsif ($field eq 'CODE') { + if ($args->{'CODE_ignore_dup'}) { + &scan_data($scan_data,"$whichline.CODE_ignore_dup",'1'); + } + &scan_data($scan_data,"$whichline.useCODE",'1'); + if ($args->{'CODE'} ne 'use_unfound') { + if (length($args->{'CODE'}) > $$scantron_config{'CODElength'}) { + return ($line,1,'New CODE value too large'); + } + if (length($args->{'CODE'}) < $$scantron_config{'CODElength'}) { + $args->{'CODE'}=sprintf('%-'.$$scantron_config{'CODElength'}.'s',$args->{'CODE'}); + } + substr($line,$$scantron_config{'CODEstart'}-1, + $$scantron_config{'CODElength'})=$args->{'CODE'}; + } + } 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,$justHeader)=@_; my %record; my $questions=substr($line,$$scantron_config{'Qstart'}-1); my $data=substr($line,0,$$scantron_config{'Qstart'}-1); if ($$scantron_config{'CODElocation'} ne 0) { if ($$scantron_config{'CODElocation'} < 0) { - $record{'scantron.CODE'}=substr($data,$$scantron_config{'CODEstart'}-1, + $record{'scantron.CODE'}=substr($data, + $$scantron_config{'CODEstart'}-1, $$scantron_config{'CODElength'}); + if (&scan_data($scan_data,"$whichline.useCODE")) { + $record{'scantron.useCODE'}=1; + } + if (&scan_data($scan_data,"$whichline.CODE_ignore_dup")) { + $record{'scantron.CODE_ignore_dup'}=1; + } } else { #FIXME interpret first N questions } } $record{'scantron.ID'}=substr($data,$$scantron_config{'IDstart'}-1, $$scantron_config{'IDlength'}); + $record{'scantron.PaperID'}= + substr($data,$$scantron_config{'PaperID'}-1, + $$scantron_config{'PaperIDlength'}); + $record{'scantron.FirstName'}= + substr($data,$$scantron_config{'FirstName'}-1, + $$scantron_config{'FirstNamelength'}); + $record{'scantron.LastName'}= + substr($data,$$scantron_config{'LastName'}-1, + $$scantron_config{'LastNamelength'}); + if ($justHeader) { return \%record; } + my @alphabet=('A'..'Z'); my $questnum=0; while ($questions) { @@ -3461,17 +3773,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 - 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; @@ -3479,7 +3799,6 @@ sub scantron_parse_scanline { sub scantron_add_delay { my ($delayqueue,$scanline,$errormessage,$errorcode)=@_; - Apache->request->print('add_delay_error '.$_[2] ); push(@$delayqueue, {'line' => $scanline, 'emsg' => $errormessage, 'ecode' => $errorcode } @@ -3487,14 +3806,15 @@ 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)) { - #Apache->request->print('success'); - return $$idmap{$id}; - } + if (lc($id) eq lc($scanID)) { + return $$idmap{$id}; + } } return undef; } @@ -3507,16 +3827,589 @@ 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) = @_; + 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'} =~ /^(duplicate|incorrect)CODE$/) { + my $resolution=$ENV{'form.scantron_CODE_resolution'}; + my $newCODE; + my %args; + if ($resolution eq 'use_unfound') { + $newCODE='use_unfound'; + } elsif ($resolution eq 'use_found') { + $newCODE=$ENV{'form.scantron_CODE_selectedvalue'}; + } elsif ($resolution eq 'use_typed') { + $newCODE=$ENV{'form.scantron_CODE_newvalue'}; + } elsif ($resolution =~ /^use_closest_(\d+)/) { + $newCODE=$ENV{"form.scantron_CODE_closest_$1"}; + } + if ($ENV{'form.scantron_corrections'} eq 'duplicateCODE') { + $args{'CODE_ignore_dup'}=1; + } + $args{'CODE'}=$newCODE; + ($line,$err,$errmsg)= + &scantron_fixup_scanline(\%scantron_config,$scan_data,$line,$which, + 'CODE',\%args); + } 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'=>$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); + if (!$symb) {return '';} + my $default_form_data=&defaultFormData($symb,$url); + if ($ENV{'form.scantron_options_ignore'} eq 'ignore_corrections') { + my $result=&scantron_remove('corrected'); + if ($result ne 'ok' && $result ne 'not_found' ) { + $r->print("An error occured ($result) when trying to Remove the existing corrections."); + } + $ENV{'form.scantron_options_ignore'}='done'; + } + if ($ENV{'form.scantron_corrections'}) { + &scantron_process_corrections($r); + } + $r->print("

Gathering neccessary info.

");$r->rflush(); + my $max_bubble=&scantron_get_maxbubble($r); + #get the student pick code ready + $r->print(&Apache::loncommon::studentbrowser_javascript()); + my $result= < + + + + + + + + + $default_form_data +SCANTRONFORM + $r->print($result); + + my @validate_phases=( 'ID', + 'CODE', + 'doublebubble', + 'missingbubbles'); + if (!$ENV{'form.validatepass'}) { + $ENV{'form.validatepass'} = 0; + } + my $currentphase=$ENV{'form.validatepass'}; + + 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); + } + } + if (!$stop) { + $r->print("Validation process complete.
"); + $r->print(''); + $r->print(''); + } else { + $r->print(''); + $r->print(""); + } + if ($stop) { + $r->print(''); + $r->print(' using corrected info
'); + $r->print(""); + $r->print(" this scanline saving it for later."); + } + $r->print("
".&show_grading_menu_form($symb,$url). + ""); + return ''; +} + +sub scantron_remove { + my ($which)=@_; + my $cname=$ENV{'course.'.$ENV{'request.course.id'}.'.num'}; + my $cdom=$ENV{'course.'.$ENV{'request.course.id'}.'.domain'}; + my $file='scantron_'; + if ($which eq 'corrected') { + $file.='corrected_'; + } else { + return 'refused'; + } + $file.=$ENV{'form.scantron_selectfile'}; + my $result=&Apache::lonnet::removeuserfile($cname,$cdom,$file); + my @keys=&Apache::lonnet::getkeys('nohist_scantrondata',$cdom,$cname); + my @todelete; + my $filename=$ENV{'form.scantron_selectfile'}; + foreach my $key (@keys) { + if ($key=~/^\Q$filename\E_/) { + push(@todelete,$key); + } + } + if (@todelete) { + &Apache::lonnet::del('nohist_scantrondata',\@todelete,$cdom,$cname); + } + return $result; +} + +sub scantron_getfile { + #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/'.$cdom.'/'.$cname.'/'. + 'scantron_orig_'.$ENV{'form.scantron_selectfile'}); + my %scanlines; + $scanlines{'orig'}=[(split("\n",$lines,-1))]; + my $temp=$scanlines{'orig'}; + $scanlines{'count'}=$#$temp; + + $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,-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,-1))]; + } + my @tmp=&Apache::lonnet::dump('nohist_scantrondata',$cdom,$cname); + if ($tmp[0] =~ /^(error:|no_such_host)/) { @tmp=(); } + my %scan_data = @tmp; + return (\%scanlines,\%scan_data); +} + +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,$scan_data) = @_; + #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 $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'}); + &Apache::lonnet::put('nohist_scantrondata',$scan_data,$cdom,$cname); +} + +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 { + 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 %found=('ids'=>{},'usernames'=>{}); + for (my $i=0;$i<=$scanlines->{'count'};$i++) { + my $line=&scantron_get_line($scanlines,$i); + if ($line=~/^[\s\cz]*$/) { next; } + my $scan_record=&scantron_parse_scanline($line,$i,\%scantron_config, + $scan_data); + my $id=$$scan_record{'scantron.ID'}; + my $found; + foreach my $checkid (keys(%idmap)) { + if (lc($checkid) eq lc($id)) { $found=$checkid;last; } + } + if ($found) { + my $username=$idmap{$found}; + if ($found{'ids'}{$found}) { + &scantron_get_correction($r,$i,$scan_record,\%scantron_config, + $line,'duplicateID',$found); + return(1,$currentphase); + } elsif ($found{'usernames'}{$username}) { + &scantron_get_correction($r,$i,$scan_record,\%scantron_config, + $line,'duplicateID',$username); + return(1,$currentphase); + } + #FIXME store away line we previously saw the ID on to use above + $found{'ids'}{$found}++; + $found{'usernames'}{$username}++; + } else { + 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,$currentphase); + } elsif (!defined($username)) { + &scantron_get_correction($r,$i,$scan_record, + \%scantron_config, + $line,'incorrectID'); + return(1,$currentphase); + } + $found{'usernames'}{$username}++; + } else { + &scantron_get_correction($r,$i,$scan_record,\%scantron_config, + $line,'incorrectID'); + return(1,$currentphase); + } + } + } + + return (0,$currentphase+1); +} + +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("

An error was detected ($error)"); + if ( defined($$scan_record{'scantron.PaperID'}) ) { + $r->print(" for PaperID ". + $$scan_record{'scantron.PaperID'}." \n"); + } else { + $r->print(" in scanline $i

".
+		  $line."
\n"); + } + $r->print(''."\n"); + $r->print(''."\n"); + if ($error =~ /ID$/) { + if ($error eq 'incorrectID') { + $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("

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

"); + $r->print("

How should I handle this?
\n"); + $r->print("\n

  • "); + #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(": "); + $r->print("\n@". + &Apache::loncommon::select_dom_form($ENV{'request.role.domain'},'scantron_domain')); + + $r->print('
  • '); + } elsif ($error =~ /CODE$/) { + if ($error eq 'incorrectCODE') { + $r->print("

    The encoded CODE is not in the list of possible CODEs

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

    The encoded CODE has also been used by a previous paper ".join(', ',@{$arg}).", and CODEs are supposed to be unique

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

    The CODE on the form is ". + $$scan_record{'scantron.CODE'}."
    \n"); + $r->print("

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

    "); + $r->print("

    How should I handle this?
    \n"); + $r->print("\n
    "); + my $i=0; + if ($error eq 'incorrectCODE') { + my ($max,$closest)=&scantron_get_closely_matching_CODEs($arg,$$scan_record{'scantron.CODE'}); + foreach my $testcode (@{$closest}) { + my $checked=''; + if (!$i) { $checked=' checked="on" '; } + $r->print(" Use the similar CODE ".$testcode." instead."); + $r->print("\n
    "); + $i++; + } + } + my $checked; if (!$i) { $checked=' checked="on" '; } + $r->print(" Use the CODE ".$$scan_record{'scantron.CODE'}." that is was on the paper, ignoring the error."); + $r->print("\n
    "); + + $r->print(< +function change_radio(field) { + var slct=document.scantronupload.scantron_CODE_resolution; + var i; + for (i=0;i +ENDSCRIPT + my $href="/adm/pickcode?". + "form=".&Apache::lonnet::escape("scantronupload"). + "&scantron_format=".&Apache::lonnet::escape($ENV{'form.scantron_format'}). + "&scantron_CODElist=".&Apache::lonnet::escape($ENV{'form.scantron_CODElist'}). + "&curCODE=".&Apache::lonnet::escape($$scan_record{'scantron.CODE'}). + "&scantron_selectfile=".&Apache::lonnet::escape($ENV{'form.scantron_selectfile'}); + $r->print(" Select a CODE from the list of all CODEs and use it. Selected CODE is "); + $r->print("\n
    "); + $r->print(" Use as the CODE."); + $r->print("\n

    "); + } elsif ($error eq 'doublebubble') { + $r->print("

    There have been multiple bubbles scanned for a some question(s)

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

    Please indicate which bubble should be used for grading

    "); + foreach my $question (@{$arg}) { + my $selected=$$scan_record{"scantron.$question.answer"}; + &scantron_bubble_selector($r,$scan_config,$question,split('',$selected)); + } + } elsif ($error eq 'missingbubble') { + $r->print("

    There have been no bubbles scanned for some question(s)

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

    Please indicate which bubble should be used for grading

    "); + $r->print("Some questions have no scanned bubbles\n"); + $r->print(''); + foreach my $question (@{$arg}) { + my $selected=$$scan_record{"scantron.$question.answer"}; + &scantron_bubble_selector($r,$scan_config,$question); + } + } else { + $r->print("\n
      "); + } + $r->print("\n
    "); + +} + +sub scantron_bubble_selector { + my ($r,$scan_config,$quest,@selected)=@_; + my $max=$$scan_config{'Qlength'}; + my @alphabet=('A'..'Z'); + $r->print("
+
+ + $default_form_data - + + + + + + + + + + + + + + + + + + +
-  Specify file location and which Folder/Sequence to grade + +  Specify file and which Folder/Sequence to grade
Sequence to grade: $sequence_selector
Filename of scoring office file: $file_selector
Format of data file: $format_selector
Saved CODEs to validate against: $CODE_selector
Each CODE is only to be used once: $CODE_unique
Options: - Sequence to grade: $sequence_selector + Do only skipped records
+ Remove any exisiting corrections
+ +
+
+
+ + +  Specify a Scantron data file to upload. + +SCANTRONFORM + my $default_form_data=&defaultFormData(&get_symb_and_url($r,1)); + my $cdom= $ENV{'course.'.$ENV{'request.course.id'}.'.domain'}; + my $cnum= $ENV{'course.'.$ENV{'request.course.id'}.'.num'}; + $r->print(< + function checkUpload(formname) { + if (formname.upfile.value == "") { + alert("Please use the browse button to select a file from your local directory."); + return false; + } + formname.submit(); + } + + +
+ $default_form_data + + + + File to upload: +
+ + +UPLOAD + + $r->print(<
- Filename of scoring office file: $file_selector -
- Format of data file: $format_selector -
+
+ + + + + + + + + + + + + + + +
+  Download a scoring office file +
Filename of scoring office file: $file_selector
+ Records to download + + Skipped Records
+ Corrected Records
+ Original Records +
+ +
+
+
"); + for (my $i=0;$i<$max+1;$i++) { + $r->print(''); + } + $r->print(''); + for (my $i=0;$i<$max;$i++) { + $r->print('"); + } + $r->print(''); + $r->print('
$quest'); + if ($selected[0] eq $alphabet[$i]) { $r->print('X'); shift(@selected) } + else { $r->print(' '); } + $r->print('
'.$alphabet[$i]." No bubble
'); +} + +sub num_matches { + my ($orig,$code) = @_; + my @code=split(//,$code); + my @orig=split(//,$orig); + my $same=0; + for (my $i=0;$i{'count'};$i++) { + my $line=&scantron_get_line($scanlines,$i); + if ($line=~/^[\s\cz]*$/) { next; } + my $scan_record=&scantron_parse_scanline($line,$i,\%scantron_config, + $scan_data); + my $CODE=$$scan_record{'scantron.CODE'}; + my $error=0; + if (!exists($allcodes{$CODE}) && !$$scan_record{'scantron.useCODE'}) { + &scantron_get_correction($r,$i,$scan_record, + \%scantron_config, + $line,'incorrectCODE',\%allcodes); + return(1,$currentphase); + } + if (exists($usedCODEs{$CODE}) && $ENV{'form.scantron_CODEunique'} + && !$$scan_record{'scantron.CODE_ignore_dup'}) { + &scantron_get_correction($r,$i,$scan_record, + \%scantron_config, + $line,'duplicateCODE',$usedCODEs{$CODE}); + return(1,$currentphase); + } + push (@{$usedCODEs{$CODE}},$$scan_record{'scantron.PaperID'}); + } + 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,$scan_data)=&scantron_getfile(); + for (my $i=0;$i<=$scanlines->{'count'};$i++) { + my $line=&scantron_get_line($scanlines,$i); + if ($line=~/^[\s\cz]*$/) { next; } + 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,\%scantron_config,$line, + 'doublebubble', + $$scan_record{'scantron.doubleerror'}); + return (1,$currentphase); + } + return (0,$currentphase+1); +} + +sub scantron_get_maxbubble { + my ($r)=@_; + if (defined($ENV{'form.scantron_maxbubble'}) && + $ENV{'form.scantron_maxbubble'}) { + return $ENV{'form.scantron_maxbubble'}; + } + my $navmap=Apache::lonnavmaps::navmap->new(); + my (undef,undef,$sequence)= + &Apache::lonnet::decode_symb($ENV{'form.selectpage'}); + my $map=$navmap->getResourceByUrl($sequence); + my @resources=$navmap->retrieveResources($map,\&scantron_filter,1,0); + &Apache::lonnet::delenv('form.counter'); + foreach my $resource (@resources) { + my $result=&Apache::lonnet::ssi($resource->src()); + } + &Apache::lonnet::delenv('scantron\.'); + my $envfile=$ENV{'user.environment'}; + $envfile=~/\/([^\/]+)\.id$/; + $envfile=$1; + &Apache::lonnet::transfer_profile_to_env($r->dir_config('lonIDsDir'), + $envfile); + $ENV{'form.scantron_maxbubble'}=$ENV{'form.counter'}-1; + return $ENV{'form.scantron_maxbubble'}; +} + +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=&scantron_get_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=~/^[\s\cz]*$/) { 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 { @@ -3527,8 +4420,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(); @@ -3545,62 +4437,51 @@ 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'}, + 'inline',undef,'scantronupload'); &Apache::lonhtmlcommon::Update_PrgWin($r,\%prog_state, 'Processing first student'); my $start=&Time::HiRes::time(); - foreach my $line (@scanlines) { - $r->print('
line is'.$line.'
'); - - chomp($line); - my $scan_record=&scantron_parse_scanline($line,\%scantron_config); - my ($uname,$udom); - unless ($uname=&scantron_find_student($scan_record,\%idmap)) { - &scantron_add_delay(\@delayqueue,$line, - 'Unable to find a student that matches',1); - next; - } - if (exists $completedstudents{$uname}) { - &scantron_add_delay(\@delayqueue,$line, - 'Student '.$uname.' has multiple sheets',2); - next; - } - $r->print('
doing studnet'.$uname.'
'); - ($uname,$udom)=split(/:/,$uname); - &Apache::lonnet::delenv('form.counter'); - &Apache::lonnet::appenv(%$scan_record); -# &Apache::lonhomework::showhash(%ENV); -# $Apache::lonxml::debug=1; -# &Apache::lonxml::debug("line is $line"); + my $i=-1; + my ($uname,$udom); + while ($i<$scanlines->{'count'}) { + ($uname,$udom)=('',''); + $i++; + my $line=&scantron_get_line($scanlines,$i); + if ($line=~/^[\s\cz]*$/) { next; } + my $scan_record=&scantron_parse_scanline($line,$i,\%scantron_config, + $scan_data); + 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; + } + if (exists $completedstudents{$uname}) { + &scantron_add_delay(\@delayqueue,$line, + 'Student '.$uname.' has multiple sheets',2); + next; + } + ($uname,$udom)=split(/:/,$uname); + &Apache::lonnet::delenv('form.counter'); + &Apache::lonnet::appenv(%$scan_record); - my $i=0; + my $i=0; foreach my $resource (@resources) { $i++; - my $result=&Apache::lonnet::ssi($resource->src(), - ('submitted' =>'scantron', - 'grade_target' =>'grade', - 'grade_username'=>$uname, - 'grade_domain' =>$udom, - 'grade_courseid'=>$ENV{'request.course.id'}, - 'grade_symb' =>$resource->symb())); -# my %score=&Apache::lonnet::restore($resource->symb(), -# $ENV{'request.course.id'}, -# $udom,$uname); -# foreach my $part ($resource->{PARTS}) { -# if ($score{'resource.'.$part.'.solved'} =~ /^correct/) { -# $studentcorrect++; -# $totalcorrect++; -# } else { -# $studentincorrect++; -# $totalincorrect++; -# } -# } -# $r->print('
'.
-#		      $resource->symb().'-'.
-#		      $resource->src().'-'.'
result is'.$result); -# &Apache::lonhomework::showhash(%score); - # if ($i eq 3) {last;} + my %form=('submitted' =>'scantron', + 'grade_target' =>'grade', + 'grade_username'=>$uname, + 'grade_domain' =>$udom, + 'grade_courseid'=>$ENV{'request.course.id'}, + 'grade_symb' =>$resource->symb()); + if (exists($scan_record->{'scantron.CODE'}) && + $scan_record->{'scantron.CODE'}) { + $form{'CODE'}=$scan_record->{'scantron.CODE'}; + } + my $result=&Apache::lonnet::ssi($resource->src(),%form); + } $completedstudents{$uname}={'line'=>$line}; } continue { @@ -3608,34 +4489,109 @@ SCANTRONFORM &Apache::lonnet::delenv('scantron\.'); &Apache::lonhtmlcommon::Increment_PrgWin($r,\%prog_state, 'last student'); - #last; - #FIXME - #get iterator for $sequence - #foreach question 'submit' the students answer to the server - # through grade target { - # generate data to pass back that includes grade recevied - #} } &Apache::lonhtmlcommon::Close_PrgWin($r,\%prog_state); - my $lasttime = &Time::HiRes::time()-$start; - $r->print("

took $lasttime

"); +# my $lasttime = &Time::HiRes::time()-$start; +# $r->print("

took $lasttime

"); - #$Apache::lonxml::debug=0; - foreach my $delay (@delayqueue) { - #FIXME - #print out each delayed student with interface to select how - # to repair student provided info - #Expected errors include - # 1 bad/no stuid/username - # 2 invalid bubblings - + $navmap->untieHashes(); + $r->print("

Done

"); + $r->print(&show_grading_menu_form($symb,$url)); + return ''; +} + +sub scantron_upload_scantron_data { + my ($r)=@_; + $r->print(&Apache::loncommon::coursebrowser_javascript($ENV{'request.role.domain'})); + my $select_link=&Apache::loncommon::selectcourse_link('rules','courseid', + 'domainid', + 'coursename'); + my $domsel=&Apache::loncommon::select_dom_form($ENV{'request.role.domain'}, + 'domainid'); + my $default_form_data=&defaultFormData(&get_symb_and_url($r,1)); + $r->print(< + function checkUpload(formname) { + if (formname.upfile.value == "") { + alert("Please use the browse button to select a file from your local directory."); + return false; + } + formname.submit(); } + + +
+$default_form_data + + + + + + +
$select_link
Course ID:
Course Name:
Domain: $domsel
File to upload:
+ + +
+UPLOAD + return ''; +} + +sub scantron_upload_scantron_data_save { + my($r)=@_; + my ($symb,$url)=&get_symb_and_url($r,1); + my $doanotherupload= + '
'."\n". + ''."\n". + ''."\n". + '
'."\n"; + if (!&Apache::lonnet::allowed('usc',$ENV{'form.domainid'}) && + !&Apache::lonnet::allowed('usc', + $ENV{'form.domainid'}.'_'.$ENV{'form.courseid'})) { + $r->print("You are not allowed to upload Scantron data to the requested course.
"); + if ($symb) { + $r->print(&show_grading_menu_form($symb,$url)); + } else { + $r->print($doanotherupload); + } + return ''; + } + $r->print("Doing upload to ".$ENV{'form.courseid'}."
"); + my $home=&Apache::lonnet::homeserver($ENV{'form.courseid'}, + $ENV{'form.domainid'}); + my $fname=$ENV{'form.upfile.filename'}; #FIXME - # if delay queue exists 2 submits one to process delayed students one - # to ignore delayed students, possibly saving the delay queue for later - - $navmap->untieHashes(); + #copied from lonnet::userfileupload() + #make that function able to target a specified course + # Replace Windows backslashes by forward slashes + $fname=~s/\\/\//g; + # Get rid of everything but the actual filename + $fname=~s/^.*\/([^\/]+)$/$1/; + # Replace spaces by underscores + $fname=~s/\s+/\_/g; + # Replace all other weird characters by nothing + $fname=~s/[^\w\.\-]//g; + # See if there is anything left + unless ($fname) { return 'error: no uploaded file'; } + $fname='scantron_orig_'.$fname; + if (length($ENV{'form.upfile'}) < 2) { + $r->print("Error: The file you attempted to upload, ".&HTML::Entities::encode($ENV{'form.upfile.filename'},'<>&"').", contained no information. Please check that you entered the correct filename."); + } else { + my $result=&Apache::lonnet::finishuserfileupload($ENV{'form.courseid'},$ENV{'form.domainid'},$home,'upfile',$fname); + if ($result =~ m|^/uploaded/|) { + $r->print("Success: Successfully uploaded ".(length($ENV{'form.upfile'})-1)." bytes of data into location ".$result.""); + } else { + $r->print("Error: An error (".$result.") occured when attempting to upload the file, ".&HTML::Entities::encode($ENV{'form.upfile.filename'},'<>&"').""); + } + } + if ($symb) { + $r->print(&show_grading_menu_form($symb,$url)); + } else { + $r->print($doanotherupload); + } + return ''; } + + #-------- end of section for handling grading scantron forms ------- # #------------------------------------------------------------------- @@ -3738,29 +4694,32 @@ GRADINGMENUJS $result.=''; $result.=''; $result.=''."\n"; @@ -3782,17 +4741,18 @@ GRADINGMENUJS $result.='
'."\n". - ' Select Section: '."\n"; if (ref($sections)) { - foreach (sort (@$sections)) {$result.=''."\n";} + foreach (sort (@$sections)) { + $result.=''."\n"; + } } $result.= '
'. ' '.'Current Resource: For one or more students '. - ''. ''. ''. + ''. '
'; $result.=''."\n"; + ''. + ' '.&mt('scores from file').' '."\n"; $result.=''."\n"; + '" value="'.&mt('Grade').'" /> scantron forms'."\n"; if ((&Apache::lonnet::allowed('mgr',$ENV{'request.course.id'})) && ($symb)) { $result.=''."\n"; } @@ -3817,14 +4777,18 @@ sub handler { &Apache::loncommon::get_unprocessed_cgi($ENV{'QUERY_STRING'}); my $url=$ENV{'form.url'}; my $symb=$ENV{'form.symb'}; - my $command=$ENV{'form.command'}; + my @commands=&Apache::loncommon::get_env_multiple('form.command'); + my $command=$commands[0]; + if ($#commands > 0) { + &Apache::lonnet::logthis("grades got multiple commands ".join(':',@commands)); + } if (!$url) { my ($temp1,$temp2); ($temp1,$temp2,$ENV{'form.url'})=&Apache::lonnet::decode_symb($symb); $url = $ENV{'form.url'}; } &send_header($request); - if ($url eq '' && $symb eq '') { + if ($url eq '' && $symb eq '' && $command eq '') { if ($ENV{'user.adv'}) { if (($ENV{'form.codeone'}) && ($ENV{'form.codetwo'}) && ($ENV{'form.codethree'})) { @@ -3865,7 +4829,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'}) { @@ -3905,12 +4868,25 @@ sub handler { } } elsif ($command eq 'scantron_selectphase' && $perm{'mgr'}) { $request->print(&scantron_selectphase($request)); + } elsif ($command eq 'scantron_validate' && $perm{'mgr'}) { + $request->print(&scantron_validate_file($request)); } elsif ($command eq 'scantron_validate' && $perm{'mgr'}) { $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'})|| + &Apache::lonnet::allowed('usc',$ENV{'request.course.id'}))) { + $request->print(&scantron_upload_scantron_data($request)); + } elsif ($command eq 'scantronupload_save' && + (&Apache::lonnet::allowed('usc',$ENV{'request.role.domain'})|| + &Apache::lonnet::allowed('usc',$ENV{'request.course.id'}))) { + $request->print(&scantron_upload_scantron_data_save($request)); + } elsif ($command eq 'scantrondownload' && + &Apache::lonnet::allowed('usc',$ENV{'request.course.id'})) { + $request->print(&scantron_download_scantron_data($request)); } elsif ($command) { - $request->print("Access Denied"); + $request->print("Access Denied ($command)"); } } &send_footer($request); @@ -3926,6 +4902,7 @@ sub send_header { #remotewindow.close(); #"); $request->print(&Apache::loncommon::bodytag('Grading')); + $request->rflush(); } sub send_footer {
'. - ''. - ' scores from file
'. ' scantron forms
'. - ''. - ' submission Receipt no: '.unpack("%32C*",$Apache::lonnet::perlvar{'lonHostID'}). + ''. + ' '.&mt('receipt').': '. + &Apache::lonnet::recprefix($ENV{'request.course.id'}). '-'. '