--- loncom/homework/grades.pm 2003/07/23 18:04:51 1.124 +++ loncom/homework/grades.pm 2003/09/29 20:58:50 1.130.2.1.2.5 @@ -1,7 +1,7 @@ # The LearningOnline Network with CAPA # The LON-CAPA Grading handler # -# $Id: grades.pm,v 1.124 2003/07/23 18:04:51 ng Exp $ +# $Id: grades.pm,v 1.130.2.1.2.5 2003/09/29 20:58:50 albertel Exp $ # # Copyright Michigan State University Board of Trustees # @@ -33,6 +33,7 @@ # June-August H.K. Ng # Year 2003 # February, March H.K. Ng +# July, H. K. Ng # package Apache::grades; @@ -95,10 +96,23 @@ sub get_fullname { return $fullname; } +#--- Format fullname, username:domain if different for display +#--- Use anywhere where the student names are listed +sub nameUserString { + my ($type,$fullname,$uname,$udom) = @_; + if ($type eq 'header') { + return ' Fullname (Username) '; + } else { + return ' '.$fullname.' ('.$uname. + ($ENV{'user.domain'} eq $udom ? '' : ' ('.$udom.')').')'; + } +} + #--- Get the partlist and the response type for a given problem. --- #--- Indicate if a response type is coded handgraded or not. --- sub response_type { - my ($url) = shift; + 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 %seen = (); my (@partlist,%handgrade); @@ -107,7 +121,8 @@ sub response_type { my ($responsetype,$part) = split(/_/,$_,2); my ($partid,$respid) = split(/_/,$part); $responsetype =~ s/response$//; # make it compatible w/ navmaps - should move to that!! - $handgrade{$part} = $responsetype.':'.($allkeys =~ /parameter_$part\_handgrade/ ? 'yes' : 'no'); + my ($value) = &Apache::lonnet::EXT('resource.'.$part.'.handgrade',$symb); + $handgrade{$part} = $responsetype.':'.($value eq 'yes' ? 'yes' : 'no'); next if ($seen{$partid} > 0); $seen{$partid}++; push @partlist,$partid; @@ -123,7 +138,7 @@ sub showResourceInfo { my $result =''. ''."\n"; my ($partlist,$handgrade) = &response_type($url); - my %resptype = (); #,$hdgrade)=('','no'); + my %resptype = (); my $hdgrade='no'; for (sort keys(%$handgrade)) { my ($responsetype,$handgrade)=split(/:/,$$handgrade{$_}); @@ -150,12 +165,12 @@ sub cleanRecord { push @ans,$ans; } my $grayFont = ''; - return '
Current Resource: '.$probTitle.'
'. + return '
'. ''. ''. - '
Answer'. (join '',@ans).'
'.$grayFont.'Option ID'.$grayFont. (join ''.$grayFont,@IDs).'
'; + ''; } if ($response eq 'essay') { if (! exists ($ENV{'form.'.$symb})) { @@ -170,7 +185,7 @@ 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); + return '

'.&keywords_highlight($answer).'
'; } return $answer; } @@ -295,7 +310,7 @@ sub student_gradeStatus { my %record = &Apache::lonnet::restore($symb,$ENV{'request.course.id'},$udom,$uname); my %partstatus = (); foreach (@$partlist) { - my ($status,$foo) = split(/_/,$record{"resource.$_.solved"},2); + my ($status,undef) = split(/_/,$record{"resource.$_.solved"},2); $status = 'nothing' if ($status eq ''); $partstatus{$_} = $status; my $subkey = "resource.$_.submitted_by"; @@ -321,6 +336,7 @@ sub jscriptNform { ''."\n". ''."\n". ''."\n". + ''."\n". ''."\n". ''."\n". ''."\n". @@ -470,7 +486,7 @@ sub listStudents { sense = "the student"; } if (ctr == 0) { - alert("Please select "+sense+" before clicking on the $viewgrade button."); + alert("Please select "+sense+" before clicking on the Next button."); return false; } document.gradesub.submit(); @@ -522,27 +538,27 @@ LISTJAVASCRIPT &Apache::lonhtmlcommon::StatusOptions($saveStatus,undef,1,'javascript:reLoadList(this.form);').'
'; } - $gradeTable.='To '.lc($viewgrade).' a submission, click on the check box next to the student\'s name. Then '."\n". - 'click on the '.$viewgrade.' button. To view the submissions for a group of students, click'."\n". - ' on the check boxes for the group of students.
'."\n". + $gradeTable.='To '.lc($viewgrade).' a submission or a group of submissions, click on the check box(es) '. + 'next to the student\'s name(s). Then click on the Next button.
'."\n". ''."\n"; $gradeTable.=''."\n"; + 'value="Next->" />'."\n"; my (undef, undef, $fullname) = &getclasslist($getsec,'1'); $gradeTable.='
'. ''; my $loop = 0; while ($loop < 2) { - $gradeTable.=''; + $gradeTable.=''. + ''; if ($ENV{'form.showgrading'} eq 'yes' && $submitonly ne 'all') { foreach (sort(@$partlist)) { $gradeTable.=''; } } $loop++; +# $gradeTable.='' if ($loop%2 ==1); } $gradeTable.=''."\n"; @@ -569,10 +585,10 @@ LISTJAVASCRIPT $ctr++; if ( $perm{'vgr'} eq 'F' ) { $gradeTable.='' if ($ctr%2 ==1); - $gradeTable.=''. + ''."\n". - ''."\n"; + ''."\n"; if ($ENV{'form.showgrading'} eq 'yes' && $submitonly ne 'all') { foreach (sort keys(%status)) { @@ -580,11 +596,12 @@ LISTJAVASCRIPT $gradeTable.=''."\n"; } } +# $gradeTable.='' if ($ctr%2 ==1); $gradeTable.=''."\n" if ($ctr%2 ==0); } } if ($ctr%2 ==1) { - $gradeTable.=''; + $gradeTable.=''; if ($ENV{'form.showgrading'} eq 'yes' && $submitonly ne 'all') { foreach (@$partlist) { $gradeTable.=''; @@ -596,7 +613,7 @@ LISTJAVASCRIPT $gradeTable.='
 Select  Fullname '. - '(Username)  No.  Select '.&nameUserString('header').' Part '.(split(/_/))[0].' Status 
