--- loncom/homework/grades.pm 2003/07/29 20:54:39 1.128 +++ loncom/homework/grades.pm 2003/11/07 08:56:52 1.148 @@ -1,7 +1,7 @@ # The LearningOnline Network with CAPA # The LON-CAPA Grading handler # -# $Id: grades.pm,v 1.128 2003/07/29 20:54:39 ng Exp $ +# $Id: grades.pm,v 1.148 2003/11/07 08:56:52 albertel Exp $ # # Copyright Michigan State University Board of Trustees # @@ -55,17 +55,35 @@ my %perm=(); # ----- These first few routines are general use routines.---- # -# --- Retrieve the parts that matches stores_\d+ from the metadata file.--- +# --- Retrieve the parts from the metadata file.--- sub getpartlist { - my ($url) = @_; - my @parts =(); - my (@metakeys) = split(/,/,&Apache::lonnet::metadata($url,'keys')); - foreach my $key (@metakeys) { - if ( $key =~ m/stores_(\w+)_.*/) { - push(@parts,$key); + my ($url,$symb) = @_; + my $partorder = &Apache::lonnet::metadata($url, 'partorder'); + my @parts; + if ($partorder) { + for my $part (split (/,/,$partorder)) { + if (!&Apache::loncommon::check_if_partid_hidden($part,$symb)) { + push(@parts, $part); + } + } + } else { + my $metadata = &Apache::lonnet::metadata($url, 'packages'); + foreach (split(/\,/,$metadata)) { + if ($_ =~ /^part_(.*)$/) { + if (!&Apache::loncommon::check_if_partid_hidden($1,$symb)) { + push(@parts, $1); + } + } } } - return @parts; + my @stores; + foreach my $part (@parts) { + my (@metakeys) = split(/,/,&Apache::lonnet::metadata($url,'keys')); + foreach my $key (@metakeys) { + if ($key =~ m/^stores_\Q$part\E_/) { push(@stores,$key); } + } + } + return @stores; } # --- Get the symbolic name of a problem and the url @@ -96,6 +114,18 @@ 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 '<b> Fullname </b><font color="#999999">(Username)</font> '; + } else { + return ' '.$fullname.'<font color="#999999"> ('.$uname. + ($ENV{'user.domain'} eq $udom ? '' : ' ('.$udom.')').')</font>'; + } +} + #--- Get the partlist and the response type for a given problem. --- #--- Indicate if a response type is coded handgraded or not. --- sub response_type { @@ -103,20 +133,25 @@ sub response_type { $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); + my (@partlist,%handgrade,%responseType); foreach (split(/,/,&Apache::lonnet::metadata($url,'packages'))) { - if (/^\w+response_\w+.*/) { + if (/^\w+response_.*/) { my ($responsetype,$part) = split(/_/,$_,2); my ($partid,$respid) = split(/_/,$part); + if (&Apache::loncommon::check_if_partid_hidden($partid,$symb)) { + next; + } $responsetype =~ s/response$//; # make it compatible w/ navmaps - should move to that!! my ($value) = &Apache::lonnet::EXT('resource.'.$part.'.handgrade',$symb); - $handgrade{$part} = $responsetype.':'.($value eq 'yes' ? 'yes' : 'no'); + $handgrade{$part} = ($value eq 'yes' ? 'yes' : 'no'); + if (!exists($responseType{$partid})) { $responseType{$partid}={}; } + $responseType{$partid}->{$respid}=$responsetype; next if ($seen{$partid} > 0); $seen{$partid}++; push @partlist,$partid; } } - return \@partlist,\%handgrade; + return \@partlist,\%handgrade,\%responseType; } #--- Show resource title @@ -125,42 +160,105 @@ sub showResourceInfo { my ($url,$probTitle) = @_; my $result ='<table border="0">'. '<tr><td colspan=3><font size=+1><b>Current Resource: </b>'.$probTitle.'</font></td></tr>'."\n"; - my ($partlist,$handgrade) = &response_type($url); + my ($partlist,$handgrade,$responseType) = &response_type($url); my %resptype = (); my $hdgrade='no'; - for (sort keys(%$handgrade)) { - my ($responsetype,$handgrade)=split(/:/,$$handgrade{$_}); - my $partID = (split(/_/))[0]; - $resptype{$partID} = $responsetype; + for my $part_resID (sort keys(%$handgrade)) { + my $handgrade=$$handgrade{$part_resID}; + my ($partID,$resID) = split(/_/,$part_resID); + my $responsetype = $responseType->{$partID}->{$resID}; $hdgrade = $handgrade if ($handgrade eq 'yes'); - $result.='<tr><td><b>Part </b>'.$partID.'</td>'. + $result.='<tr><td><b>Part </b>'.$partID.' <font color="#999999">'. + $resID.'</font></td>'. '<td><b>Type: </b>'.$responsetype.'</td></tr>'; # '<td><b>Handgrade: </b>'.$handgrade.'</td></tr>'; } $result.='</table>'."\n"; - return $result,\%resptype,$hdgrade,$partlist,$handgrade; + return $result,$responseType,$hdgrade,$partlist,$handgrade; } + +sub get_order { + my ($partid,$respid,$symb,$uname,$udom)=@_; + my (undef,undef,$url)=&Apache::lonnet::decode_symb($symb); + $url=&Apache::lonnet::clutter($url); + my $subresult=&Apache::lonnet::ssi($url, + ('grade_target' => 'analyze'), + ('grade_domain' => $udom), + ('grade_symb' => $symb), + ('grade_courseid' => + $ENV{'request.course.id'}), + ('grade_username' => $uname)); + (my $debug,$subresult)=split(/_HASH_REF__/,$subresult,2); + Apache->request->print($debug); + my %analyze=&Apache::lonnet::str2hash($subresult); + return ($analyze{"$partid.$respid.shown"}); +} #--- Clean response type for display -#--- Currently filters option response type only. +#--- Currently filters option/rank/radiobutton/match/essay response types only. sub cleanRecord { - my ($answer,$response,$symb) = @_; - if ($response eq 'option') { - my (@IDs,@ans); - foreach (split(/\&/,&Apache::lonnet::unescape($answer))) { - my ($optionID,$ans) = split(/=/); - push @IDs,$optionID.'</font>'; - push @ans,$ans; + my ($answer,$response,$symb,$partid,$respid,$record,$order,$version) = @_; + my $grayFont = '<font color="#999999">'; + if ($response =~ /^(option|rank)$/) { + my %answer=&Apache::lonnet::str2hash($answer); + my %grading=&Apache::lonnet::str2hash($record->{$version."resource.$partid.$respid.submissiongrading"}); + my ($toprow,$bottomrow); + foreach my $foil (@$order) { + if ($grading{$foil} == 1) { + $toprow.='<td><b>'.$answer{$foil}.' </b></td>'; + } else { + $toprow.='<td><i>'.$answer{$foil}.' </i></td>'; + } + $bottomrow.='<td>'.$grayFont.$foil.'</font> </td>'; } - my $grayFont = '<font color="#999999">'; return '<blockquote><table border="1">'. - '<tr valign="top"><td>Answer</td><td>'. - (join '</td><td>',@ans).'</td></tr>'. - '<tr valign="top"><td>'.$grayFont.'Option ID</font></td><td>'.$grayFont. - (join '</td><td>'.$grayFont,@IDs).'</font></td></tr>'. - '</table></blockquote>'; - } - if ($response eq 'essay') { + '<tr valign="top"><td>Answer</td>'.$toprow.'</tr>'. + '<tr valign="top"><td>'.$grayFont.'Option ID</font></td>'. + $grayFont.$bottomrow.'</tr>'.'</table></blockquote>'; + } elsif ($response eq 'match') { + my %answer=&Apache::lonnet::str2hash($answer); + my %grading=&Apache::lonnet::str2hash($record->{$version."resource.$partid.$respid.submissiongrading"}); + my @items=&Apache::lonnet::str2array($record->{$version."resource.$partid.$respid.submissionitems"}); + my ($toprow,$middlerow,$bottomrow); + foreach my $foil (@$order) { + my $item=shift(@items); + if ($grading{$foil} == 1) { + $toprow.='<td><b>'.$item.' </b></td>'; + $middlerow.='<td><b>'.$grayFont.$answer{$foil}.' </font></b></td>'; + } else { + $toprow.='<td><i>'.$item.' </i></td>'; + $middlerow.='<td><i>'.$grayFont.$answer{$foil}.' </font></i></td>'; + } + $bottomrow.='<td>'.$grayFont.$foil.'</font> </td>'; + } + return '<blockquote><table border="1">'. + '<tr valign="top"><td>Answer</td>'.$toprow.'</tr>'. + '<tr valign="top"><td>'.$grayFont.'Item ID</font></td>'. + $middlerow.'</tr>'. + '<tr valign="top"><td>'.$grayFont.'Option ID</font></td>'. + $bottomrow.'</tr>'.'</table></blockquote>'; + } elsif ($response eq 'radiobutton') { + my %answer=&Apache::lonnet::str2hash($answer); + my ($toprow,$bottomrow); + my $correct=($order->[0])+1; + for (my $i=1;$i<=$#$order;$i++) { + my $foil=$order->[$i]; + if (exists($answer{$foil})) { + if ($i == $correct) { + $toprow.='<td><b>true</b></td>'; + } else { + $toprow.='<td><i>true</i></td>'; + } + } else { + $toprow.='<td>false</td>'; + } + $bottomrow.='<td>'.$grayFont.$foil.'</font> </td>'; + } + return '<blockquote><table border="1">'. + '<tr valign="top"><td>Answer</td>'.$toprow.'</tr>'. + '<tr valign="top"><td>'.$grayFont.'Option ID</font></td>'. + $grayFont.$bottomrow.'</tr>'.'</table></blockquote>'; + } elsif ($response eq 'essay') { if (! exists ($ENV{'form.'.$symb})) { my (%keyhash) = &Apache::lonnet::dump('nohist_handgrade', $ENV{'course.'.$ENV{'request.course.id'}.'.domain'}, @@ -173,7 +271,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 '<br /><br /><blockquote>'.&keywords_highlight($answer).'</blockquote>'; + return '<br /><br /><blockquote><pre>'.&keywords_highlight($answer).'</pre></blockquote>'; } return $answer; } @@ -206,7 +304,8 @@ sub commonJSfunctions { } } } else { - if (selectOne.selected) return selectOne.value; + // only one value it must be the selected one + return selectOne.value; } } </script> @@ -494,9 +593,12 @@ LISTJAVASCRIPT my $checkhdgrade = ($ENV{'form.handgrade'} eq 'yes' && scalar(@$partlist) > 1 ) ? 'checked' : ''; my $checklastsub = $checkhdgrade eq '' ? 'checked' : ''; my $gradeTable='<form action="/adm/grades" method="post" name="gradesub">'."\n". - ' <b>View Problem Text: </b><input type="radio" name="vProb" value="no" checked /> no '."\n". + ' <b>View Problem Text: </b><input type="radio" name="vProb" value="no" checked="on" /> no '."\n". '<input type="radio" name="vProb" value="yes" /> one student '."\n". '<input type="radio" name="vProb" value="all" /> all students <br />'."\n". + ' <b>View Answer: </b><input type="radio" name="vAns" value="no" /> no '."\n". + '<input type="radio" name="vAns" value="yes" /> one student '."\n". + '<input type="radio" name="vAns" value="all" checked="on" /> all students <br />'."\n". ' <b>Submissions: </b>'."\n"; if ($ENV{'form.handgrade'} eq 'yes' && scalar(@$partlist) > 1) { $gradeTable.='<input type="radio" name="lastSub" value="hdgrade" '.$checkhdgrade.' /> essay part only'."\n"; @@ -505,8 +607,8 @@ LISTJAVASCRIPT my $saveStatus = $ENV{'form.Status'} eq '' ? 'Active' : $ENV{'form.Status'}; $ENV{'form.Status'} = $saveStatus; - $gradeTable.='<input type="radio" name="lastSub" value="lastonly" '.$checklastsub.' /> last sub only'."\n". - '<input type="radio" name="lastSub" value="last" /> last sub & parts info'."\n". + $gradeTable.='<input type="radio" name="lastSub" value="lastonly" '.$checklastsub.' /> last submission only'."\n". + '<input type="radio" name="lastSub" value="last" /> last submission & parts info'."\n". '<input type="radio" name="lastSub" value="datesub" /> by dates and submissions'."\n". '<input type="radio" name="lastSub" value="all" /> all details'."\n". '<input type="hidden" name="section" value="'.$getsec.'" />'."\n". @@ -532,15 +634,14 @@ LISTJAVASCRIPT $gradeTable.='<input type="button" '."\n". 'onClick="javascript:checkSelect(this.form.stuinfo);" '."\n". 'value="Next->" />'."\n"; - + $gradeTable.='<input type="checkbox" name="checkPlag" checked="on">Check For Plagiarism</input>'; my (undef, undef, $fullname) = &getclasslist($getsec,'1'); $gradeTable.='<table border="0"><tr><td bgcolor="#777777">'. '<table border="0"><tr bgcolor="#e6ffff">'; my $loop = 0; while ($loop < 2) { $gradeTable.='<td><b> No.</b> </td><td><b> Select </b></td>'. - '<td><b> Fullname </b>'. - '<font color="#999999">(Username)</font> </td>'; + '<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>'; @@ -557,18 +658,21 @@ LISTJAVASCRIPT my %status = (); if ($ENV{'form.showgrading'} eq 'yes' && $submitonly ne 'all') { (%status) =&student_gradeStatus($url,$symb,$udom,$uname,$partlist); - my $statusflg = ''; + my $submitted = 0; + my $graded = 1; foreach (keys(%status)) { - $statusflg = 1 if ($status{$_} ne 'nothing'); + $submitted = 1 if ($status{$_} ne 'nothing'); + $graded = 0 if ($status{$_} =~ /^correct/); my ($foo,$partid,$foo1) = split(/\./,$_); if ($status{'resource.'.$partid.'.submitted_by'} ne '') { - $statusflg = ''; + $submitted = 0; $gradeTable.='<input type="hidden" name="'. $student.':submitted_by" value="'. $status{'resource.'.$partid.'.submitted_by'}.'" />'; } } - next if ($statusflg eq '' && $submitonly eq 'yes'); + next if (!$submitted && ($submitonly eq 'yes' || $submitonly eq 'graded')); + next if (!$graded && $submitonly eq 'graded'); } $ctr++; @@ -577,8 +681,7 @@ LISTJAVASCRIPT $gradeTable.='<td align="right">'.$ctr.' </td>'. '<td align="center"><input type=checkbox name="stuinfo" value="'. $student.':'.$$fullname{$student}.' "></td>'."\n". - '<td> '.$$fullname{$student}.' '."\n". - '<font color="#999999">('.$uname.')</font></td>'."\n"; + '<td>'.&nameUserString(undef,$$fullname{$student},$uname,$udom).'</td>'."\n"; if ($ENV{'form.showgrading'} eq 'yes' && $submitonly ne 'all') { foreach (sort keys(%status)) { @@ -611,7 +714,7 @@ LISTJAVASCRIPT } else { $gradeTable='<br /> <font color="red">'. 'No submissions found for this resource for any students. ('.$num_students. - ' checked for submissions</font><br />'; + ' checked for submissions)</font><br />'; } } elsif ($ctr == 1) { $gradeTable =~ s/type=checkbox/type=checkbox checked/; @@ -758,7 +861,9 @@ sub sub_page_js { var points = formname["GD_BOX"+i+"_"+partid].value; if (points == "") { var name = formname["name"+i].value; - var resp = confirm("You did not assign a score for "+name+", part "+partid+". Continue?"); + var studentID = (name != '' ? name : formname["unamedom"+i].value); + var resp = confirm("You did not assign a score for "+studentID+ + ", part "+partid+". Continue?"); if (resp == false) { formname["GD_BOX"+i+"_"+partid].focus(); return false; @@ -1183,27 +1288,46 @@ sub gradeBox { } sub show_problem { - my ($request,$symb,$uname,$udom,$removeform,$viewon) = @_; - my $rendered=&Apache::loncommon::get_student_view($symb,$uname,$udom, - $ENV{'request.course.id'}); + my ($request,$symb,$uname,$udom,$removeform,$viewon,$mode) = @_; + my $rendered; + if ($mode eq 'both' or $mode eq 'text') { + $rendered=&Apache::loncommon::get_student_view($symb,$uname,$udom, + $ENV{'request.course.id'}); + } if ($removeform) { $rendered=~s|<form(.*?)>||g; $rendered=~s|</form>||g; $rendered=~s|name="submit"|name="would_have_been_submit"|g; } - my $companswer=&Apache::loncommon::get_student_answers($symb,$uname,$udom, - $ENV{'request.course.id'}); + my $companswer; + if ($mode eq 'both' or $mode eq 'answer') { + $companswer=&Apache::loncommon::get_student_answers($symb,$uname,$udom, + $ENV{'request.course.id'}); + } if ($removeform) { $companswer=~s|<form(.*?)>||g; $companswer=~s|</form>||g; - $rendered=~s|name="submit"|name="would_have_been_submit"|g; + $companswer=~s|name="submit"|name="would_have_been_submit"|g; } my $result.='<table border="0" width="100%"><tr><td bgcolor="#777777">'; $result.='<table border="0" width="100%">'; - $result.='<tr><td bgcolor="#e6ffff"><b> View of the problem - '.$ENV{'form.fullname'}. - '</b></td></tr>' if ($viewon); - $result.='<tr><td bgcolor="#ffffff">'.$rendered.'<br />'; - $result.='<b>Correct answer:</b><br />'.$companswer; + if ($viewon) { + $result.='<tr><td bgcolor="#e6ffff"><b> '; + if ($mode eq 'both' or $mode eq 'text') { + $result.='View of the problem - '; + } else { + $result.='Correct answer: '; + } + $result.=$ENV{'form.fullname'}.'</b></td></tr>'; + } + if ($mode eq 'both') { + $result.='<tr><td bgcolor="#ffffff">'.$rendered.'<br />'; + $result.='<b>Correct answer:</b><br />'.$companswer; + } elsif ($mode eq 'text') { + $result.='<tr><td bgcolor="#ffffff">'.$rendered; + } elsif ($mode eq 'answer') { + $result.='<tr><td bgcolor="#ffffff">'.$companswer; + } $result.='</td></tr></table>'; $result.='</td></tr></table><br />'; return $result; @@ -1252,8 +1376,16 @@ sub submission { # option to display problem, only once else it cause problems # with the form later since the problem has a form. - if ($ENV{'form.vProb'} eq 'yes' or !$ENV{'form.vProb'}) { - $request->print(&show_problem($request,$symb,$uname,$udom,0,1)); + if ($ENV{'form.vProb'} eq 'yes' or $ENV{'form.vAns'} eq 'yes') { + my $mode; + if ($ENV{'form.vProb'} eq 'yes' && $ENV{'form.vAns'} eq 'yes') { + $mode='both'; + } elsif ($ENV{'form.vProb'} eq 'yes') { + $mode='text'; + } elsif ($ENV{'form.vAns'} eq 'yes') { + $mode='answer'; + } + $request->print(&show_problem($request,$symb,$uname,$udom,0,1,$mode)); } # kwclr is the only variable that is guaranteed to be non blank @@ -1288,6 +1420,7 @@ sub submission { '<input type="hidden" name="url" value="'.$url.'" />'."\n". '<input type="hidden" name="showgrading" value="'.$ENV{'form.showgrading'}.'" />'."\n". '<input type="hidden" name="vProb" value="'.$ENV{'form.vProb'}.'" />'."\n". + '<input type="hidden" name="vAns" value="'.$ENV{'form.vAns'}.'" />'."\n". '<input type="hidden" name="lastSub" value="'.$ENV{'form.lastSub'}.'" />'."\n". '<input type="hidden" name="section" value="'.$ENV{'form.section'}.'">'."\n". '<input type="hidden" name="submitonly" value="'.$ENV{'form.submitonly'}.'">'."\n". @@ -1338,22 +1471,29 @@ KEYWORDS } } - if ($ENV{'form.vProb'} eq 'all') { + if ($ENV{'form.vProb'} eq 'all' or $ENV{'form.vAns'} eq 'all') { $request->print('<br /><br /><br />') if ($counter > 0); - $request->print(&show_problem($request,$symb,$uname,$udom,1,1)); + my $mode; + if ($ENV{'form.vProb'} eq 'all' && $ENV{'form.vAns'} eq 'all') { + $mode='both'; + } elsif ($ENV{'form.vProb'} eq 'all' ) { + $mode='text'; + } elsif ($ENV{'form.vAns'} eq 'all') { + $mode='answer'; + } + $request->print(&show_problem($request,$symb,$uname,$udom,1,1,$mode)); } + my %record = &Apache::lonnet::restore($symb,$ENV{'request.course.id'},$udom,$uname); - my ($partlist,$handgrade) = &response_type($url,$symb); + my ($partlist,$handgrade,$responseType) = &response_type($url,$symb); # Display student info $request->print(($counter == 0 ? '' : '<br />')); my $result='<table border="0" width=100%><tr><td bgcolor="#777777">'."\n". '<table border="0" width=100%><tr bgcolor="#edffff"><td>'."\n"; - $result.='<b>Fullname: </b>'.$ENV{'form.fullname'}. - '<font color="#999999"> Username: '.$uname. - ($ENV{'user.domain'} eq $udom ? '' : ' ('.$udom.')').'</font><br />'."\n"; + $result.='<b>Fullname: </b>'.&nameUserString(undef,$ENV{'form.fullname'},$uname,$udom).'<br />'."\n"; $result.='<input type="hidden" name="name'.$counter. '" value="'.$ENV{'form.fullname'}.'" />'."\n"; @@ -1429,7 +1569,7 @@ KEYWORDS $$fullname{$ENV{'form.'.$uname.':'.$udom.':submitted_by'}}.'</a>'; $request->print($submitby); } else { - my ($string,$timestamp)= &get_last_submission (\%record); + my ($string,$timestamp)= &get_last_submission(\%record); my $lastsubonly=''. ($$timestamp eq '' ? '' : '<b>Date Submitted:</b> '. $$timestamp)."</td></tr>\n"; @@ -1437,8 +1577,8 @@ KEYWORDS $lastsubonly.='<tr><td bgcolor="#ffffe6">'.$$string[0]; } else { for my $part (sort keys(%$handgrade)) { - my ($responsetype,$foo) = split(/:/,$$handgrade{$part}); my ($partid,$respid) = split(/_/,$part); + 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. @@ -1446,19 +1586,27 @@ KEYWORDS '<font color="red">Nothing submitted - no attempts</font><br /><br />'; } else { foreach (@$string) { - my ($partid,$respid) = /^resource\.(\w+)\.(\w+)\.submission/; + my ($partid,$respid) = /^resource\.([^\.]*)\.([^\.]*)\.submission/; if ($part eq ($partid.'_'.$respid)) { my ($ressub,$subval) = split(/:/,$_,2); # Similarity check my $similar=''; - my ($oname,$odom,$ocrsid,$oessay,$osim)=&most_similar($uname,$udom,$subval); - if ($osim) { - $osim=int($osim*100.0); - $similar='<hr /><h3><font color="#FF0000">Essay is '.$osim. - '% similar to an essay by '.&Apache::loncommon::plainname($oname,$odom). - '</font></h3><blockquote><i>'. - &keywords_highlight($oessay).'</i></blockquote><hr />'; + my $oname; + my $odom; + my $ocrsid; + my $oessay; + my $osim; + if($ENV{'form.checkPlag'}){ + ($oname,$odom,$ocrsid,$oessay,$osim)=&most_similar($uname,$udom,$subval); + if ($osim) { + $osim=int($osim*100.0); + $similar='<hr /><h3><font color="#FF0000">Essay is '.$osim. + '% similar to an essay by '.&Apache::loncommon::plainname($oname,$odom). + '</font></h3><blockquote><i>'. + &keywords_highlight($oessay).'</i></blockquote><hr />'; + } } + my $order=&get_order($partid,$respid,$symb,$uname,$udom); $lastsubonly.='<tr><td bgcolor="#ffffe6"><b>Part '. $partid.'</b> <font color="#999999">( ID '.$respid. ' )</font> '. @@ -1469,8 +1617,8 @@ KEYWORDS '<font color="red" size="1">Like all files provided by users, '. 'this file may contain virusses</font><br />':''). '<b>Submitted Answer: </b>'. - &cleanRecord($subval,$responsetype,$symb). - '<br /><br />'.$similar."\n" + &cleanRecord($subval,$responsetype,$symb,$partid,$respid,\%record,$order). + '<br /><br />'.$similar."\n" if ($ENV{'form.lastSub'} eq 'lastonly' || ($ENV{'form.lastSub'} eq 'hdgrade' && $$handgrade{$part} =~ /:yes$/)); @@ -1484,7 +1632,7 @@ KEYWORDS } } elsif ($ENV{'form.lastSub'} eq 'datesub') { my (undef,$responseType,undef,$parts) = &showResourceInfo($url); - $request->print(&displaySubByDates(\$symb,\%record,$parts,$responseType,$checkIcon)); + $request->print(&displaySubByDates($symb,\%record,$parts,$responseType,$checkIcon,$uname,$udom)); } elsif ($ENV{'form.lastSub'} =~ /^(last|all)$/) { $request->print(&Apache::loncommon::get_previous_attempt($symb,$uname,$udom, $ENV{'request.course.id'}, @@ -1531,17 +1679,21 @@ KEYWORDS my %seen = (); my @partlist; + my @gradePartRespid; for (sort keys(%$handgrade)) { my ($partid,$respid) = split(/_/); next if ($seen{$partid} > 0); $seen{$partid}++; next if ($$handgrade{$_} =~ /:no$/ && $ENV{'form.lastSub'} =~ /^(hdgrade)$/); push @partlist,$partid; + push @gradePartRespid,$partid.'.'.$respid; $request->print(&gradeBox($request,$symb,$uname,$udom,$counter,$partid,\%record)); } $result='<input type="hidden" name="partlist'.$counter. '" value="'.(join ":",@partlist).'" />'."\n"; + $result.='<input type="hidden" name="gradePartRespid'. + '" value="'.(join ":",@gradePartRespid).'" />'."\n" if ($counter == 0); my $ctr = 0; while ($ctr < scalar(@partlist)) { $result.='<input type="hidden" name="partid'.$counter.'_'.$ctr.'" value="'. @@ -1768,17 +1920,28 @@ sub processHandGrade { } $ctr = 0; @parsedlist = reverse @parsedlist if ($button eq 'Previous'); + my ($partlist) = &response_type($url); foreach my $student (@parsedlist) { + my $submitonly=$ENV{'form.submitonly'}; my ($uname,$udom) = split(/:/,$student); - if ($ENV{'form.submitonly'} eq 'yes') { - my %record = &Apache::lonnet::restore($symb,$ENV{'request.course.id'},$udom,$uname); - my $statusflg = ''; - foreach (split(/:/,$ENV{'form.partlist0'})){ - $statusflg = 1 if (exists ($record{'resource.'.$_.'.solved'})); + if ($submitonly =~ /^(yes|graded)$/) { +# my %record = &Apache::lonnet::restore($symb,$ENV{'request.course.id'},$udom,$uname); + my %status=&student_gradeStatus($url,$symb,$udom,$uname,$partlist); + my $submitted = 0; + my $graded = 1; + foreach (keys(%status)) { + $submitted = 1 if ($status{$_} ne 'nothing'); + $graded = 0 if ($status{$_} =~ /^correct/); + my ($foo,$partid,$foo1) = split(/\./,$_); + if ($status{'resource.'.$partid.'.submitted_by'} ne '') { + $submitted = 0; + } } - next if ($statusflg eq ''); + next if (!$submitted && ($submitonly eq 'yes' || $submitonly eq 'graded')); + next if (!$graded && $submitonly eq 'graded'); } push @nextlist,$student if ($ctr < $ntstu); + last if ($ctr == $ntstu); $ctr++; } @@ -2075,7 +2238,7 @@ sub viewgrades { my ($partid,$respid) = split (/_/,$_,2); next if $seen{$partid}; $seen{$partid}++; - my ($responsetype,$handgrade)=split(/:/,$$handgrade{$_}); + my $handgrade=$$handgrade{$_}; my $wgt = &Apache::lonnet::EXT('resource.'.$partid.'.weight',$symb); $weight{$partid} = $wgt eq '' ? '1' : $wgt; @@ -2116,8 +2279,8 @@ sub viewgrades { $result.= '<h3>Assign Grade to Specific Students in '.$sectionClass; $result.= '<table border=0><tr><td bgcolor="#777777">'."\n". '<table border=0><tr bgcolor="#deffff"><td> <b>No.</b> </td>'. - '<td> <b>Fullname</b> <font color="#999999">(Username)</font></td>'."\n"; - my (@parts) = sort(&getpartlist($url)); + '<td>'.&nameUserString('header')."</td>\n"; + my (@parts) = sort(&getpartlist($url,$symb)); foreach my $part (@parts) { my $display=&Apache::lonnet::metadata($url,$part.'.display'); $display =~ s|^Number of Attempts|Tries<br />|; # makes the column narrower @@ -2160,7 +2323,7 @@ sub viewgrades { #--- call by previous routine to display each student sub viewstudentgrade { - my ($$url,$symb,$courseid,$student,$fullname,$parts,$weight,$ctr) = @_; + 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); @@ -2216,8 +2379,9 @@ sub editgrades { $title.='<font size=+1><b>Section: </b>'.$ENV{'form.section'}.'</font>'."\n"; my $result= '<table border="0"><tr><td bgcolor="#777777">'."\n"; - $result.= '<table border="0"><tr bgcolor="#deffff"><td rowspan=2> <b>No.</b> </td>'. - '<td rowspan=2> <b>Fullname</b> <font color="#999999">(username)</font></td>'."\n"; + $result.= '<table border="0"><tr bgcolor="#deffff">'. + '<td rowspan=2 valign="center"> <b>No.</b> </td>'. + '<td rowspan=2 valign="center">'.&nameUserString('header')."</td>\n"; my %scoreptr = ( 'correct' =>'correct_by_override', @@ -2233,7 +2397,7 @@ sub editgrades { my %columns = (); my ($i,$ctr,$count,$rec_update) = (0,0,0,0); - my (@parts) = sort(&getpartlist($url)); + my (@parts) = sort(&getpartlist($url,$symb)); my $header; while ($ctr < $ENV{'form.totalparts'}) { my $partid = $ENV{'form.partid_'.$ctr}; @@ -2276,8 +2440,7 @@ sub editgrades { my ($uname,$udom)=split(/_/,$user); my %newrecord; my $updateflag = 0; - $line .= '<td> '.$$fullname{$usercolon}. - ' <font color="#999999">('.$uname.($udom eq $ENV{'user.domain'} ? '' : '$udom').')</font></td>'; + $line .= '<td>'.&nameUserString(undef,$$fullname{$usercolon},$uname,$udom).'</td>'; my $usec=$classlist->{"$uname:$udom"}[5]; if (!&canmodify($usec)) { my $numcols=scalar(@partid)*4+2; @@ -2312,18 +2475,17 @@ sub editgrades { $newrecord{'resource.'.$_.'.awarded'} = 0; $newrecord{'resource.'.$_.'.regrader'}="$ENV{'user.name'}:$ENV{'user.domain'}"; $updateflag = 1; + } elsif (!($old_part eq $partial && $old_score eq $score)) { + $updateflag = 1; + $newrecord{'resource.'.$_.'.awarded'} = $partial if $partial ne ''; + $newrecord{'resource.'.$_.'.solved'} = $score; + $rec_update++; } $line .= '<td align="center">'.$old_aw.' </td>'. '<td align="center">'.$awarded. ($score eq 'excused' ? $score : '').' </td>'; - if (!($old_part eq $partial && $old_score eq $score)) { - $updateflag = 1; - $newrecord{'resource.'.$_.'.awarded'} = $partial if $partial ne ''; - $newrecord{'resource.'.$_.'.solved'} = $score; - $rec_update++; - } my $partid=$_; foreach my $stores (@parts) { @@ -2495,14 +2657,13 @@ to this page if the data selected is ins $javascript </script> ENDPICK - $request->print(&show_grading_menu_form($symb,$url)); return ''; } sub csvupload_fields { - my ($url) = @_; - my (@parts) = &getpartlist($url); + my ($url,$symb) = @_; + my (@parts) = &getpartlist($url,$symb); my @fields=(['username','Student Username'],['domain','Student Domain']); foreach my $part (sort(@parts)) { my @datum; @@ -2585,7 +2746,7 @@ sub csvuploadmap { &csvuploadmap_header($request,$symb,$url,$datatoken,$#records+1); my ($i,$keyfields); if (@records) { - my @fields=&csvupload_fields($url); + my @fields=&csvupload_fields($url,$symb); if ($ENV{'form.upfile_associate'} eq 'reverse') { &Apache::loncommon::csv_print_samples($request,\@records); @@ -2712,7 +2873,9 @@ LISTJAVASCRIPT $result.='<form action="/adm/grades" method="post" name="displayPage">'."\n"; $result.=' <b>Problems from:</b> <select name="selectpage">'."\n"; my ($titles,$symbx) = &getSymbMap($request); - my ($curpage,$type,$mapId) = ($symb =~ /(.*?\.(page|sequence))___(\d+)___/); + my ($curpage) =&Apache::lonnet::decode_symb($symb); +# my ($curpage,$mapId) =&Apache::lonnet::decode_symb($symb); +# my $type=($curpage =~ /\.(page|sequence)/); my $ctr=0; foreach (@$titles) { my ($minder,$showtitle) = ($_ =~ /(\d+)\.(.*)/); @@ -2732,7 +2895,7 @@ LISTJAVASCRIPT $result.='<input type="hidden" name="page" />'."\n". '<input type="hidden" name="title" />'."\n"; - $result.=' <b>View Problems Text: </b><input type="radio" name="vProb" value="no" checked /> no '."\n". + $result.=' <b>View Problems Text: </b><input type="radio" name="vProb" value="no" checked="on" /> no '."\n". '<input type="radio" name="vProb" value="yes" /> yes '."<br>\n"; $result.=' <b>Submission Details: </b>'. @@ -2756,9 +2919,9 @@ LISTJAVASCRIPT '<table border="0"><tr><td bgcolor="#777777">'. '<table border="0"><tr bgcolor="#e6ffff">'. '<td align="right"> <b>No.</b></td>'. - '<td><b> Fullname <font color="#999999">(username)</font></b></td>'. + '<td>'.&nameUserString('header').'</td>'. '<td align="right"> <b>No.</b></td>'. - '<td><b> Fullname <font color="#999999">(username)</font></b></td></tr>'; + '<td>'.&nameUserString('header').'</td></tr>'; my (undef,undef,$fullname) = &getclasslist($getsec,'1'); my $ptr = 1; @@ -2766,8 +2929,8 @@ LISTJAVASCRIPT my ($uname,$udom) = split(/:/,$student); $studentTable.=($ptr%2 == 1 ? '<tr bgcolor="#ffffe6">' : '</td>'); $studentTable.='<td align="right">'.$ptr.' </td>'; - $studentTable.='<td> <input type="radio" name="student" value="'.$student.'" /> '.$$fullname{$student}. - '<font color="#999999"> ('.$uname.($udom eq $cdom ? '':':'.$udom).')</font>'."\n"; + $studentTable.='<td> <input type="radio" name="student" value="'.$student.'" /> ' + .&nameUserString(undef,$$fullname{$student},$uname,$udom)."\n"; $studentTable.=($ptr%2 == 0 ? '</td></tr>' : ''); $ptr++; } @@ -2784,9 +2947,7 @@ LISTJAVASCRIPT sub getSymbMap { my ($request) = @_; - my $navmap = Apache::lonnavmaps::navmap-> new($ENV{'request.course.fn'}.'.db', - $ENV{'request.course.fn'}.'_parms.db'); - $navmap->init(); + my $navmap = Apache::lonnavmaps::navmap->new(); my %symbx = (); my @titles = (); @@ -2826,15 +2987,13 @@ sub displayPage { return; } my $result='<h3><font color="#339933"> '.$ENV{'form.title'}.'</font></h3>'; - $result.='<h3> Student: '.$$fullname{$ENV{'form.student'}}. - '<font color="#999999"> ('.$uname.($udom eq $cdom ? '':':'.$udom).')</font></h3>'."\n"; - + $result.='<h3> Student: '.&nameUserString(undef,$$fullname{$ENV{'form.student'}},$uname,$udom). + '</h3>'."\n"; &sub_page_js($request); $request->print($result); - my $navmap = Apache::lonnavmaps::navmap-> new($ENV{'request.course.fn'}.'.db', - $ENV{'request.course.fn'}.'_parms.db',1, 1); - my ($mapUrl, $id, $resUrl) = split(/___/, $ENV{'form.page'}); + my $navmap = Apache::lonnavmaps::navmap->new(); + my ($mapUrl, $id, $resUrl)=&Apache::lonnet::decode_symb($ENV{'form.page'}); my $map = $navmap->getResourceByUrl($resUrl); # add to navmaps my $iterator = $navmap->getIterator($map->map_start(), @@ -2875,8 +3034,9 @@ sub displayPage { $studentTable.='<tr bgcolor="#ffffe6"><td align="center" valign="top" >'.$question. (scalar(@{$parts}) == 1 ? '' : '<br>('.scalar(@{$parts}).' parts)').'</td>'; $studentTable.='<td valign="top">'; - if ($ENV{'form.vProb'} eq 'yes') { - $studentTable.=&show_problem($request,$symbx,$uname,$udom,1); + if ($ENV{'form.vProb'} eq 'yes' ) { + $studentTable.=&show_problem($request,$symbx,$uname,$udom,1, + undef,'both'); } else { my $companswer = &Apache::loncommon::get_student_answers($symbx,$uname,$udom,$ENV{'request.course.id'}); $companswer =~ s|<form(.*?)>||g; @@ -2897,9 +3057,16 @@ sub displayPage { } else { my %responseType = (); foreach my $partid (@{$parts}) { - $responseType{$partid} = $curRes->responseType($partid); + my @responseIds =$curRes->responseIds($partid); + my @responseType =$curRes->responseType($partid); + my %responseIds; + for (my $i=0;$i<=$#responseIds;$i++) { + $responseIds{$responseIds[$i]}=$responseType[$i]; + } + $responseType{$partid} = \%responseIds; } - $studentTable.= &displaySubByDates(\$symbx,\%record,$parts,\%responseType,$checkIcon); + $studentTable.= &displaySubByDates($symbx,\%record,$parts,\%responseType,$checkIcon,$uname,$udom); + } } elsif ($ENV{'form.lastSub'} eq 'all') { my $last = ($ENV{'form.lastSub'} eq 'last' ? 'last' : ''); @@ -2934,7 +3101,7 @@ sub displayPage { } sub displaySubByDates { - my ($symbx,$record,$parts,$responseType,$checkIcon) = @_; + my ($symb,$record,$parts,$responseType,$checkIcon,$uname,$udom) = @_; my $studentTable='<table border="0" width="100%"><tr><td bgcolor="#777777">'. '<table border="0" width="100%"><tr bgcolor="#e6ffff">'. '<td><b>Date/Time</b></td>'. @@ -2942,33 +3109,62 @@ sub displaySubByDates { '<td><b>Status </b></td></tr>'; my ($version); my %mark; + my %orders; $mark{'correct_by_student'} = $checkIcon; - return '<br /> <font color="red">Nothing submitted - no attempts</font><br />' - if (!exists($$record{'1:timestamp'})); + if (!exists($$record{'1:timestamp'})) { + return '<br /> <font color="red">Nothing submitted - no attempts</font><br />'; + } for ($version=1;$version<=$$record{'version'};$version++) { my $timestamp = scalar(localtime($$record{$version.':timestamp'})); $studentTable.='<tr bgcolor="#ffffff" valign="top"><td>'.$timestamp.'</td>'; my @versionKeys = split(/\:/,$$record{$version.':keys'}); my @displaySub = (); foreach my $partid (@{$parts}) { - my @matchKey = grep /^resource\.$partid\..*?\.submission$/,@versionKeys; + my @matchKey = sort(grep /^resource\.\Q$partid\E\..*?\.submission$/,@versionKeys); # next if ($$record{"$version:resource.$partid.solved"} eq ''); - $displaySub[0].=(exists $$record{$version.':'.$matchKey[0]}) ? - '<b>Part '.$partid.' '. - ($$record{"$version:resource.$partid.tries"} eq '' ? 'Trial not counted' : - 'Trial '.$$record{"$version:resource.$partid.tries"}).'</b> '. - &cleanRecord($$record{$version.':'.$matchKey[0]},$$responseType{$partid},$$symbx).'<br />' : ''; - $displaySub[1].=(exists $$record{"$version:resource.$partid.award"}) ? - '<b>Part '.$partid.'</b> '. - lc($$record{"$version:resource.$partid.award"}).' '. - $mark{$$record{"$version:resource.$partid.solved"}}.'<br />' : ''; - $displaySub[2].=(exists $$record{"$version:resource.$partid.regrader"}) ? - $$record{"$version:resource.$partid.regrader"}.' (<b>Part:</b> '.$partid.')' : ''; - } - $displaySub[2].=(exists $$record{"$version:resource.regrader"}) ? - $$record{"$version:resource.regrader"} : ''; # needed because old essay regrader has not parts info - $studentTable.='<td>'.$displaySub[0].' </td><td>'.$displaySub[1]. - ($displaySub[2] eq '' ? '' : 'Manually graded by '.$displaySub[2]).' </td></tr>'; + foreach my $matchKey (@matchKey) { + if (exists $$record{$version.':'.$matchKey}) { + my ($responseId)=($matchKey=~ /^resource\.\Q$partid\E\.(.*?)\.submission$/); + $displaySub[0].='<b>Part '.$partid.' '; + $displaySub[0].='<font color="#999999">(ID '. + $responseId.')</font> '; + if ($$record{"$version:resource.$partid.tries"} eq '') { + $displaySub[0].='Trial not counted'; + } else { + $displaySub[0].='Trial '. + $$record{"$version:resource.$partid.tries"}; + } + my $responseType=$responseType->{$partid}->{$responseId}; + if (!exists($orders{$partid})) { $orders{$partid}={}; } + if (!exists($orders{$partid}->{$responseId})) { + $orders{$partid}->{$responseId}= + &get_order($partid,$responseId,$symb,$uname,$udom); + } + $displaySub[0].='</b> '. + &cleanRecord($$record{$version.':'.$matchKey},$responseType,$symb,$partid,$responseId,$record,$orders{$partid}->{$responseId},"$version:").'<br />'; + } + } + if (exists $$record{"$version:resource.$partid.award"}) { + $displaySub[1].='<b>Part '.$partid.'</b> '. + 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>Part:</b> '.$partid.')'; + } + } + # needed because old essay regrader has not parts info + if (exists $$record{"$version:resource.regrader"}) { + $displaySub[2].=$$record{"$version:resource.regrader"}; + } + $studentTable.='<td>'.$displaySub[0].' </td><td>'.$displaySub[1]; + if ($displaySub[2]) { + $studentTable.='Manually graded by '.$displaySub[2]; + } + $studentTable.=' </td></tr>'; + } $studentTable.='</table></td></tr></table>'; return $studentTable; @@ -2990,14 +3186,13 @@ sub updateGradeByPage { return; } my $result='<h3><font color="#339933"> '.$ENV{'form.title'}.'</font></h3>'; - $result.='<h3> Student: '.$ENV{'form.fullname'}. - '<font color="#999999"> ('.$uname.($udom eq $cdom ? '':':'.$udom).')</font></h3>'."\n"; + $result.='<h3> Student: '.&nameUserString(undef,$ENV{'form.fullname'},$uname,$udom). + '</h3>'."\n"; $request->print($result); - my $navmap = Apache::lonnavmaps::navmap-> new($ENV{'request.course.fn'}.'.db', - $ENV{'request.course.fn'}.'_parms.db',1, 1); - my ($mapUrl, $id, $resUrl) = split(/___/, $ENV{'form.page'}); + my $navmap = Apache::lonnavmaps::navmap->new(); + my ($mapUrl, $id, $resUrl) = &Apache::lonnet::decode_symb( $ENV{'form.page'}); my $map = $navmap->getResourceByUrl($resUrl); # add to navmaps my $iterator = $navmap->getIterator($map->map_start(), @@ -3119,7 +3314,7 @@ sub getSequenceDropDown { my ($request,$symb)=@_; my $result='<select name="selectpage">'."\n"; my ($titles,$symbx) = &getSymbMap($request); - my ($curpage,$type,$mapId) = ($symb =~ /(.*?\.(page|sequence))___(\d+)___/); + my ($curpage)=&Apache::lonnet::decode_symb($symb); my $ctr=0; foreach (@$titles) { my ($minder,$showtitle) = ($_ =~ /(\d+)\.(.*)/); @@ -3171,7 +3366,7 @@ sub scantron_selectphase { my $result; $result.= <<SCANTRONFORM; <form method="post" enctype="multipart/form-data" action="/adm/grades" name="scantro_process"> - <input type="hidden" name="command" value="scantron_process" /> + <input type="hidden" name="command" value="scantron_validate" /> $default_form_data <table width="100%" border="0"> <tr> @@ -3201,7 +3396,7 @@ sub scantron_selectphase { </td> </tr> </table> - <input type="submit" value="Submit" /> + <input type="submit" value="Validate Scantron Records" /> </form> $grading_menu_button SCANTRONFORM @@ -3283,14 +3478,23 @@ sub scantron_parse_scanline { } sub scantron_add_delay { + my ($delayqueue,$scanline,$errormessage,$errorcode)=@_; + Apache->request->print('add_delay_error '.$_[2] ); + push(@$delayqueue, + {'line' => $scanline, 'emsg' => $errormessage, + 'ecode' => $errorcode } + ); } sub scantron_find_student { my ($scantron_record,$idmap)=@_; my $scanID=$$scantron_record{'scantron.ID'}; foreach my $id (keys(%$idmap)) { - Apache->request->print('<pre>checking studnet -'.$id.'- againt -'.$scanID.'- </pre>'); - if (lc($id) eq lc($scanID)) { Apache->request->print('success');return $$idmap{$id}; } + #Apache->request->print('<pre>checking studnet -'.$id.'- againt -'.$scanID.'- </pre>'); + if (lc($id) eq lc($scanID)) { + #Apache->request->print('success'); + return $$idmap{$id}; + } } return undef; } @@ -3303,9 +3507,21 @@ 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_validate_file { + my ($r) = @_; +} + sub scantron_process_students { my ($r) = @_; - my (undef,undef,$sequence)=split(/___/,$ENV{'form.selectpage'}); + my (undef,undef,$sequence)=&Apache::lonnet::decode_symb($ENV{'form.selectpage'}); my ($symb,$url)=&get_symb_and_url($r); if (!$symb) {return '';} my $default_form_data=&defaultFormData($symb,$url); @@ -3315,10 +3531,10 @@ sub scantron_process_students { my @scanlines=<$scanlines>; my $classlist=&Apache::loncoursedata::get_classlist(); my %idmap=&username_to_idmap($classlist); - my $navmap=Apache::lonnavmaps::navmap->new($ENV{'request.course.fn'}.'.db',$ENV{'request.course.fn'}.'_parms.db',1, 1); + my $navmap=Apache::lonnavmaps::navmap->new(); my $map=$navmap->getResourceByUrl($sequence); my @resources=$navmap->retrieveResources($map,\&scantron_filter,1,0); - $r->print("geto ".scalar(@resources)."<br />"); +# $r->print("geto ".scalar(@resources)."<br />"); my $result= <<SCANTRONFORM; <form method="post" enctype="multipart/form-data" action="/adm/grades" name="scantronupload"> <input type="hidden" name="command" value="scantron_configphase" /> @@ -3327,29 +3543,36 @@ SCANTRONFORM $r->print($result); my @delayqueue; - my $totalcorrect; - my $totalincorrect; - + my %completedstudents; + my %prog_state=&Apache::lonhtmlcommon::Create_PrgWin($r, 'Scantron Status','Scantron Progress',scalar(@scanlines)); + &Apache::lonhtmlcommon::Update_PrgWin($r,\%prog_state, + 'Processing first student'); + my $start=&Time::HiRes::time(); foreach my $line (@scanlines) { - my $studentcorrect; - my $studentincorrect; + $r->print('<pre>line is'.$line.'</pre>'); chomp($line); my $scan_record=&scantron_parse_scanline($line,\%scantron_config); my ($uname,$udom); - if ($uname=&scantron_find_student($scan_record,\%idmap)) { + unless ($uname=&scantron_find_student($scan_record,\%idmap)) { + &scantron_add_delay(\@delayqueue,$line, + 'Unable to find a student that matches',1); + next; + } + if (exists $completedstudents{$uname}) { &scantron_add_delay(\@delayqueue,$line, - 'Unable to find a student that matches'); + 'Student '.$uname.' has multiple sheets',2); + next; } $r->print('<pre>doing studnet'.$uname.'</pre>'); ($uname,$udom)=split(/:/,$uname); &Apache::lonnet::delenv('form.counter'); &Apache::lonnet::appenv(%$scan_record); # &Apache::lonhomework::showhash(%ENV); - $Apache::lonxml::debug=1; - &Apache::lonxml::debug("line is $line"); +# $Apache::lonxml::debug=1; +# &Apache::lonxml::debug("line is $line"); my $i=0; foreach my $resource (@resources) { @@ -3361,31 +3584,31 @@ SCANTRONFORM 'grade_domain' =>$udom, 'grade_courseid'=>$ENV{'request.course.id'}, 'grade_symb' =>$resource->symb())); - my %score=&Apache::lonnet::restore($resource->symb(), - $ENV{'request.course.id'}, - $udom,$uname); - foreach my $part ($resource->{PARTS}) { - if ($score{'resource.'.$part.'.solved'} =~ /^correct/) { - $studentcorrect++; - $totalcorrect++; - } else { - $studentincorrect++; - $totalincorrect++; - } - } - $r->print('<pre>'. - $resource->symb().'-'. - $resource->src().'-'.'</pre>result is'.$result); - &Apache::lonhomework::showhash(%score); +# my %score=&Apache::lonnet::restore($resource->symb(), +# $ENV{'request.course.id'}, +# $udom,$uname); +# foreach my $part ($resource->{PARTS}) { +# if ($score{'resource.'.$part.'.solved'} =~ /^correct/) { +# $studentcorrect++; +# $totalcorrect++; +# } else { +# $studentincorrect++; +# $totalincorrect++; +# } +# } +# $r->print('<pre>'. +# $resource->symb().'-'. +# $resource->src().'-'.'</pre>result is'.$result); +# &Apache::lonhomework::showhash(%score); # if ($i eq 3) {last;} } + $completedstudents{$uname}={'line'=>$line}; + } continue { &Apache::lonnet::delenv('form.counter'); &Apache::lonnet::delenv('scantron\.'); &Apache::lonhtmlcommon::Increment_PrgWin($r,\%prog_state, - 'last student Who got a '.$studentcorrect.' correct and '. - $studentincorrect.' incorrect. The class has gotten '. - $totalcorrect.' correct and '.$totalincorrect.' incorrect'); - last; + 'last student'); + #last; #FIXME #get iterator for $sequence #foreach question 'submit' the students answer to the server @@ -3393,7 +3616,11 @@ SCANTRONFORM # generate data to pass back that includes grade recevied #} } - $Apache::lonxml::debug=0; + &Apache::lonhtmlcommon::Close_PrgWin($r,\%prog_state); + my $lasttime = &Time::HiRes::time()-$start; + $r->print("<p>took $lasttime</p>"); + + #$Apache::lonxml::debug=0; foreach my $delay (@delayqueue) { #FIXME #print out each delayed student with interface to select how @@ -3460,7 +3687,7 @@ sub gradingmenu { } formname.command.value = cmd; formname.saveState.value = "saveCmd="+cmdsave+":saveSec="+pullDownSelection(formname.section)+ - ":saveSub="+radioSelection(formname.submitonly)+":saveStatus="+pullDownSelection(formname.Status); + ":saveSub="+pullDownSelection(formname.submitonly)+":saveStatus="+pullDownSelection(formname.Status); if (val < 5) formname.submit(); if (val == 5) { if (!checkReceiptNo(formname,'notOK')) { return false;} @@ -3528,12 +3755,14 @@ GRADINGMENUJS $result.='<tr bgcolor="#ffffe6"valign="top"><td>'. '<input type="radio" name="radioChoice" value="submission" '. - ($saveCmd eq 'submission' ? 'checked' : '').'> '.'<b>Current Resource:</b> For one or more students'. - '<br /> -->For students with '. - '<input type="radio" name="submitonly" value="yes" '. - ($saveSub eq 'yes' ? 'checked' : '').' /> submissions or '. - '<input type="radio" name="submitonly" value="all" '. - ($saveSub eq 'all' ? 'checked' : '').' /> for all</td></tr>'."\n"; + ($saveCmd eq 'submission' ? 'checked' : '').'> '.'<b>Current Resource:</b> For one or more students '. + '<select name="submitonly">'. + '<option value="yes" '. + ($saveSub eq 'yes' ? 'selected="on"' : '').'>with submissions</option>'. + '<option value="graded" '. + ($saveSub eq 'graded' ? 'selected="on"' : '').'>with ungraded submissions</option>'. + '<option value="all" '. + ($saveSub eq 'all' ? 'selected="on"' : '').'>with any status</option></select></td></tr>'."\n"; $result.='<tr bgcolor="#ffffe6"valign="top"><td>'. '<input type="radio" name="radioChoice" value="viewgrades" '. @@ -3579,9 +3808,9 @@ sub handler { undef(%perm); if ($ENV{'browser.mathml'}) { - $request->content_type('text/xml'); + &Apache::loncommon::content_type($request,'text/xml'); } else { - $request->content_type('text/html'); + &Apache::loncommon::content_type($request,'text/html'); } $request->send_http_header; return '' if $request->header_only; @@ -3591,7 +3820,7 @@ sub handler { my $command=$ENV{'form.command'}; if (!$url) { my ($temp1,$temp2); - ($temp1,$temp2,$ENV{'form.url'})=split(/___/,$symb); + ($temp1,$temp2,$ENV{'form.url'})=&Apache::lonnet::decode_symb($symb); $url = $ENV{'form.url'}; } &send_header($request); @@ -3604,7 +3833,7 @@ sub handler { my ($tsymb,$tuname,$tudom,$tcrsid)= &Apache::lonnet::checkin($token); if ($tsymb) { - my ($map,$id,$url)=split(/\_\_\_/,$tsymb); + my ($map,$id,$url)=&Apache::lonnet::decode_symb($tsymb); if (&Apache::lonnet::allowed('mgr',$tcrsid)) { $request->print(&Apache::lonnet::ssi_body('/res/'.$url, ('grade_username' => $tuname, @@ -3676,6 +3905,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_process' && $perm{'mgr'}) { $request->print(&scantron_process_students($request)); } elsif ($command) {