--- loncom/homework/grades.pm 2004/02/09 21:13:50 1.172 +++ loncom/homework/grades.pm 2004/09/27 20:59:21 1.216 @@ -1,7 +1,7 @@ # The LearningOnline Network with CAPA # The LON-CAPA Grading handler # -# $Id: grades.pm,v 1.172 2004/02/09 21:13:50 albertel Exp $ +# $Id: grades.pm,v 1.216 2004/09/27 20:59:21 www Exp $ # # Copyright Michigan State University Board of Trustees # @@ -25,16 +25,7 @@ # # http://www.lon-capa.org/ # -# 2/9,2/13 Guy Albertelli -# 6/8 Gerd Kortemeyer -# 7/26 H.K. Ng -# 8/20 Gerd Kortemeyer -# Year 2002 -# June-August H.K. Ng -# Year 2003 -# February, March H.K. Ng -# July, H. K. Ng -# +### package Apache::grades; use strict; @@ -89,10 +80,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); } @@ -162,6 +158,20 @@ sub response_type { return \@partlist,\%handgrade,\%responseType; } +sub get_display_part { + my ($partID,$url,$symb)=@_; + if (!defined($symb) || $symb eq '') { + $symb=$ENV{'form.symb'}; + if ($symb eq '') { $symb=&Apache::lonnet::symbread($url) } + } + my $display=&Apache::lonnet::EXT('resource.'.$partID.'.display',$symb); + if (defined($display) and $display ne '') { + $display.= " (<font color=\"#999900\">id $partID</font>)"; + } else { + $display=$partID; + } + return $display; +} #--- Show resource title #--- and parts and response type sub showResourceInfo { @@ -189,7 +199,8 @@ sub showResourceInfo { } $partsseen{$partID}=1; } - $result.='<td><b>Part </b>'.$partID.' <font color="#999999">'. + my $display_part=&get_display_part($partID,$url); + $result.='<td><b>Part: </b>'.$display_part.' <font color="#999999">'. $resID.'</font></td>'. '<td><b>Type: </b>'.$responsetype.'</td></tr>'; # '<td><b>Handgrade: </b>'.$handgrade.'</td></tr>'; @@ -344,27 +355,36 @@ sub getclasslist { # my %sections; my %fullnames; - foreach (keys(%$classlist)) { - # the following undefs are for 'domain', and 'username' respectively. - my (undef,undef,$end,$start,$id,$section,$fullname,$status)= - @{$classlist->{$_}}; + foreach my $student (keys(%$classlist)) { + my $end = + $classlist->{$student}->[&Apache::loncoursedata::CL_END()]; + my $start = + $classlist->{$student}->[&Apache::loncoursedata::CL_START()]; + my $id = + $classlist->{$student}->[&Apache::loncoursedata::CL_ID()]; + my $section = + $classlist->{$student}->[&Apache::loncoursedata::CL_SECTION()]; + my $fullname = + $classlist->{$student}->[&Apache::loncoursedata::CL_FULLNAME()]; + my $status = + $classlist->{$student}->[&Apache::loncoursedata::CL_STATUS()]; # filter students according to status selected if ($filterlist && $ENV{'form.Status'} ne 'Any') { if ($ENV{'form.Status'} ne $status) { - delete ($classlist->{$_}); + delete ($classlist->{$student}); next; } } - $section = ($section ne '' ? $section : 'no'); + $section = ($section ne '' ? $section : 'none'); if (&canview($section)) { if ($getsec eq 'all' || $getsec eq $section) { $sections{$section}++; - $fullnames{$_}=$fullname; + $fullnames{$student}=$fullname; } else { - delete($classlist->{$_}); + delete($classlist->{$student}); } } else { - delete($classlist->{$_}); + delete($classlist->{$student}); } } my %seen = (); @@ -506,7 +526,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'}; @@ -521,18 +541,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.='<tr bgcolor="#ffffe6"><td> '."\n". - '<a href="javascript:viewOneStudent(\''.$uname.'\',\''.$udom. - '\')"; TARGET=_self>'.$$fullname{$_}.'</a> </td>'."\n". - '<td> '.$uname.' </td>'. - '<td> '.$udom.' </td></tr>'."\n"; - - $matches++; + foreach my $part (@$parts) { + if ($receipt eq &Apache::lonnet::ireceipt($uname,$udom,$courseid,$symb,$part)) { + $contents.='<tr bgcolor="#ffffe6"><td> '."\n". + '<a href="javascript:viewOneStudent(\''.$uname.'\',\''.$udom. + '\')"; TARGET=_self>'.$$fullname{$_}.'</a> </td>'."\n". + '<td> '.$uname.' </td>'. + '<td> '.$udom.' </td>'; + if ($receiptparts) { + $contents.='<td> '.$part.' </td>'; + } + $contents.='</tr>'."\n"; + + $matches++; + } } } if ($matches == 0) { @@ -545,8 +574,11 @@ sub verifyreceipt { '<table border="0"><tr bgcolor="#e6ffff">'."\n". '<td><b> Fullname </b></td>'."\n". '<td><b> Username </b></td>'."\n". - '<td><b> Domain </b></td></tr>'."\n". - $contents. + '<td><b> Domain </b></td>'; + if ($receiptparts) { + $string.='<td> Problem Part </td>'; + } + $string.='</tr>'."\n".$contents. '</table></td></tr></table>'."\n"; } return $string.&show_grading_menu_form($symb,$url); @@ -665,7 +697,9 @@ LISTJAVASCRIPT '<td>'.&nameUserString('header').'</td>'; if ($ENV{'form.showgrading'} eq 'yes' && $submitonly ne 'all') { foreach (sort(@$partlist)) { - $gradeTable.='<td><b> Part '.(split(/_/))[0].' Status </b></td>'; + my $display_part=&get_display_part((split(/_/))[0],$url,$symb); + $gradeTable.='<td><b> Part: '.$display_part. + ' Status </b></td>'; } } $loop++; @@ -958,6 +992,7 @@ sub sub_page_kw_js { my $request = shift; my $iconpath = $request->dir_config('lonIconsURL'); &commonJSfunctions($request); + my $nothing= &Apache::lonhtmlcommon::javascript_nothing(); $request->print(<<SUBJAVASCRIPT); <script type="text/javascript" language="javascript"> @@ -1067,10 +1102,10 @@ sub sub_page_kw_js { var ypos = (screen.height-height)/2-30; ypos = (ypos < 0) ? '0' : ypos; - pWin = window.open('', 'MessageCenter', 'toolbar=no,location=no,scrollbars='+scrollbar+',screenx='+xpos+',screeny='+ypos+',width=600,height='+height); + pWin = window.open('', 'MessageCenter', 'resizable=yes,toolbar=no,location=no,scrollbars='+scrollbar+',screenx='+xpos+',screeny='+ypos+',width=600,height='+height); pWin.focus(); pDoc = pWin.document; - pDoc.open('text/html','replace'); + pDoc.open($nothing,'replace'); pDoc.write("<html><head>"); pDoc.write("<title>Message Central</title>"); @@ -1198,10 +1233,10 @@ sub sub_page_kw_js { var ypos = (screen.height-330)/2-30; ypos = (ypos < 0) ? '0' : ypos; - hwdWin = window.open('', 'KeywordHighlightCentral', 'toolbar=no,location=no,scrollbars=no,width=400,height=300,screenx='+xpos+',screeny='+ypos); + hwdWin = window.open('', 'KeywordHighlightCentral', 'resizeable=yes,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.open($nothing,'replace'); hDoc.write("<html><head>"); hDoc.write("<title>Highlight Central</title>"); @@ -1272,16 +1307,17 @@ sub gradeBox { '' : $$record{'resource.'.$partid.'.awarded'}*$wgt); my $result='<input type="hidden" name="WGT'.$counter.'_'.$partid.'" value="'.$wgt.'" />'."\n"; + my $display_part=&get_display_part($partid,undef,$symb); $result.='<table border="0"><tr><td>'. - '<b>Part </b>'.$partid.' <b>Points: </b></td><td>'."\n"; + '<b>Part: </b>'.$display_part.' <b>Points: </b></td><td>'."\n"; my $ctr = 0; $result.='<table border="0"><tr>'."\n"; # display radio buttons in a nice table 10 across while ($ctr<=$wgt) { - $result.= '<td><input type="radio" name="RADVAL'.$counter.'_'.$partid.'" '. + $result.= '<td><nobr><input type="radio" name="RADVAL'.$counter.'_'.$partid.'" '. 'onclick="javascript:writeBox(this.form,\''.$counter.'_'.$partid.'\','. $ctr.')" value="'.$ctr.'" '. - ($score eq $ctr ? 'checked':'').' /> '.$ctr."</td>\n"; + ($score eq $ctr ? 'checked':'').' /> '.$ctr."</nobr></td>\n"; $result.=(($ctr+1)%10 == 0 ? '</tr><tr>' : ''); $ctr++; } @@ -1605,11 +1641,12 @@ KEYWORDS my %seenparts; for my $part (sort keys(%$handgrade)) { my ($partid,$respid) = split(/_/,$part); + my $display_part=&get_display_part($partid,$url,$symb); if ($ENV{"form.$uname:$udom:$partid:submitted_by"}) { if (exists($seenparts{$partid})) { next; } $seenparts{$partid}=1; - my $submitby='<b>Part '.$partid. - ' Collaborative submission by: </b>'. + my $submitby='<b>Part:</b> '.$display_part. + ' <b>Collaborative submission by:</b> '. '<a href="javascript:viewSubmitter(\''. $ENV{"form.$uname:$udom:$partid:submitted_by"}. '\')"; TARGET=_self>'. @@ -1619,8 +1656,8 @@ KEYWORDS } my $responsetype = $responseType->{$partid}->{$respid}; if (!exists($record{"resource.$partid.$respid.submission"})) { - $lastsubonly.='<tr><td bgcolor="#ffffe6"><b>Part '. - $partid.'</b> <font color="#999999">( ID '.$respid. + $lastsubonly.='<tr><td bgcolor="#ffffe6"><b>Part:</b> '. + $display_part.' <font color="#999999">( ID '.$respid. ' )</font> '. '<font color="red">Nothing submitted - no attempts</font><br /><br />'; next; @@ -1648,11 +1685,14 @@ KEYWORDS if ($ENV{'form.lastSub'} eq 'lastonly' || ($ENV{'form.lastSub'} eq 'hdgrade' && $$handgrade{$part} eq 'yes')) { - $lastsubonly.='<tr><td bgcolor="#ffffe6"><b>Part '. - $partid.'</b> <font color="#999999">( ID '.$respid. + my $display_part=&get_display_part($partid,$url,$symb); + $lastsubonly.='<tr><td bgcolor="#ffffe6"><b>Part:</b> '. + $display_part.' <font color="#999999">( ID '.$respid. ' )</font> '; if ($record{"resource.$partid.$respid.uploadedurl"}) { - $lastsubonly.='<a href="'.&Apache::lonnet::tokenwrapper($record{"resource.$partid.$respid.uploadedurl"}).'" target="lonGRDs"><img src="/adm/lonIcons/unknown.gif" border=0"> File uploaded by student</a> <font color="red" size="1">Like all files provided by users, this file may contain virusses</font><br />'; + &Apache::lonnet::allowuploaded('/adm/grades', + $record{"resource.$partid.$respid.uploadedurl"}); + $lastsubonly.='<a href="'.$record{"resource.$partid.$respid.uploadedurl"}.'" target="lonGRDs"><img src="/adm/lonIcons/unknown.gif" border=0"> File uploaded by student</a> <font color="red" size="1">Like all files provided by users, this file may contain virusses</font><br />'; } $lastsubonly.='<b>Submitted Answer: </b>'. &cleanRecord($subval,$responsetype,$symb,$partid, @@ -1687,8 +1727,10 @@ KEYWORDS ($ENV{'form.command'} eq 'processGroup' && $counter == $total)) { $toGrade.='</form>'.&show_grading_menu_form($symb,$url) } - $request = print($toGrade); + $request->print($toGrade); return; + } else { + $request->print('</td></tr></table></td></tr></table>'."\n"); } # essay grading message center @@ -2030,11 +2072,11 @@ 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.'_'.$_} : @@ -2278,7 +2320,7 @@ sub viewgrades { my $sectionClass; if ($ENV{'form.section'} eq 'all') { $sectionClass='Class </h3>'; - } elsif ($ENV{'form.section'} eq 'no') { + } elsif ($ENV{'form.section'} eq 'none') { $sectionClass='Students in no Section </h3>'; } else { $sectionClass='Students in Section '.$ENV{'form.section'}.'</h3>'; @@ -2305,7 +2347,8 @@ sub viewgrades { $ctsparts.'" value="'.$partid.'" />'."\n"; $result.='<input type="hidden" name="weight_'. $partid.'" value="'.$weight{$partid}.'" />'."\n"; - $result.='<tr><td><b>Part '.$partid.' Point:</b> </td><td>'; + my $display_part=&get_display_part($partid,$url,$symb); + $result.='<tr><td><b>Part:</b> '.$display_part.' <b>Point:</b> </td><td>'; $result.='<table border="0"><tr>'; my $ctr = 0; while ($ctr<=$weight{$partid}) { # display radio buttons in a nice table 10 across @@ -2344,14 +2387,17 @@ sub viewgrades { my $display=&Apache::lonnet::metadata($url,$part.'.display'); $display =~ s|^Number of Attempts|Tries<br />|; # makes the column narrower if (!$display) { $display = &Apache::lonnet::metadata($url,$part.'.name'); } + my ($partid) = &split_part_type($part); + my $display_part=&get_display_part($partid,$url,$symb); if ($display =~ /^Partial Credit Factor/) { - my ($partid) = &split_part_type($part); - $result.='<td><b>Score Part '.$partid.'<br />(weight = '. - $weight{$partid}.')</b></td>'."\n"; + $result.='<td><b>Score Part:</b> '.$display_part. + ' <br /><b>(weight = '.$weight{$partid}.')</b></td>'."\n"; next; + } else { + $display =~s/\[Part: \Q$partid\E\]/Part:<\/b> $display_part/; } $display =~ s|Problem Status|Grade Status<br />|; - $result.='<td><b>'.$display.'</b></td>'."\n"; + $result.='<td><b>'.$display.'</td>'."\n"; } $result.='</tr>'; @@ -2481,9 +2527,10 @@ sub editgrades { } } foreach my $partid (@partid) { + my $display_part=&get_display_part($partid,$url,$symb); $result .= '<td colspan="'.$columns{$partid}. - '" align="center"><b>Part '.$partid. - '</b> (Weight = '.$weight{$partid}.')</td>'; + '" align="center"><b>Part:</b> '.$display_part. + ' (Weight = '.$weight{$partid}.')</td>'; } $result .= '</tr><tr bgcolor="#deffff">'; @@ -2577,7 +2624,7 @@ sub editgrades { if ($noupdate) { # my $numcols=(scalar(@partid)*(scalar(@parts)-1)*2)+3; my $numcols=scalar(@partid)*4+2; - $result .= '<tr bgcolor="#ffffff"><td align="center" colspan="'.$numcols.'">No Changes Occurred For the Students Below</td></tr>'.$noupdate; + $result .= '<tr bgcolor="#ffffff"><td align="center" colspan="'.$numcols.'">No Changes Occurred For the Students Below</td></tr><tr bgcolor="#ffffde">'.$noupdate; } $result .= '</table></td></tr></table>'."\n". &show_grading_menu_form ($symb,$url); @@ -3089,7 +3136,7 @@ sub displayPage { '<td align="center"><b> Prob. </b></td>'. '<td><b> '.($ENV{'form.vProb'} eq 'no' ? 'Title' : 'Problem Text').'/Grade</b></td></tr>'; - 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) { @@ -3100,7 +3147,7 @@ sub displayPage { my $parts = $curRes->parts(); my $title = $curRes->compTitle(); my $symbx = $curRes->symb(); - $studentTable.='<tr bgcolor="#ffffe6"><td align="center" valign="top" >'.$question. + $studentTable.='<tr bgcolor="#ffffe6"><td align="center" valign="top" >'.$prob. (scalar(@{$parts}) == 1 ? '' : '<br>('.scalar(@{$parts}).' parts)').'</td>'; $studentTable.='<td valign="top">'; if ($ENV{'form.vProb'} eq 'yes' ) { @@ -3150,6 +3197,7 @@ sub displayPage { $studentTable.='<input type="hidden" name="q_'.$question.'" value="'.$partid.'" />'."\n"; $question++; } + $prob++; } $studentTable.='</td></tr>'; @@ -3191,12 +3239,14 @@ sub displaySubByDates { foreach my $partid (@{$parts}) { my @matchKey = sort(grep /^resource\.\Q$partid\E\..*?\.submission$/,@versionKeys); # next if ($$record{"$version:resource.$partid.solved"} eq ''); + my $display_part=&get_display_part($partid,undef,$symb); 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].='<b>Part '.$partid.' '; + $displaySub[0].='<b>Part:</b> '.$display_part.' '; $displaySub[0].='<font color="#999999">(ID '. - $responseId.')</font> '; + $responseId.')</font> <b>'; if ($$record{"$version:resource.$partid.tries"} eq '') { $displaySub[0].='Trial not counted'; } else { @@ -3214,14 +3264,14 @@ sub displaySubByDates { } } if (exists $$record{"$version:resource.$partid.award"}) { - $displaySub[1].='<b>Part '.$partid.'</b> '. + $displaySub[1].='<b>Part:</b> '.$display_part.' '. lc($$record{"$version:resource.$partid.award"}).' '. $mark{$$record{"$version:resource.$partid.solved"}}. '<br />'; } if (exists $$record{"$version:resource.$partid.regrader"}) { $displaySub[2].=$$record{"$version:resource.$partid.regrader"}. - ' (<b>'.&mt('Part').':</b> '.$partid.')'; + ' (<b>'.&mt('Part').':</b> '.$display_part.')'; } } # needed because old essay regrader has not parts info @@ -3276,7 +3326,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--; } @@ -3285,7 +3335,7 @@ sub updateGradeByPage { my $parts = $curRes->parts(); my $title = $curRes->compTitle(); my $symbx = $curRes->symb(); - $studentTable.='<tr bgcolor="#ffffe6"><td align="center" valign="top" >'.$question. + $studentTable.='<tr bgcolor="#ffffe6"><td align="center" valign="top" >'.$prob. (scalar(@{$parts}) == 1 ? '' : '<br>('.scalar(@{$parts}).' parts)').'</td>'; $studentTable.='<td valign="top"> <b>'.$title.'</b> </td>'; @@ -3318,12 +3368,13 @@ sub updateGradeByPage { $changeflag++; $newpts = ''; } - + my $display_part=&get_display_part($partid,undef, + $curRes->symb()); my $oldstatus = $ENV{'form.solved'.$question.'_'.$partid}; - $displayPts[0].=' <b>Part</b> '.$partid.' = '. + $displayPts[0].=' <b>Part:</b> '.$display_part.' = '. (($oldstatus eq 'excused') ? 'excused' : $oldpts). ' <br>'; - $displayPts[1].=' <b>Part</b> '.$partid.' = '. + $displayPts[1].=' <b>Part:</b> '.$display_part.' = '. (($score eq 'excused') ? 'excused' : $newpts). ' <br>'; @@ -3346,6 +3397,7 @@ sub updateGradeByPage { '<td valign="top">'.$displayPts[1].'</td>'. '</tr>'; + $prob++; } $curRes = $iterator->next(); } @@ -3396,18 +3448,27 @@ sub getSequenceDropDown { return $result; } -sub scantron_uploads { - if (!-e $Apache::lonnet::perlvar{'lonScansDir'}) { return ''}; - my $result= '<select name="scantron_selectfile">'; +sub scantron_filenames { my $cdom=$ENV{'course.'.$ENV{'request.course.id'}.'.domain'}; my $cname=$ENV{'course.'.$ENV{'request.course.id'}.'.num'}; my @files=&Apache::lonnet::dirlist('userfiles',$cdom,$cname, &Apache::loncommon::propath($cdom,$cname)); - foreach my $filename (@files) { + my @possiblenames; + foreach my $filename (sort(@files)) { ($filename)=split(/&/,$filename); if ($filename!~/^scantron_orig_/) { next ; } $filename=~s/^scantron_orig_//; - $result.="<option>$filename</option>\n"; + push(@possiblenames,$filename); + } + return @possiblenames; +} + +sub scantron_uploads { + my ($file2grade) = @_; + my $result= '<select name="scantron_selectfile">'; + $result.="<option></option>"; + foreach my $filename (sort(&scantron_filenames())) { + $result.="<option".($filename eq $file2grade ? ' selected="on"':'').">$filename</option>\n"; } $result.="</select>"; return $result; @@ -3416,6 +3477,7 @@ sub scantron_uploads { sub scantron_scantab { my $fh=Apache::File->new($Apache::lonnet::perlvar{'lonTabDir'}.'/scantronformat.tab'); my $result='<select name="scantron_format">'."\n"; + $result.='<option></option>'."\n"; foreach my $line (<$fh>) { my ($name,$descrip)=split(/:/,$line); if ($name =~ /^\#/) { next; } @@ -3426,15 +3488,42 @@ sub scantron_scantab { return $result; } +sub scantron_CODElist { + my $cdom = $ENV{'course.'.$ENV{'request.course.id'}.'.domain'}; + my $cnum = $ENV{'course.'.$ENV{'request.course.id'}.'.num'}; + my @names=&Apache::lonnet::getkeys('CODEs',$cdom,$cnum); + my $namechoice='<option></option>'; + foreach my $name (sort(@names)) { + if ($name =~ /^error: 2 /) { next; } + $namechoice.='<option value="'.$name.'">'.$name.'</option>'; + } + $namechoice='<select name="scantron_CODElist">'.$namechoice.'</select>'; + return $namechoice; +} + +sub scantron_CODEunique { + my $result='<nobr> + <input type="radio" name="scantron_CODEunique" + value="Yes" checked="on" /> Yes + </nobr> + <nobr> + <input type="radio" name="scantron_CODEunique" + value="No" /> No + </nobr>'; + return $result; +} + sub scantron_selectphase { - my ($r) = @_; + my ($r,$file2grade) = @_; my ($symb,$url)=&get_symb_and_url($r); if (!$symb) {return '';} my $sequence_selector=&getSequenceDropDown($r,$symb); my $default_form_data=&defaultFormData($symb,$url); my $grading_menu_button=&show_grading_menu_form($symb,$url); - my $file_selector=&scantron_uploads(); + my $file_selector=&scantron_uploads($file2grade); 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, @@ -3442,39 +3531,39 @@ sub scantron_selectphase { <table width="100%" border="0"> <tr> <td bgcolor="#777777"> - <form method="post" enctype="multipart/form-data" action="/adm/grades" name="scantro_process"> - <input type="hidden" name="command" value="scantron_validate" /> + <form method="post" enctype="multipart/form-data" action="/adm/grades" name="scantron_process"> + <input type="hidden" name="command" value="scantron_warning" /> $default_form_data <table width="100%" border="0"> <tr bgcolor="#e6ffff"> - <td> - <b>Specify file location and which Folder/Sequence to grade</b> + <td colspan="2"> + <b>Specify file and which Folder/Sequence to grade</b> </td> </tr> <tr bgcolor="#ffffe6"> - <td> - Sequence to grade: $sequence_selector - </td> + <td> Sequence to grade: </td><td> $sequence_selector </td> </tr> <tr bgcolor="#ffffe6"> - <td> - Filename of scoring office file: $file_selector - </td> + <td> Filename of scoring office file: </td><td> $file_selector </td> </tr> <tr bgcolor="#ffffe6"> - <td> - Format of data file: $format_selector - </td> + <td> Format of data file: </td><td> $format_selector </td> </tr> <tr bgcolor="#ffffe6"> + <td> Saved CODEs to validate against: </td><td> $CODE_selector</td> + </tr> + <tr bgcolor="#ffffe6"> + <td> Each CODE is only to be used once:</td><td> $CODE_unique </td> + </tr> + <tr bgcolor="#ffffe6"> + <td> Options: </td> <td> -<!-- FIXME this is lazy, a single parse of the set should let me know what this is --> - Last line to expect an answer on: - <input type="text" name="scantron_maxbubble" /> + <input type="checkbox" name="scantron_options_redo" value="redo_skipped"/> Do only previously skipped records <br /> + <input type="checkbox" name="scantron_options_ignore" value="ignore_corrections"/> Remove all exisiting corrections </td> </tr> <tr bgcolor="#ffffe6"> - <td> + <td colspan="2"> <input type="submit" value="Validate Scantron Records" /> </td> </tr> @@ -3495,13 +3584,36 @@ SCANTRONFORM <table width="100%" border="0"> <tr bgcolor="#e6ffff"> <td> - Specify a Scantron data file to upload. + <b>Specify a Scantron data file to upload.</b> </td> </tr> <tr bgcolor="#ffffe6"> <td> SCANTRONFORM - &scantron_upload_scantron_data($r); + 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(<<UPLOAD); + <script type="text/javascript" language="javascript"> + 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(); + } + </script> + + <form enctype='multipart/form-data' action='/adm/grades' name='rules' method='post'> + $default_form_data + <input name='courseid' type='hidden' value='$cnum' /> + <input name='domainid' type='hidden' value='$cdom' /> + <input name='command' value='scantronupload_save' type='hidden' /> + File to upload:<input type="file" name="upfile" size="50" /> + <br /> + <input type="button" onClick="javascript:checkUpload(this.form);" value="Upload Scantron Data" /> + </form> +UPLOAD $r->print(<<SCANTRONFORM); </td> @@ -3511,6 +3623,30 @@ SCANTRONFORM </tr> SCANTRONFORM } + $r->print(<<SCANTRONFORM); + <tr> + <td bgcolor="#777777"> + <form action='/adm/grades' name='scantron_download'> + <input type="hidden" name="command" value="scantron_download" /> + <table width="100%" border="0"> + <tr bgcolor="#e6ffff"> + <td colspan="2"> + <b>Download a scoring office file</b> + </td> + </tr> + <tr bgcolor="#ffffe6"> + <td> Filename of scoring office file: </td><td> $file_selector </td> + </tr> + <tr bgcolor="#ffffe6"> + <td colspan="2"> + <input type="submit" value="Show List of Files" /> + </td> + </tr> + </table> + </form> + </td> + </tr> +SCANTRONFORM $r->print(<<SCANTRONFORM); </table> @@ -3567,7 +3703,7 @@ 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 to large'); + return ($line,1,'New value too large'); } if (length($args->{'newid'}) < $$scantron_config{'IDlength'}) { $args->{'newid'}=sprintf('%-'.$$scantron_config{'IDlength'}.'s', @@ -3579,6 +3715,21 @@ sub scantron_fixup_scanline { &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'}; @@ -3609,14 +3760,21 @@ sub scan_data { } sub scantron_parse_scanline { - my ($line,$whichline,$scantron_config,$scan_data)=@_; + 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 } @@ -3632,6 +3790,8 @@ sub scantron_parse_scanline { $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) { @@ -3687,7 +3847,8 @@ sub scantron_find_student { sub scantron_filter { my ($curres)=@_; - if (ref($curres) && $curres->is_problem() && !$curres->randomout) { + # randomout is dysfunctional at best for this purpose + if (ref($curres) && $curres->is_problem()) { #&& !$curres->randomout) { return 1; } return 0; @@ -3699,7 +3860,7 @@ sub scantron_process_corrections { 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 $line=&scantron_get_line($scanlines,$scan_data,$which); my ($skip,$err,$errmsg); if ($ENV{'form.scantron_skip_record'}) { $skip=1; @@ -3712,6 +3873,26 @@ sub scantron_process_corrections { '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)= @@ -3725,31 +3906,141 @@ sub scantron_process_corrections { if ($err) { $r->print("Unable to accept last correction, an error occurred :$errmsg:"); } else { - &scantron_put_line($scanlines,$which,$line,$skip); + &scantron_put_line($scanlines,$scan_data,$which,$line,$skip); &scantron_putfile($scanlines,$scan_data); } } +sub reset_skipping_status { + my ($scanlines,$scan_data)=&scantron_getfile(); + &scan_data($scan_data,'remember_skipping',undef,1); + &scantron_putfile(undef,$scan_data); +} + +sub allow_skipping { + my ($scan_data,$i)=@_; + my %remembered=split(':',&scan_data($scan_data,'remember_skipping')); + delete($remembered{$i}); + &scan_data($scan_data,'remember_skipping',join(':',%remembered)); +} + +sub should_be_skipped { + my ($scan_data,$i)=@_; + if ($ENV{'form.scantron_options_redo'} !~ /^redo_/) { + # not redoing old skips + return 0; + } + my %remembered=split(':',&scan_data($scan_data,'remember_skipping')); + if (exists($remembered{$i})) { return 0; } + return 1; +} + +sub remember_current_skipped { + my ($scanlines,$scan_data)=&scantron_getfile(); + my %to_remember; + for (my $i=0;$i<=$scanlines->{'count'};$i++) { + if ($scanlines->{'skipped'}[$i]) { + $to_remember{$i}=1; + } + } + &Apache::lonnet::logthis('remembering '.join(':',%to_remember)); + &scan_data($scan_data,'remember_skipping',join(':',%to_remember)); + &scantron_putfile(undef,$scan_data); +} + +sub check_for_error { + my ($r,$result)=@_; + if ($result ne 'ok' && $result ne 'not_found' ) { + $r->print("An error occured ($result) when trying to Remove the existing corrections."); + } +} + +sub scantron_warning_screen { + my ($button_text)=@_; + my $title=&Apache::lonnet::gettitle($ENV{'form.selectpage'}); + return (<<STUFF); +<p> +<font color="red">Please double check the information + below before clicking on '$button_text'</font> +</p> +<table> +<tr><td><b>Sequence To be Graded:</b></td><td>$title</td></tr> +<tr><td><b>Data File that will be used:</b></td><td><tt>$ENV{'form.scantron_selectfile'}</tt></td></tr> +</table> +</font> +<br /> +<p> If this information is correct, please click on '$button_text'.</p> +<p> If something is incorrect, please click the 'Grading Menu' button to start over.</p> + +<br /> +STUFF +} + +sub scantron_do_warning { + my ($r)=@_; + my ($symb,$url)=&get_symb_and_url($r); + if (!$symb) {return '';} + my $default_form_data=&defaultFormData($symb,$url); + $r->print(&scantron_form_start().$default_form_data); + my $warning=&scantron_warning_screen('Validate Records'); + $r->print(<<STUFF); +$warning +<input type="submit" name="submit" value="Validate Records" /> +<input type="hidden" name="command" value="scantron_validate" /> +</form> +STUFF + $r->print("<br />".&show_grading_menu_form($symb,$url)."</body></html>"); + return ''; +} + +sub scantron_form_start { + my ($max_bubble)=@_; + my $result= <<SCANTRONFORM; +<form method="post" enctype="multipart/form-data" action="/adm/grades" name="scantronupload"> + <input type="hidden" name="selectpage" value="$ENV{'form.selectpage'}" /> + <input type="hidden" name="scantron_format" value="$ENV{'form.scantron_format'}" /> + <input type="hidden" name="scantron_selectfile" value="$ENV{'form.scantron_selectfile'}" /> + <input type="hidden" name="scantron_maxbubble" value="$max_bubble'" /> + <input type="hidden" name="scantron_CODElist" value="$ENV{'form.scantron_CODElist'}" /> + <input type="hidden" name="scantron_CODEunique" value="$ENV{'form.scantron_CODEunique'}" /> + <input type="hidden" name="scantron_options_redo" value="$ENV{'form.scantron_options_redo'}" /> + <input type="hidden" name="scantron_options_ignore" value="$ENV{'form.scantron_options_ignore'}" /> +SCANTRONFORM + return $result; +} sub scantron_validate_file { my ($r) = @_; my ($symb,$url)=&get_symb_and_url($r); if (!$symb) {return '';} my $default_form_data=&defaultFormData($symb,$url); + + # do the detection of only doing skipped records first befroe we delete + # them when doing the corrections reset + if ($ENV{'form.scantron_options_redo'} ne 'redo_skipped_ready') { + &reset_skipping_status(); + } + if ($ENV{'form.scantron_options_redo'} eq 'redo_skipped') { + &remember_current_skipped(); + &scantron_remove_file('skipped'); + $ENV{'form.scantron_options_redo'}='redo_skipped_ready'; + } + + if ($ENV{'form.scantron_options_ignore'} eq 'ignore_corrections') { + &check_for_error($r,&scantron_remove_file('corrected')); + &check_for_error($r,&scantron_remove_file('skipped')); + &check_for_error($r,&scantron_remove_scan_data()); + $ENV{'form.scantron_options_ignore'}='done'; + } if ($ENV{'form.scantron_corrections'}) { &scantron_process_corrections($r); } + $r->print("<p>Gathering neccessary info.</p>");$r->rflush(); #get the student pick code ready $r->print(&Apache::loncommon::studentbrowser_javascript()); - my $result= <<SCANTRONFORM; -<form method="post" enctype="multipart/form-data" action="/adm/grades" name="scantronupload"> - <input type="hidden" name="selectpage" value="$ENV{'form.selectpage'}" /> - <input type="hidden" name="scantron_format" value="$ENV{'form.scantron_format'}" /> - <input type="hidden" name="scantron_selectfile" value="$ENV{'form.scantron_selectfile'}" /> - <input type="hidden" name="scantron_maxbubble" value="$ENV{'form.scantron_maxbubble'}" /> - $default_form_data -SCANTRONFORM + my $max_bubble=&scantron_get_maxbubble($r); + my $result=&scantron_form_start($max_bubble).$default_form_data; $r->print($result); my @validate_phases=( 'ID', @@ -3757,14 +4048,10 @@ SCANTRONFORM 'doublebubble', 'missingbubbles'); if (!$ENV{'form.validatepass'}) { - $ENV{'form.valiadatepass'} = 0; + $ENV{'form.validatepass'} = 0; } - my $currentphase=$ENV{'form.valiadatepass'}; + my $currentphase=$ENV{'form.validatepass'}; - if ($ENV{'form.scantron_selectfile'}=~m-^/-) { - #first pass copy file to classdir - - } my $stop=0; while (!$stop && $currentphase < scalar(@validate_phases)) { $r->print("<p> Validating ".$validate_phases[$currentphase]."</p>"); @@ -3776,9 +4063,14 @@ SCANTRONFORM } } if (!$stop) { - $r->print("Validation process complete.<br />"); - $r->print('<input type="submit" name="submit" value="Start Grading" />'); - $r->print('<input type="hidden" name="command" value="scantron_process" />'); + my $warning=&scantron_warning_screen('Start Grading'); + $r->print(<<STUFF); +Validation process complete.<br /> +$warning +<input type="submit" name="submit" value="Start Grading" /> +<input type="hidden" name="command" value="scantron_process" /> +STUFF + } else { $r->print('<input type="hidden" name="command" value="scantron_validate" />'); $r->print("<input type='hidden' name='validatepass' value='".$currentphase."' />"); @@ -3794,9 +4086,44 @@ SCANTRONFORM return ''; } +sub scantron_remove_file { + 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' || $which eq 'skipped') { + $file.=$which.'_'; + } else { + return 'refused'; + } + $file.=$ENV{'form.scantron_selectfile'}; + return &Apache::lonnet::removeuserfile($cname,$cdom,$file); +} + +sub scantron_remove_scan_data { + my $cname=$ENV{'course.'.$ENV{'request.course.id'}.'.num'}; + my $cdom=$ENV{'course.'.$ENV{'request.course.id'}.'.domain'}; + 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_/) { + if ($ENV{'form.scantron_options_redo'} eq 'redo_skipped_ready' && + $key=~/remember_skipping/) { + next; + } + push(@todelete,$key); + } + } + my $result; + if (@todelete) { + $result=&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 + #FIXME really would prefer a scantron directory my $cname=$ENV{'course.'.$ENV{'request.course.id'}.'.num'}; my $cdom=$ENV{'course.'.$ENV{'request.course.id'}.'.domain'}; my $lines; @@ -3821,7 +4148,7 @@ sub scantron_getfile { } else { $scanlines{'skipped'}=[(split("\n",$lines,-1))]; } - my @tmp=&Apache::lonnet::dump('scantrondata',$cdom,$cname); + 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); @@ -3839,34 +4166,48 @@ sub lonnet_putfile { sub scantron_putfile { my ($scanlines,$scan_data) = @_; - #FIXME really would prefer a scantron directory but tokenwrapper - # doesn't allow access to subdirs of userfiles + #FIXME really would prefer a scantron directory my $cname=$ENV{'course.'.$ENV{'request.course.id'}.'.num'}; my $cdom=$ENV{'course.'.$ENV{'request.course.id'}.'.domain'}; - my $prefix='scantron_'; + if ($scanlines) { + 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); + &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;} + my ($scanlines,$scan_data,$i)=@_; + if (&should_be_skipped($scan_data,$i)) { return undef; } + if ($scanlines->{'skipped'}[$i]) { return undef; } if ($scanlines->{'corrected'}[$i]) {return $scanlines->{'corrected'}[$i];} return $scanlines->{'orig'}[$i]; } +sub get_todo_count { + my ($scanlines,$scan_data)=@_; + my $count=0; + for (my $i=0;$i<=$scanlines->{'count'};$i++) { + my $line=&scantron_get_line($scanlines,$scan_data,$i); + if ($line=~/^[\s\cz]*$/) { next; } + $count++; + } + return $count; +} + sub scantron_put_line { - my ($scanlines,$i,$newline,$skip)=@_; + my ($scanlines,$scan_data,$i,$newline,$skip)=@_; if ($skip) { $scanlines->{'skipped'}[$i]=$newline; + &allow_skipping($scan_data,$i); return; } $scanlines->{'corrected'}[$i]=$newline; @@ -3885,7 +4226,7 @@ sub scantron_validate_ID { my %found=('ids'=>{},'usernames'=>{}); for (my $i=0;$i<=$scanlines->{'count'};$i++) { - my $line=&scantron_get_line($scanlines,$i); + my $line=&scantron_get_line($scanlines,$scan_data,$i); if ($line=~/^[\s\cz]*$/) { next; } my $scan_record=&scantron_parse_scanline($line,$i,\%scantron_config, $scan_data); @@ -3899,13 +4240,13 @@ sub scantron_validate_ID { if ($found{'ids'}{$found}) { &scantron_get_correction($r,$i,$scan_record,\%scantron_config, $line,'duplicateID',$found); - return(1); + return(1,$currentphase); } elsif ($found{'usernames'}{$username}) { &scantron_get_correction($r,$i,$scan_record,\%scantron_config, $line,'duplicateID',$username); - return(1); + return(1,$currentphase); } - #FIXME store away line we prviously saw the ID on to use above + #FIXME store away line we previously saw the ID on to use above $found{'ids'}{$found}++; $found{'usernames'}{$username}++; } else { @@ -3915,18 +4256,18 @@ sub scantron_validate_ID { &scantron_get_correction($r,$i,$scan_record, \%scantron_config, $line,'duplicateID',$username); - return(1); + return(1,$currentphase); } elsif (!defined($username)) { &scantron_get_correction($r,$i,$scan_record, \%scantron_config, $line,'incorrectID'); - return(1); + return(1,$currentphase); } $found{'usernames'}{$username}++; } else { &scantron_get_correction($r,$i,$scan_record,\%scantron_config, $line,'incorrectID'); - return(1); + return(1,$currentphase); } } } @@ -3952,7 +4293,7 @@ sub scantron_get_correction { $r->print('<input type="hidden" name="scantron_corrections" value="'.$error.'" />'."\n"); $r->print('<input type="hidden" name="scantron_line" value="'.$i.'" />'."\n"); if ($error =~ /ID$/) { - if ($error eq 'unknownID') { + if ($error eq 'incorrectID') { $r->print("The encoded ID is not in the classlist</p>\n"); } elsif ($error eq 'duplicateID') { $r->print("The encoded ID has also been used by a previous paper $arg</p>\n"); @@ -3970,11 +4311,61 @@ sub scantron_get_correction { 'scantron_username','scantron_domain')); $r->print(": <input type='text' name='scantron_username' value='' />"); $r->print("\n@". - &Apache::loncommon::select_dom_form(undef,'scantron_domain')); + &Apache::loncommon::select_dom_form($ENV{'request.role.domain'},'scantron_domain')); $r->print('</li>'); + } elsif ($error =~ /CODE$/) { + if ($error eq 'incorrectCODE') { + $r->print("</p><p>The encoded CODE is not in the list of possible CODEs</p>\n"); + } elsif ($error eq 'duplicateCODE') { + $r->print("</p><p>The encoded CODE has also been used by a previous paper ".join(', ',@{$arg}).", and CODEs are supposed to be unique</p>\n"); + } + $r->print("<p>The CODE on the form is <tt>". + $$scan_record{'scantron.CODE'}."</tt><br />\n"); + $r->print("<p>The ID on the form is <tt>". + $$scan_record{'scantron.ID'}."</tt><br />\n"); + $r->print("The name on the paper is ". + $$scan_record{'scantron.LastName'}.",". + $$scan_record{'scantron.FirstName'}."</p>"); + $r->print("<p>How should I handle this? <br /> \n"); + $r->print("\n<br /> "); + 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("<input type='radio' name='scantron_CODE_resolution' value='use_closest_$i' $checked /> Use the similar CODE <b><tt>".$testcode."</tt></b> instead.<input type='hidden' name='scantron_CODE_closest_$i' value='$testcode' />"); + $r->print("\n<br />"); + $i++; + } + } + my $checked; if (!$i) { $checked=' checked="on" '; } + $r->print("<input type='radio' name='scantron_CODE_resolution' value='use_unfound' $checked /> Use the CODE <b><tt>".$$scan_record{'scantron.CODE'}."</tt></b> that is was on the paper, ignoring the error."); + $r->print("\n<br />"); + + $r->print(<<ENDSCRIPT); +<script type="text/javascript"> +function change_radio(field) { + var slct=document.scantronupload.scantron_CODE_resolution; + var i; + for (i=0;i<slct.length;i++) { + if (slct[i].value==field) { slct[i].checked=true; } + } +} +</script> +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("<input type='radio' name='scantron_CODE_resolution' value='use_found' /> <a target='_blank' href='$href'>Select</a> a CODE from the list of all CODEs and use it. Selected CODE is <input readonly='true' type='text' size='8' name='scantron_CODE_selectedvalue' onfocus=\"javascript:change_radio('use_found')\" onchange=\"javascript:change_radio('use_found')\" />"); + $r->print("\n<br />"); + $r->print("<input type='radio' name='scantron_CODE_resolution' value='use_typed' /> Use <input type='text' size='8' name='scantron_CODE_newvalue' onfocus=\"javascript:change_radio('use_typed')\" onkeypress=\"javascript:change_radio('use_typed')\" /> as the CODE."); + $r->print("\n<br /><br />"); } elsif ($error eq 'doublebubble') { -#FIXME Need to print out who this is along with the paper info $r->print("<p>There have been multiple bubbles scanned for a some question(s)</p>\n"); $r->print('<input type="hidden" name="scantron_questions" value="'. join(',',@{$arg}).'" />'); @@ -4021,9 +4412,77 @@ sub scantron_bubble_selector { $r->print('</tr></table>'); } +sub num_matches { + my ($orig,$code) = @_; + my @code=split(//,$code); + my @orig=split(//,$orig); + my $same=0; + for (my $i=0;$i<scalar(@code);$i++) { + if ($code[$i] eq $orig[$i]) { $same++; } + } + return $same; +} + +sub scantron_get_closely_matching_CODEs { + my ($allcodes,$CODE)=@_; + my @CODEs; + foreach my $testcode (sort(keys(%{$allcodes}))) { + push(@{$CODEs[&num_matches($CODE,$testcode)]},$testcode); + } + + return ($#CODEs,$CODEs[-1]); +} + +sub get_codes { + my $old_name=$ENV{'form.scantron_CODElist'}; + my $cdom =$ENV{'course.'.$ENV{'request.course.id'}.'.domain'}; + my $cnum =$ENV{'course.'.$ENV{'request.course.id'}.'.num'}; + my %result=&Apache::lonnet::get('CODEs',[$old_name],$cdom,$cnum); + my %allcodes=map {(&Apache::lonprintout::num_to_letters($_),1)} split(',',$result{$old_name}); + return %allcodes; +} + sub scantron_validate_CODE { my ($r,$currentphase) = @_; - #FIXME doesn't do anything yet + my %scantron_config=&get_scantron_config($ENV{'form.scantron_format'}); + if ($scantron_config{'CODElocation'} && + $scantron_config{'CODEstart'} && + $scantron_config{'CODElength'}) { + if (!defined($ENV{'form.scantron_CODElist'})) { + &FIXME_blow_up() + } + } else { + return (0,$currentphase+1); + } + + my %usedCODEs; + + my %allcodes=&get_codes(); + + my ($scanlines,$scan_data)=&scantron_getfile(); + for (my $i=0;$i<=$scanlines->{'count'};$i++) { + my $line=&scantron_get_line($scanlines,$scan_data,$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'} eq 'yes' + && !$$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); } @@ -4037,7 +4496,7 @@ sub scantron_validate_doublebubble { 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); + my $line=&scantron_get_line($scanlines,$scan_data,$i); if ($line=~/^[\s\cz]*$/) { next; } my $scan_record=&scantron_parse_scanline($line,$i,\%scantron_config, $scan_data); @@ -4050,6 +4509,31 @@ sub scantron_validate_doublebubble { 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 @@ -4059,10 +4543,10 @@ sub scantron_validate_missingbubbles { #get scantron line setup my %scantron_config=&get_scantron_config($ENV{'form.scantron_format'}); my ($scanlines,$scan_data)=&scantron_getfile(); - my $max_bubble=$ENV{'form.scantron_maxbubble'}; + 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); + my $line=&scantron_get_line($scanlines,$scan_data,$i); if ($line=~/^[\s\cz]*$/) { next; } my $scan_record=&scantron_parse_scanline($line,$i,\%scantron_config, $scan_data); @@ -4107,18 +4591,25 @@ SCANTRONFORM my @delayqueue; my %completedstudents; + my $count=&get_todo_count($scanlines,$scan_data); my %prog_state=&Apache::lonhtmlcommon::Create_PrgWin($r,'Scantron Status', - 'Scantron Progress',$scanlines->{'count'}); + 'Scantron Progress',$count, + 'inline',undef,'scantronupload'); &Apache::lonhtmlcommon::Update_PrgWin($r,\%prog_state, 'Processing first student'); my $start=&Time::HiRes::time(); my $i=-1; - my ($uname,$udom); + my ($uname,$udom,$started); while ($i<$scanlines->{'count'}) { ($uname,$udom)=('',''); $i++; - my $line=&scantron_get_line($scanlines,$i); + my $line=&scantron_get_line($scanlines,$scan_data,$i); if ($line=~/^[\s\cz]*$/) { next; } + if ($started) { + &Apache::lonhtmlcommon::Increment_PrgWin($r,\%prog_state, + 'last student'); + } + $started=1; my $scan_record=&scantron_parse_scanline($line,$i,\%scantron_config, $scan_data); unless ($uname=&scantron_find_student($scan_record,$scan_data, @@ -4139,27 +4630,31 @@ SCANTRONFORM 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 %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); + if (&Apache::loncommon::connection_aborted($r)) { last; } } $completedstudents{$uname}={'line'=>$line}; + if (&Apache::loncommon::connection_aborted($r)) { last; } } continue { &Apache::lonnet::delenv('form.counter'); &Apache::lonnet::delenv('scantron\.'); - &Apache::lonhtmlcommon::Increment_PrgWin($r,\%prog_state, - 'last student'); } &Apache::lonhtmlcommon::Close_PrgWin($r,\%prog_state); # my $lasttime = &Time::HiRes::time()-$start; # $r->print("<p>took $lasttime</p>"); $navmap->untieHashes(); - $r->print("</form><p>Done</p>"); + $r->print("</form>"); $r->print(&show_grading_menu_form($symb,$url)); return ''; } @@ -4168,10 +4663,11 @@ 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'); + 'domainid', + 'coursename'); my $domsel=&Apache::loncommon::select_dom_form($ENV{'request.role.domain'}, 'domainid'); - my $default_form_data=&defaultFormData(&get_symb_and_url($r)); + my $default_form_data=&defaultFormData(&get_symb_and_url($r,1)); $r->print(<<UPLOAD); <script type="text/javascript" language="javascript"> function checkUpload(formname) { @@ -4185,12 +4681,14 @@ sub scantron_upload_scantron_data { <form enctype='multipart/form-data' action='/adm/grades' name='rules' method='post'> $default_form_data -Course: <input name='courseid' type='text' /> -Domain: $domsel $select_link -<br /> +<table> +<tr><td>$select_link </td></tr> +<tr><td>Course ID: </td><td><input name='courseid' type='text' /> </td></tr> +<tr><td>Course Name: </td><td><input name='coursename' type='text' /></td></tr> +<tr><td>Domain: </td><td>$domsel </td></tr> +<tr><td>File to upload:</td><td><input type="file" name="upfile" size="50" /></td></tr> +</table> <input name='command' value='scantronupload_save' type='hidden' /> -File to upload:<input type="file" name="upfile" size="50" /> -<br /> <input type="button" onClick="javascript:checkUpload(this.form);" value="Upload Scantron Data" /> </form> UPLOAD @@ -4199,14 +4697,25 @@ UPLOAD sub scantron_upload_scantron_data_save { my($r)=@_; + my ($symb,$url)=&get_symb_and_url($r,1); + my $doanotherupload= + '<br /><form action="/adm/grades" method="post">'."\n". + '<input type="hidden" name="command" value="scantronupload" />'."\n". + '<input type="submit" name="submit" value="Do Another Upload" />'."\n". + '</form>'."\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.<br />"); - $r->print(&show_grading_menu_form(&get_symb_and_url($r))); + if ($symb) { + $r->print(&show_grading_menu_form($symb,$url)); + } else { + $r->print($doanotherupload); + } return ''; } - $r->print("Doing upload to ".$ENV{'form.courseid'}." <br />"); + my %coursedata=&Apache::lonnet::coursedescription($ENV{'form.domainid'}.'_'.$ENV{'form.courseid'}); + $r->print("Doing upload to ".$coursedata{'description'}." <br />"); my $home=&Apache::lonnet::homeserver($ENV{'form.courseid'}, $ENV{'form.domainid'}); my $fname=$ENV{'form.upfile.filename'}; @@ -4223,14 +4732,70 @@ sub scantron_upload_scantron_data_save { $fname=~s/[^\w\.\-]//g; # See if there is anything left unless ($fname) { return 'error: no uploaded file'; } + my $uploadedfile=$fname; $fname='scantron_orig_'.$fname; - $r->print(&Apache::lonnet::finishuserfileupload($ENV{'form.courseid'}, - $ENV{'form.domainid'}, - $home,'upfile',$fname)); - $r->print(&show_grading_menu_form(&get_symb_and_url($r))); + if (length($ENV{'form.upfile'}) < 2) { + $r->print("<font color='red'>Error:</font> The file you attempted to upload, <tt>".&HTML::Entities::encode($ENV{'form.upfile.filename'},'<>&"')."</tt>, 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("<font color='green'>Success:</font> Successfully uploaded ".(length($ENV{'form.upfile'})-1)." bytes of data into location <tt>".$result."</tt>"); + } else { + $r->print("<font color='red'>Error:</font> An error (".$result.") occurred when attempting to upload the file, <tt>".&HTML::Entities::encode($ENV{'form.upfile.filename'},'<>&"')."</tt>"); + } + } + if ($symb) { + $r->print(&scantron_selectphase($r,$uploadedfile)); + } else { + $r->print($doanotherupload); + } return ''; } +sub valid_file { + my ($requested_file)=@_; + foreach my $filename (sort(&scantron_filenames())) { + &Apache::lonnet::logthis("$requested_file $filename"); + if ($requested_file eq $filename) { return 1; } + } + return 0; +} + +sub scantron_download_scantron_data { + my ($r)=@_; + my $default_form_data=&defaultFormData(&get_symb_and_url($r,1)); + my $cname=$ENV{'course.'.$ENV{'request.course.id'}.'.num'}; + my $cdom=$ENV{'course.'.$ENV{'request.course.id'}.'.domain'}; + my $file=$ENV{'form.scantron_selectfile'}; + if (! &valid_file($file)) { + $r->print(<<ERROR); + <p> + The requested file name was invalid. + </p> +ERROR + $r->print(&show_grading_menu_form(&get_symb_and_url($r,1))); + return; + } + my $orig='/uploaded/'.$cdom.'/'.$cname.'/scantron_orig_'.$file; + my $corrected='/uploaded/'.$cdom.'/'.$cname.'/scantron_corrected_'.$file; + my $skipped='/uploaded/'.$cdom.'/'.$cname.'/scantron_skipped_'.$file; + &Apache::lonnet::allowuploaded('/adm/grades',$orig); + &Apache::lonnet::allowuploaded('/adm/grades',$corrected); + &Apache::lonnet::allowuploaded('/adm/grades',$skipped); + $r->print(<<DOWNLOAD); + <p> + <a href="$orig">Original</a> file as uploaded by the scantron office. + </p> + <p> + <a href="$corrected">Corrections</a>, a file of corrected records that were used in grading. + </p> + <p> + <a href="$skipped">Skipped</a>, a file of records that were skipped. + </p> +DOWNLOAD + $r->print(&show_grading_menu_form(&get_symb_and_url($r,1))); + return ''; +} #-------- end of section for handling grading scantron forms ------- # @@ -4345,9 +4910,6 @@ GRADINGMENUJS $result.=&mt('Student Status').':</b>'.&Apache::lonhtmlcommon::StatusOptions($saveStatus,undef,1,undef); - if (ref($sections) && (grep /no/,@$sections)) { - $result.=' (Section "no" implies the students were not assigned a section.)<br />'; - } $result.='</td></tr>'; $result.='<tr bgcolor="#ffffe6"valign="top"><td>'. @@ -4381,17 +4943,18 @@ GRADINGMENUJS $result.='<table width="100%" border=0>'; $result.='<tr bgcolor="#ffffe6"><td>'. - '<input type="button" onClick="javascript:checkChoice(this.form,\'3\',\'csvform\');" value="Upload" />'. - ' scores from file </td></tr>'."\n"; + '<input type="button" onClick="javascript:checkChoice(this.form,\'3\',\'csvform\');" value="'.&mt('Upload').'" />'. + ' '.&mt('scores from file').' </td></tr>'."\n"; $result.='<tr bgcolor="#ffffe6"valign="top"><td colspan="2">'. '<input type="button" onClick="javascript:checkChoice(this.form,\'4\',\'scantron_selectphase\');'. - '" value="Grade" /> scantron forms</td></tr>'."\n"; + '" value="'.&mt('Grade').'" /> scantron forms</td></tr>'."\n"; if ((&Apache::lonnet::allowed('mgr',$ENV{'request.course.id'})) && ($symb)) { $result.='<tr bgcolor="#ffffe6"valign="top"><td>'. - '<input type="button" onClick="javascript:checkChoice(this.form,\'5\',\'verify\');" value="Verify" />'. - ' submission Receipt no: '.unpack("%32C*",$Apache::lonnet::perlvar{'lonHostID'}). + '<input type="button" onClick="javascript:checkChoice(this.form,\'5\',\'verify\');" value="'.&mt('Verify').'" />'. + ' '.&mt('receipt').': '. + &Apache::lonnet::recprefix($ENV{'request.course.id'}). '-<input type="text" name="receipt" size="4" onChange="javascript:checkReceiptNo(this.form,\'OK\')">'. '</td></tr>'."\n"; } @@ -4507,8 +5070,8 @@ 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_warning' && $perm{'mgr'}) { + $request->print(&scantron_do_warning($request)); } elsif ($command eq 'scantron_validate' && $perm{'mgr'}) { $request->print(&scantron_validate_file($request)); } elsif ($command eq 'scantron_process' && $perm{'mgr'}) { @@ -4521,7 +5084,7 @@ sub handler { (&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' && + } elsif ($command eq 'scantron_download' && &Apache::lonnet::allowed('usc',$ENV{'request.course.id'})) { $request->print(&scantron_download_scantron_data($request)); } elsif ($command) { @@ -4546,8 +5109,7 @@ sub send_header { sub send_footer { my ($request)= @_; - $request->print('</body>'); - $request->print(&Apache::lontexconvert::footer()); + $request->print('</body></html>'); } 1;