'.$ctr.'  '.$$fullname{$student}.' '."\n". - '('.$uname.')'.&nameUserString(undef,$$fullname{$student},$uname,$udom).' '.$status{$_}.' 
      
'. ''."\n"; + 'value="Next->" />'."\n"; if ($ctr == 0) { my $num_students=(scalar(keys(%$fullname))); if ($num_students eq 0) { @@ -645,9 +662,9 @@ sub sub_page_js { $request->print(< function updateRadio(formname,id,weight) { - var gradeBox = eval("formname.GD_BOX"+id); - var radioButton = eval("formname.RADVAL"+id); - var oldpts = eval("formname.oldpts"+id+".value"); + var gradeBox = formname["GD_BOX"+id]; + var radioButton = formname["RADVAL"+id]; + var oldpts = formname["oldpts"+id].value; var pts = checkSolved(formname,id) == 'update' ? gradeBox.value : oldpts; gradeBox.value = pts; var resetbox = false; @@ -669,7 +686,7 @@ sub sub_page_js { var resp = confirm("You entered a value ("+pts+ ") greater than the weight for the part. Accept?"); if (resp == false) { - gradeBox.value = ""; + gradeBox.value = oldpts; return; } } @@ -681,18 +698,17 @@ sub sub_page_js { } } updateSelect(formname,id); - var stores = eval("formname.stores"+id); - stores.value = "0"; + formname["stores"+id].value = "0"; } function writeBox(formname,id,pts) { - var gradeBox = eval("formname.GD_BOX"+id); + var gradeBox = formname["GD_BOX"+id]; if (checkSolved(formname,id) == 'update') { gradeBox.value = pts; } else { - var oldpts = eval("formname.oldpts"+id+".value"); + var oldpts = formname["oldpts"+id].value; gradeBox.value = oldpts; - var radioButton = eval("formname.RADVAL"+id); + var radioButton = formname["RADVAL"+id]; for (var i=0; i"); pDoc.write("Message Central"); @@ -947,7 +958,7 @@ sub sub_page_kw_js { pDoc.write(" opener.document.SCORE.msgsub.value = opener.checkEntities(document.msgcenter.msgsub.value);"); pDoc.write(" var nmsg = opener.document.SCORE.savemsgN.value;"); pDoc.write(" var usrctr = document.msgcenter.usrctr.value;"); - pDoc.write(" var newval = eval(\\"opener.document.SCORE.newmsg\\"+usrctr);"); + pDoc.write(" var newval = opener.document.SCORE[\\"newmsg\\"+usrctr];"); pDoc.write(" newval.value = opener.checkEntities(document.msgcenter.newmsg.value);"); pDoc.write(" var msgchk = \\"\\";"); @@ -956,12 +967,12 @@ sub sub_page_kw_js { pDoc.write(" }"); pDoc.write(" var includemsg = 0;"); pDoc.write(" for (var i=1; i<=nmsg; i++) {"); - pDoc.write(" var opnmsg = eval(\\"opener.document.SCORE.savemsg\\"+i);"); - pDoc.write(" var frmmsg = eval(\\"document.msgcenter.msg\\"+i);"); + pDoc.write(" var opnmsg = opener.document.SCORE[\\"savemsg\\"+i];"); + pDoc.write(" var frmmsg = document.msgcenter[\\"msg\\"+i];"); pDoc.write(" opnmsg.value = opener.checkEntities(frmmsg.value);"); - pDoc.write(" var showflg = eval(\\"opener.document.SCORE.shownOnce\\"+i);"); + pDoc.write(" var showflg = opener.document.SCORE[\\"shownOnce\\"+i];"); pDoc.write(" showflg.value = \\"1\\";"); - pDoc.write(" var chkbox = eval(\\"document.msgcenter.msgn\\"+i);"); + pDoc.write(" var chkbox = document.msgcenter[\\"msgn\\"+i];"); pDoc.write(" if (chkbox.checked) {"); pDoc.write(" msgchk += \\"savemsg\\"+i+\\",\\";"); pDoc.write(" includemsg = 1;"); @@ -971,9 +982,9 @@ sub sub_page_kw_js { pDoc.write(" msgchk += \\"newmsg\\"+usrctr;"); pDoc.write(" includemsg = 1;"); pDoc.write(" }"); - pDoc.write(" imgformname = eval(\\"opener.document.SCORE.mailicon\\"+usrctr);"); + pDoc.write(" imgformname = opener.document.SCORE[\\"mailicon\\"+usrctr];"); pDoc.write(" imgformname.src = \\"$iconpath/\\"+((includemsg) ? \\"mailto.gif\\" : \\"mailbkgrd.gif\\");"); - pDoc.write(" var includemsg = eval(\\"opener.document.SCORE.includemsg\\"+usrctr);"); + pDoc.write(" var includemsg = opener.document.SCORE[\\"includemsg\\"+usrctr];"); pDoc.write(" includemsg.value = msgchk;"); pDoc.write(" self.close()"); @@ -1025,6 +1036,7 @@ sub sub_page_kw_js { pDoc.write("

"); pDoc.write(""); pDoc.write(""); + pDoc.close(); } //====================== Script for keyword highlight options ============== @@ -1068,6 +1080,7 @@ sub sub_page_kw_js { hwdWin = window.open('', 'KeywordHighlightCentral', 'toolbar=no,location=no,scrollbars=no,width=400,height=300,screenx='+xpos+',screeny='+ypos); hwdWin.focus(); var hDoc = hwdWin.document; + hDoc.open('text/html','replace'); hDoc.write(""); hDoc.write("Highlight Central"); @@ -1116,6 +1129,7 @@ sub sub_page_kw_js { hDoc.write("

"); hDoc.write(""); hDoc.write(""); + hDoc.close(); } @@ -1165,11 +1179,12 @@ sub gradeBox { 'onChange="javascript:clearRadBox(this.form,\''.$counter.'_'.$partid.'\')" >'."\n"; if ($$record{'resource.'.$partid.'.solved'} eq 'excused') { $result.=''. - ''."\n"; + ''; } else { $result.=''. - ''."\n"; + ''; } + $result.=''."\n"; $result.="  \n"; $result.=''."\n". ''."\n". @@ -1340,16 +1355,15 @@ KEYWORDS $request->print(&show_problem($request,$symb,$uname,$udom,1,1)); } my %record = &Apache::lonnet::restore($symb,$ENV{'request.course.id'},$udom,$uname); - my ($partlist,$handgrade) = &response_type($url); + + my ($partlist,$handgrade) = &response_type($url,$symb); # Display student info $request->print(($counter == 0 ? '' : '
')); my $result=''."\n"; @@ -2186,14 +2199,13 @@ sub viewstudentgrade { $status = 'nothing' if ($status eq ''); $result.=''."\n"; - $result.='\n"; + $result.= (($status eq 'excused') ? '' + : '')."\n"; + $result.=''; + $result.=" \n"; } else { $result.=''. @@ -2217,9 +2229,11 @@ sub editgrades { my $title='

Current Grade Status

'; $title.='Current Resource: '.$ENV{'form.probTitle'}.'
'."\n"; $title.='Section: '.$ENV{'form.section'}.''."\n"; + my $result= '
'."\n". '
'."\n"; - $result.='Fullname: '.$ENV{'form.fullname'}. - '   Username: '.$uname. - ($ENV{'user.domain'} eq $udom ? '' : ' ('.$udom.')').'
'."\n"; + $result.='Fullname: '.&nameUserString(undef,$ENV{'form.fullname'},$uname,$udom).'
'."\n"; $result.=''."\n"; @@ -1438,7 +1452,8 @@ KEYWORDS if (!exists($record{'resource.'.$partid.'.'.$respid.'.submission'})) { $lastsubonly.='
Part '. $partid.' ( ID '.$respid. - ' )   Nothing submitted - no attempts

'; + ' )   '. + 'Nothing submitted - no attempts

'; } else { foreach (@$string) { my ($partid,$respid) = /^resource\.(\w+)\.(\w+)\.submission/; @@ -1463,12 +1478,9 @@ KEYWORDS '"> File uploaded by student '. 'Like all files provided by users, '. 'this file may contain virusses
':''). - 'Submitted Answer: '.($responsetype =~ /^(essay|option)$/ ? - '
' : ''). -# &cleanRecord(&keywords_highlight($subval),$responsetype). + 'Submitted Answer: '. &cleanRecord($subval,$responsetype,$symb). - ($responsetype =~ /^(essay|option)$/ ? '

' : - '

').$similar."\n" + '

'.$similar."\n" if ($ENV{'form.lastSub'} eq 'lastonly' || ($ENV{'form.lastSub'} eq 'hdgrade' && $$handgrade{$part} =~ /:yes$/)); @@ -1515,7 +1527,6 @@ KEYWORDS $msgfor .= ', '.(join ', ',@col_fullnames).' and '.$lastone.'.'; } $msgfor =~ s/\'/\\'/g; #' stupid emacs - no! javascript -# $result.='
'."\n". $result=''."\n". ''."\n"; $result.=' '."\n"; + $result.=''."\n" if ($counter == 0); my $ctr = 0; while ($ctr < scalar(@partlist)) { $result.='$nsel  '."\n". - '  '; - $endform.='(Next and Previous do not save the scores.)'."\n" ; + $endform.='  '."\n". + '  '; + $endform.='(Next and Previous (student) do not save the scores.)'."\n" ; $endform.='
'; $endform.=&show_grading_menu_form($symb,$url); $request->print($endform); @@ -1596,7 +1611,7 @@ sub get_last_submission { } } } - @string = $string[0] eq '' ? 'Nothing submitted - no attempts.' : @string; + @string = $string[0] eq '' ? 'Nothing submitted - no attempts.' : @string; return \@string,\$timestamp; } @@ -1766,21 +1781,19 @@ sub processHandGrade { } } $ctr = 0; - my ($partlist,$handgrade) = &response_type($ENV{'form.url'}); @parsedlist = reverse @parsedlist if ($button eq 'Previous'); foreach my $student (@parsedlist) { my ($uname,$udom) = split(/:/,$student); if ($ENV{'form.submitonly'} eq 'yes') { - my (%status) = &student_gradeStatus($ENV{'form.url'},$symb,$udom,$uname,$partlist) ; + my %record = &Apache::lonnet::restore($symb,$ENV{'request.course.id'},$udom,$uname); my $statusflg = ''; - foreach (keys(%status)) { - $statusflg = 1 if ($status{$_} ne 'nothing'); - my ($foo,$partid,$foo1) = split(/\./); - $statusflg = '' if ($status{'resource.'.$partid.'.submitted_by'} ne ''); + foreach (split(/:/,$ENV{'form.gradePartRespid'})){ + $statusflg = 1 if (exists ($record{'resource.'.$_.'.submission'})); } next if ($statusflg eq ''); } push @nextlist,$student if ($ctr < $ntstu); + last if ($ctr == $ntstu); $ctr++; } @@ -1815,14 +1828,23 @@ sub saveHandGrade { my %newrecord = (); my ($pts,$wgt) = ('',''); foreach (split(/:/,$ENV{'form.partlist'.$newflg})) { - if ($ENV{'form.GD_SEL'.$newflg.'_'.$_} eq 'excused') { + my $dropMenu = $ENV{'form.GD_SEL'.$newflg.'_'.$_}; + if ($dropMenu eq 'excused') { if ($record{'resource.'.$_.'.solved'} ne 'excused') { $newrecord{'resource.'.$_.'.solved'} = 'excused'; if (exists($record{'resource.'.$_.'.awarded'})) { $newrecord{'resource.'.$_.'.awarded'} = ''; } + $newrecord{'resource.'.$_.'.regrader'}="$ENV{'user.name'}:$ENV{'user.domain'}"; } - } else { + } 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'}"; + } elsif ($dropMenu eq '') { $pts = ($ENV{'form.GD_BOX'.$newflg.'_'.$_} ne '' ? $ENV{'form.GD_BOX'.$newflg.'_'.$_} : $ENV{'form.RADVAL'.$newflg.'_'.$_}); @@ -1865,10 +1887,10 @@ sub viewgrades_js { $request->print(< function writePoint(partid,weight,point) { - var radioButton = eval("document.classgrade.RADVAL_"+partid); - var textbox = eval("document.classgrade.TEXTVAL_"+partid); + var radioButton = document.classgrade["RADVAL_"+partid]; + var textbox = document.classgrade["TEXTVAL_"+partid]; if (point == "textval") { - var point = eval("document.classgrade.TEXTVAL_"+partid+".value"); + point = document.classgrade["TEXTVAL_"+partid].value; if (isNaN(point) || parseFloat(point) < 0) { alert("A number equal or greater than 0 is expected. Entered value = "+parseFloat(point)); var resetbox = false; @@ -1899,15 +1921,13 @@ sub viewgrades_js { } } else { - textbox.value = point; + textbox.value = parseFloat(point); } for (i=0;i'."\n". ''."\n". ''."\n". + ''."\n". ''."\n"; - $result.='

Assign Common Grade To '; + my $sectionClass; if ($ENV{'form.section'} eq 'all') { - $result.='Class

'; + $sectionClass='Class '; } elsif ($ENV{'form.section'} eq 'no') { - $result.='Students in no Section '; + $sectionClass='Students in no Section '; } else { - $result.='Students in Section '.$ENV{'form.section'}.''; + $sectionClass='Students in Section '.$ENV{'form.section'}.''; } + $result.='

Assign Common Grade To '.$sectionClass; $result.= '
'."\n". '
'; #radio buttons/text box for assigning points for a section or class. #handles different parts of a problem - my ($partlist,$handgrade) = &response_type($ENV{'form.url'}); + my ($partlist,$handgrade) = &response_type($url,$symb); my %weight = (); my $ctsparts = 0; $result.=''; @@ -2098,7 +2117,8 @@ sub viewgrades { 'onChange="javascript:writeRadText(\''.$partid.'\','. $weight{$partid}.')"> '. ''. - ''."\n"; + ''. + ''."\n"; $ctsparts++; } $result.='
'.'
'.'
'."\n". @@ -2108,21 +2128,14 @@ sub viewgrades { #table listing all the students in a section/class #header of table - $result.= '

Assign Grade to Specific Students in '; - if ($ENV{'form.section'} eq 'all') { - $result.='the Class

'; - } elsif ($ENV{'form.section'} eq 'no') { - $result.='no Section '; - } else { - $result.='Section '.$ENV{'form.section'}.''; - } + $result.= '

Assign Grade to Specific Students in '.$sectionClass; $result.= '
'."\n". - ''. - ''."\n"; + '
Fullname (Username)
'. + '\n"; my (@parts) = sort(&getpartlist($url)); foreach my $part (@parts) { my $display=&Apache::lonnet::metadata($url,$part.'.display'); - $display =~ s/^Number of Attempts/Tries/; # makes the column narrower + $display =~ s|^Number of Attempts|Tries
|; # makes the column narrower if (!$display) { $display = &Apache::lonnet::metadata($url,$part.'.name'); } if ($display =~ /^Partial Credit Factor/) { my ($partid) = &split_part_type($part); @@ -2143,13 +2156,13 @@ sub viewgrades { my $uname = $_; $uname=~s/:/_/; $result.=''."\n"; - $result.=&viewstudentgrade($url,$symb,$ENV{'request.course.id'}, - $_,$$fullname{$_},\@parts,\%weight); $ctr++; + $result.=&viewstudentgrade($url,$symb,$ENV{'request.course.id'}, + $_,$$fullname{$_},\@parts,\%weight,$ctr); } $result.='
 No. '.&nameUserString('header')."
'; $result.=''."\n"; - $result.=''."\n"; if (scalar(%$fullname) eq 0) { my $colspan=3+scalar(@parts); @@ -2162,11 +2175,11 @@ sub viewgrades { #--- call by previous routine to display each student sub viewstudentgrade { - my ($url,$symb,$courseid,$student,$fullname,$parts,$weight) = @_; + my ($url,$symb,$courseid,$student,$fullname,$parts,$weight,$ctr) = @_; my ($uname,$udom) = split(/:/,$student); $student=~s/:/_/; my %record=&Apache::lonnet::restore($symb,$courseid,$udom,$uname); - my $result='

'. + my $result='
'.$ctr.'  '. ''.$fullname.' '. '('.$uname.($ENV{'user.domain'} eq $udom ? '' : ':'.$udom).')'."\n"; - my $optsel = ''."\n"; - $optsel = ''."\n" - if ($status eq 'excused'); - $result.=$optsel; - $result.="
'."\n"; $result.= ''. - ''."\n"; + ''. + '\n"; my %scoreptr = ( 'correct' =>'correct_by_override', @@ -2253,8 +2267,9 @@ sub editgrades { if ($type eq 'awarded' || $type eq 'solved') { next; } my $display=&Apache::lonnet::metadata($url,$stores.'.display'); $display =~ s/\[Part: (\w)+\]//; - $header .= ''. - ''; + $display =~ s/Number of Attempts/Tries/; + $header .= ''. + ''; $columns{$partid}+=2; } } @@ -2268,6 +2283,7 @@ sub editgrades { $result .= $header; $result .= ''."\n"; my $noupdate; + my ($updateCtr,$noupdateCtr) = (1,1); for ($i=0; $i<$ENV{'form.total'}; $i++) { my $line; my $user = $ENV{'form.ctr'.$i}; @@ -2276,12 +2292,10 @@ sub editgrades { my ($uname,$udom)=split(/_/,$user); my %newrecord; my $updateflag = 0; - $line .= ''; + $line .= ''; my $usec=$classlist->{"$uname:$udom"}[5]; if (!&canmodify($usec)) { - my $numcols=scalar(@partid)*(scalar(@parts)-1)*2; + my $numcols=scalar(@partid)*4+2; $noupdate.=$line.""; next; } @@ -2302,8 +2316,19 @@ sub editgrades { } elsif ($partial == 0) { $score = 'incorrect_by_override'; } - $score = 'excused' if (($ENV{'form.GD_'.$user.'_'.$_.'_solved'} eq 'excused') && - ($score ne 'excused')); + my $dropMenu = $ENV{'form.GD_'.$user.'_'.$_.'_solved'}; + $score = 'excused' if (($dropMenu eq 'excused') && ($score ne 'excused')); + + if ($dropMenu eq 'reset status' && + $old_score ne '') { # ignore if no previous attempts => nothing to reset + $newrecord{'resource.'.$_.'.tries'} = 0; + $newrecord{'resource.'.$_.'.solved'} = ''; + $newrecord{'resource.'.$_.'.award'} = ''; + $newrecord{'resource.'.$_.'.awarded'} = 0; + $newrecord{'resource.'.$_.'.regrader'}="$ENV{'user.name'}:$ENV{'user.domain'}"; + $updateflag = 1; + } + $line .= ''. ''; @@ -2336,18 +2361,21 @@ sub editgrades { $count++; &Apache::lonnet::cstore(\%newrecord,$symb,$ENV{'request.course.id'}, $udom,$uname); - $result.=$line; + $result.=''.$line; + $updateCtr++; } else { - $noupdate.=$line; + $noupdate.=''.$line; + $noupdateCtr++; } } if ($noupdate) { - my $numcols=(scalar(@partid)*(scalar(@parts)-1)*2)+3; - $result .= ''.$noupdate; +# my $numcols=(scalar(@partid)*(scalar(@parts)-1)*2)+3; + my $numcols=scalar(@partid)*4+2; + $result .= ''.$noupdate; } $result .= '
UsernameDomainFullname No. '.&nameUserString('header')." Old '.$display.'  New '.$display.'  Old '.$display.'  New '.$display.' 
'.$uname.' '. - $udom.' '. - $$fullname{$usercolon}.' '.&nameUserString(undef,$$fullname{$usercolon},$uname,$udom).'Not allowed to modify student
'.$old_aw.' '.$awarded. ($score eq 'excused' ? $score : '').' 
 '.$updateCtr.' 
 '.$noupdateCtr.' 
No Changes Occured For the Students Below
No Changes Occurred For the Students Below
'."\n". &show_grading_menu_form ($symb,$url); - my $msg = 'Number of records updated = '.$rec_update. + my $msg = '
Number of records updated = '.$rec_update. ' for '.$count.' student'.($count <= 1 ? '' : 's').'.
'. 'Total number of students = '.$ENV{'form.total'}.'
'; return $title.$msg.$result; @@ -2482,7 +2510,6 @@ to this page if the data selected is ins $javascript ENDPICK - $request->print(&show_grading_menu_form($symb,$url)); return ''; } @@ -2679,9 +2706,9 @@ function checkPickOne(formname) { alert("Please select the student you wish to grade."); return; } - var ptr = pullDownSelection(formname.selectpage); - formname.page.value = eval("formname.page"+ptr+".value"); - formname.title.value = eval("formname.title"+ptr+".value"); + ptr = pullDownSelection(formname.selectpage); + formname.page.value = formname["page"+ptr].value; + formname.title.value = formname["title"+ptr].value; formname.submit(); } @@ -2735,34 +2762,33 @@ LISTJAVASCRIPT ''."
\n"; $result.=' 
'."\n"; + 'onClick="javascript:checkPickOne(this.form);"value="Next->" />
'."\n"; $request->print($result); - my $studentTable.=' Select a student you wish to grade
'. + my $studentTable.=' Select a student you wish to grade and then click on the Next button.
'. '
'. ''. - ''. - ''. - ''. - ''; + ''. + ''. + ''. + ''; my (undef,undef,$fullname) = &getclasslist($getsec,'1'); my $ptr = 1; foreach my $student (sort {lc($$fullname{$a}) cmp lc($$fullname{$b}) } keys %$fullname) { my ($uname,$udom) = split(/:/,$student); - $studentTable.=($ptr%4 == 1 ? '' : ''); + $studentTable.=($ptr%2 == 1 ? '' : ''); + $studentTable.=''; + $studentTable.='' : ''); $ptr++; } - $studentTable.='
 Fullname (username) Fullname (username) Fullname (username) Fullname (username)
 No.'.&nameUserString('header').' No.'.&nameUserString('header').'
' : ''); - $studentTable.=' '.$$fullname{$student}. - ' ('.$uname.($udom eq $cdom ? '':':'.$udom).')'."\n"; - $studentTable.=($ptr%4 == 0 ? '
'.$ptr.'   ' + .&nameUserString(undef,$$fullname{$student},$uname,$udom)."\n"; + $studentTable.=($ptr%2 == 0 ? '
   ' if ($ptr%4 == 2); - $studentTable.='  ' if ($ptr%4 == 3); - $studentTable.=' ' if ($ptr%4 == 0); + $studentTable.='  ' if ($ptr%2 == 0); $studentTable.='
'."\n"; - $studentTable.='
 '."\n"; + $studentTable.=''."\n"; $studentTable.=&show_grading_menu_form($symb,$url); $request->print($studentTable); @@ -2774,7 +2800,7 @@ sub getSymbMap { my ($request) = @_; my $navmap = Apache::lonnavmaps::navmap-> new($ENV{'request.course.fn'}.'.db', $ENV{'request.course.fn'}.'_parms.db'); - $navmap->init(); +# $navmap->init(); my %symbx = (); my @titles = (); @@ -2814,9 +2840,8 @@ sub displayPage { return; } my $result='

 '.$ENV{'form.title'}.'

'; - $result.='

 Student: '.$$fullname{$ENV{'form.student'}}. - ' ('.$uname.($udom eq $cdom ? '':':'.$udom).')

'."\n"; - + $result.='

 Student: '.&nameUserString(undef,$$fullname{$ENV{'form.student'}},$uname,$udom). + '

'."\n"; &sub_page_js($request); $request->print($result); @@ -2830,11 +2855,13 @@ sub displayPage { my $studentTable='
'."\n". ''."\n". + ''."\n". ''."\n". ''."\n". ''."\n". ''."\n". ''."\n". + ''."\n". ''."\n"; my $checkIcon = 'No recorded submission for this problem
'; @@ -2910,7 +2937,7 @@ sub displayPage { $navmap->untieHashes(); $studentTable.=''."\n". - '  '. '
'."\n"; $studentTable.=&show_grading_menu_form($symb,$url); @@ -2952,7 +2979,7 @@ sub displaySubByDates { $$record{"$version:resource.$partid.regrader"}.' (Part: '.$partid.')' : ''; } $displaySub[2].=(exists $$record{"$version:resource.regrader"}) ? - $$record{"$version:resource.regrader"} : ''; + $$record{"$version:resource.regrader"} : ''; # needed because old essay regrader has not parts info $studentTable.=''.$displaySub[0].' '.$displaySub[1]. ($displaySub[2] eq '' ? '' : 'Manually graded by '.$displaySub[2]).' '; } @@ -2976,8 +3003,8 @@ sub updateGradeByPage { return; } my $result='

 '.$ENV{'form.title'}.'

'; - $result.='

 Student: '.$$fullname{$ENV{'form.student'}}. - ' ('.$uname.($udom eq $cdom ? '':':'.$udom).')

'."\n"; + $result.='

 Student: '.&nameUserString(undef,$ENV{'form.fullname'},$uname,$udom). + '

'."\n"; $request->print($result); @@ -2991,7 +3018,7 @@ sub updateGradeByPage { my $studentTable='
'. ''. - ''. + ''. ''. ''. ''; @@ -3023,31 +3050,39 @@ sub updateGradeByPage { my $score; if ($partial > 0) { $score = 'correct_by_override'; - } elsif ($partial == 0) { + } elsif ($newpts ne '') { #empty is taken as 0 $score = 'incorrect_by_override'; } - if ($ENV{'form.GD_SEL'.$question.'_'.$partid} eq 'excused') { + my $dropMenu = $ENV{'form.GD_SEL'.$question.'_'.$partid}; + if ($dropMenu eq 'excused') { $partial = ''; $score = 'excused'; + } elsif ($dropMenu eq 'reset status' + && $ENV{'form.solved'.$question.'_'.$partid} ne '') { #update only if previous record exists + $newrecord{'resource.'.$partid.'.tries'} = 0; + $newrecord{'resource.'.$partid.'.solved'} = ''; + $newrecord{'resource.'.$partid.'.award'} = ''; + $newrecord{'resource.'.$partid.'.awarded'} = 0; + $newrecord{'resource.'.$partid.'.regrader'} = "$ENV{'user.name'}:$ENV{'user.domain'}"; + $changeflag++; + $newpts = ''; } + my $oldstatus = $ENV{'form.solved'.$question.'_'.$partid}; $displayPts[0].=' Part '.$partid.' = '. (($oldstatus eq 'excused') ? 'excused' : $oldpts). ' 
'; $displayPts[1].=' Part '.$partid.' = '. - ($oldstatus eq 'correct_by_student' ? $oldpts : - (($score eq 'excused') ? 'excused' : $newpts)). + (($score eq 'excused') ? 'excused' : $newpts). ' 
'; $question++; - if (($oldstatus eq 'correct_by_student') || - ($newpts eq $oldpts && $score eq $oldstatus)) - { - next; - } + next if ($dropMenu eq 'reset status' || ($newpts == $oldpts && $score ne 'excused')); + $newrecord{'resource.'.$partid.'.awarded'} = $partial if $partial ne ''; - $newrecord{'resource.'.$partid.'.solved'} = $score; - $newrecord{'resource.'.$partid.'.regrader'}="$ENV{'user.name'}:$ENV{'user.domain'}"; + $newrecord{'resource.'.$partid.'.solved'} = $score if $score ne ''; + $newrecord{'resource.'.$partid.'.regrader'} = "$ENV{'user.name'}:$ENV{'user.domain'}" + if (scalar(keys(%newrecord)) > 0); $changeflag++; } @@ -3055,6 +3090,7 @@ sub updateGradeByPage { &Apache::lonnet::cstore(\%newrecord,$symbx,$ENV{'request.course.id'}, $udom,$uname); } + $studentTable.=''. ''. ''; @@ -3110,6 +3146,8 @@ sub getSequenceDropDown { } sub scantron_uploads { + #FIXME need to support scantron files put in another location, + # maybe the course directory? a scantron dir in the course directory? if (!-e $Apache::lonnet::perlvar{'lonScansDir'}) { return ''}; my $result= ' + $default_form_data
 No  Prob.  Title  Previous Score  New Score 
'.$displayPts[0].''.$displayPts[1].'
@@ -3174,11 +3214,18 @@ sub scantron_selectphase { Format of data file: $format_selector + + +
+ + Last line to expect an answer on: + +
- + $grading_menu_button SCANTRONFORM @@ -3190,6 +3237,7 @@ 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; } @@ -3206,6 +3254,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; @@ -3221,8 +3275,50 @@ sub username_to_idmap { return %idmap; } +sub scantron_fixup_scanline { + my ($scantron_config,$scan_data,$line,$field,$newvalue,$arg) = @_; + if ($field eq 'ID') { + if ($newvalue > $$scantron_config{'IDlength'}) { + return ($line,1,'New value to large'); + } + if ($newvalue < $$scantron_config{'IDlength'}) { + $newvalue=sprintf('%-'.$$scantron_config{'IDlength'}.'s', + $newvalue); + } + substr($line,$$scantron_config{'IDstart'}-1, + $$scantron_config{'IDlength'})=$newvalue; + } 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 ne 'none') { + substr($answer,$arg,1)=$on; + &scan_data($scan_data,"no_bubble.$newvalue",undef,'1'); + } else { + &scan_data($scan_data,"no_bubble.$newvalue",'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,$scantron_config,$scan_data)=@_; my %record; my $questions=substr($line,$$scantron_config{'Qstart'}-1); my $data=substr($line,0,$$scantron_config{'Qstart'}-1); @@ -3236,6 +3332,15 @@ sub scantron_parse_scanline { } $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'}); my @alphabet=('A'..'Z'); my $questnum=0; while ($questions) { @@ -3243,31 +3348,48 @@ 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,"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; } sub scantron_add_delay { + my ($delayqueue,$scanline,$errormessage,$errorcode)=@_; + Apache->request->print('add_delay_error '.$_[2] ); + push(@$delayqueue, + {'line' => $scanline, 'emsg' => $errormessage, + 'ecode' => $errorcode } + ); } sub scantron_find_student { my ($scantron_record,$idmap)=@_; my $scanID=$$scantron_record{'scantron.ID'}; 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}; } + #Apache->request->print('
checking studnet -'.$id.'- againt -'.$scanID.'-
'); + if (lc($id) eq lc($scanID)) { + #Apache->request->print('success'); + return $$idmap{$id}; + } } return undef; } @@ -3280,6 +3402,363 @@ 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,'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, + '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); + if (!$symb) {return '';} + my $default_form_data=&defaultFormData($symb,$url); + + if ($ENV{'form.scantron_corrections'}) { + &scantron_process_corrections($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.valiadatepass'} = 0; + } + my $currentphase=$ENV{'form.valiadatepass'}; + + if ($ENV{'form.scantron_selectfile'}=~m-^/-) { + #first pass copy file to classdir + + } + my $stop=0; + while (!$stop && $currentphase < scalar(@validate_phases)) { + my $which="scantron_validate_".$validate_phases[$currentphase]; + { + no strict 'refs'; + ($stop,$currentphase)=&$which($r,$currentphase); + } + } + $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/'.$cdom.'/'.$cname.'/'. + 'scantron_orig_'.$ENV{'form.scantron_selectfile'}); + if ($lines eq '-1') { + #FIXME need to actually replicate file to course space + } + my %scanlines; + $scanlines{'orig'}=[split("\n",$lines)]; + my $temp=$scanlines{'orig'}; + $scanlines{'count'}=$#$temp; + + $lines=&Apache::lonnet::getfile('/uploaded/'.$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/'.$cdom.'/'.$cname.'/'. + 'scantron_skipped_'.$ENV{'form.scantron_selectfile'}); + if ($lines eq '-1') { + $scanlines{'skipped'}=[]; + } else { + $scanlines{'skipped'}=[split("\n",$lines)]; + } + 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 { + 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('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) { next; } + my $scan_record=&scantron_parse_scanline($line,\%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"); + 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"); + } + $found=$checkid;last; + } + } + if ($found) { + if ($found{'ids'}{$found}) { + #FIXME store away line we prviously saw the ID on + &scantron_get_correction($r,$i,$scan_record,\%scantron_config, + $line,'duplicateID',$found); + return(1); + } else { + $found{'ids'}{$found}++; + } + } else { + &scantron_get_correction($r,$i,$scan_record,\%scantron_config, + $line,'incorrectID'); + return(1); + } + } + + 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("

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 =~ /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