--- loncom/homework/grades.pm 2003/11/06 15:22:33 1.147 +++ loncom/homework/grades.pm 2003/11/07 19:25:26 1.152 @@ -1,7 +1,7 @@ # The LearningOnline Network with CAPA # The LON-CAPA Grading handler # -# $Id: grades.pm,v 1.147 2003/11/06 15:22:33 albertel Exp $ +# $Id: grades.pm,v 1.152 2003/11/07 19:25:26 albertel Exp $ # # Copyright Michigan State University Board of Trustees # @@ -177,26 +177,87 @@ sub showResourceInfo { 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)); + (undef,$subresult)=split(/_HASH_REF__/,$subresult,2); + 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'}, @@ -604,8 +665,9 @@ LISTJAVASCRIPT my ($foo,$partid,$foo1) = split(/\./,$_); if ($status{'resource.'.$partid.'.submitted_by'} ne '') { $submitted = 0; + my ($part)=split(/\./,$partid); $gradeTable.='<input type="hidden" name="'. - $student.':submitted_by" value="'. + $student.':'.$part.':submitted_by" value="'. $status{'resource.'.$partid.'.submitted_by'}.'" />'; } } @@ -1471,8 +1533,10 @@ KEYWORDS $result.=$$fullname{$_}.' '; } $result.='<br />'."\n"; + my ($part)=split(/\./,$_); $result.='<input type="hidden" name="collaborator'.$counter. - '" value="'.(join ':',@goodcollaborators).'" />'."\n"; + '" value="'.$part.':'.(join ':',@goodcollaborators).'" />'. + "\n"; } if (scalar(@badcollaborators) > 0) { $result.='<table border="0"><tr bgcolor="#ffbbbb"><td>'; @@ -1498,78 +1562,78 @@ KEYWORDS # (3) Last submission plus the parts info # (4) The whole record for this student if ($ENV{'form.lastSub'} =~ /^(lastonly|hdgrade)$/) { - if ($ENV{'form.'.$uname.':'.$udom.':submitted_by'}) { - my $submitby=''. - '<b>Collaborative submission by: </b>'. - '<a href="javascript:viewSubmitter(\''. - $ENV{'form.'.$uname.':'.$udom.':submitted_by'}. - '\')"; TARGET=_self>'. - $$fullname{$ENV{'form.'.$uname.':'.$udom.':submitted_by'}}.'</a>'; - $request->print($submitby); + my ($string,$timestamp)= &get_last_submission(\%record); + my $lastsubonly=''. + ($$timestamp eq '' ? '' : '<b>Date Submitted:</b> '. + $$timestamp)."</td></tr>\n"; + if ($$timestamp eq '') { + $lastsubonly.='<tr><td bgcolor="#ffffe6">'.$$string[0]; } else { - my ($string,$timestamp)= &get_last_submission(\%record); - my $lastsubonly=''. - ($$timestamp eq '' ? '' : '<b>Date Submitted:</b> '. - $$timestamp)."</td></tr>\n"; - if ($$timestamp eq '') { - $lastsubonly.='<tr><td bgcolor="#ffffe6">'.$$string[0]; - } else { - for my $part (sort keys(%$handgrade)) { - my ($partid,$respid) = split(/_/,$part); - my $responsetype = $responseType->{$partid}->{$respid}; - if (!exists($record{'resource.'.$partid.'.'.$respid.'.submission'})) { + my %seenparts; + for my $part (sort keys(%$handgrade)) { + my ($partid,$respid) = split(/_/,$part); + if ($ENV{"form.$uname:$udom:$partid:submitted_by"}) { + if (exists($seenparts{$partid})) { next; } + $seenparts{$partid}=1; + my $submitby='<b>Part '.$partid. + ' Collaborative submission by: </b>'. + '<a href="javascript:viewSubmitter(\''. + $ENV{"form.$uname:$udom:$partid:submitted_by"}. + '\')"; TARGET=_self>'. + $$fullname{$ENV{"form.$uname:$udom:$partid:submitted_by"}}.'</a><br />'; + $request->print($submitby); + next; + } + 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. + ' )</font> '. + '<font color="red">Nothing submitted - no attempts</font><br /><br />'; + next; + } + foreach (@$string) { + my ($partid,$respid) = /^resource\.([^\.]*)\.([^\.]*)\.submission/; + if ($part ne ($partid.'_'.$respid)) { next; } + my ($ressub,$subval) = split(/:/,$_,2); + # Similarity check + my $similar=''; + if($ENV{'form.checkPlag'}){ + my ($oname,$odom,$ocrsid,$oessay,$osim)= + &most_similar($uname,$udom,$subval); + if ($osim) { + $osim=int($osim*100.0); + $similar="<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); + 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. - ' )</font> '. - '<font color="red">Nothing submitted - no attempts</font><br /><br />'; - } else { - foreach (@$string) { - my ($partid,$respid) = /^resource\.(\w+)\.(\w+)\.submission/; - if ($part eq ($partid.'_'.$respid)) { - my ($ressub,$subval) = split(/:/,$_,2); - # Similarity check - my $similar=''; - my $oname; - my $odom; - my $ocrsid; - my $oessay; - my $osim; - if($ENV{'form.checkPlag'}){ - ($oname,$odom,$ocrsid,$oessay,$osim)=&most_similar($uname,$udom,$subval); - if ($osim) { - $osim=int($osim*100.0); - $similar='<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 />'; - } - } - $lastsubonly.='<tr><td bgcolor="#ffffe6"><b>Part '. - $partid.'</b> <font color="#999999">( ID '.$respid. - ' )</font> '. - ($record{"resource.$partid.$respid.uploadedurl"}? - '<a href="'. - &Apache::lonnet::tokenwrapper($record{"resource.$partid.$respid.uploadedurl"}). - '"><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 />':''). - '<b>Submitted Answer: </b>'. - &cleanRecord($subval,$responsetype,$symb). - '<br /><br />'.$similar."\n" - if ($ENV{'form.lastSub'} eq 'lastonly' || - ($ENV{'form.lastSub'} eq 'hdgrade' && - $$handgrade{$part} =~ /:yes$/)); - } + ' )</font> '; + if ($record{"resource.$partid.$respid.uploadedurl"}) { + $lastsubonly.='<a href="'.&Apache::lonnet::tokenwrapper($record{"resource.$partid.$respid.uploadedurl"}).'"><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, + $respid,\%record,$order); + if ($similar) {$lastsubonly.="<br /><br />$similar\n";} } } } - $lastsubonly.='</td></tr><tr bgcolor="#ffffff"><td>'."\n"; - $request->print($lastsubonly); } + $lastsubonly.='</td></tr><tr bgcolor="#ffffff"><td>'."\n"; + $request->print($lastsubonly); } elsif ($ENV{'form.lastSub'} eq 'datesub') { my (undef,$responseType,undef,$parts) = &showResourceInfo($url); - $request->print(&displaySubByDates(\$symb,\%record,$parts,$responseType,$checkIcon)); + $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'}, @@ -1742,18 +1806,26 @@ sub processHandGrade { $ENV{'form.msgsub'},$message); } if ($ENV{'form.collaborator'.$ctr}) { - my (@collaborators) = split(/:/,$ENV{'form.collaborator'.$ctr}); - foreach (@collaborators) { - my ($errorflag,$pts,$wgt) = - &saveHandGrade($request,$url,$symb,$_,$udom,$ctr,$ENV{'form.unamedom'.$ctr}); - if ($errorflag eq 'not_allowed') { - $request->print("<font color=\"red\">Not allowed to modify grades for $_:$udom</font>"); - next; - } else { - if ($message ne '') { - $msgstatus = &Apache::lonmsg::user_normal_msg ($_,$udom, - $ENV{'form.msgsub'}, - $message); + my @collabstrs; + if (ref($ENV{'form.collaborator'.$ctr}) eq 'ARRAY') { + @collabstrs=@{$ENV{'form.collaborator'.$ctr}}; + } else { + @collabstrs=$ENV{'form.collaborator'.$ctr}; + } + foreach my $collabstr (@collabstrs) { + my ($part,@collaborators) = split(/:/,$collabstr); + foreach (@collaborators) { + my ($errorflag,$pts,$wgt) = + &saveHandGrade($request,$url,$symb,$_,$udom,$ctr, + $ENV{'form.unamedom'.$ctr},$part); + if ($errorflag eq 'not_allowed') { + $request->print("<font color=\"red\">Not allowed to modify grades for $_:$udom</font>"); + next; + } else { + if ($message ne '') { + $msgstatus = &Apache::lonmsg::user_normal_msg($_,$udom,$ENV{'form.msgsub'},$message); + } + } } } @@ -1905,7 +1977,7 @@ sub processHandGrade { #---- Save the score and award for each student, if changed sub saveHandGrade { - my ($request,$url,$symb,$stuname,$domain,$newflg,$submitter) = @_; + my ($request,$url,$symb,$stuname,$domain,$newflg,$submitter,$part) = @_; my $usec = &Apache::lonnet::getsection($domain,$stuname, $ENV{'request.course.id'}); if (!&canmodify($usec)) { return('not_allowed'); } @@ -1913,6 +1985,8 @@ sub saveHandGrade { my %newrecord = (); my ($pts,$wgt) = ('',''); foreach (split(/:/,$ENV{'form.partlist'.$newflg})) { + #collaborator may vary for different parts + if ($submitter && $_ ne $part) { next; } my $dropMenu = $ENV{'form.GD_SEL'.$newflg.'_'.$_}; if ($dropMenu eq 'excused') { if ($record{'resource.'.$_.'.solved'} ne 'excused') { @@ -1948,6 +2022,7 @@ sub saveHandGrade { $newrecord{$reckey} = 'correct_by_override' if ($record{$reckey} ne 'correct_by_override'); } + $newrecord{'resource.'.$_.'.submitted_by'} = $submitter if ($submitter && ($record{'resource.'.$_.'.submitted_by'} ne $submitter)); $newrecord{'resource.'.$_.'.regrader'}="$ENV{'user.name'}:$ENV{'user.domain'}"; @@ -3002,7 +3077,7 @@ sub displayPage { } $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') { @@ -3038,7 +3113,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>'. @@ -3046,6 +3121,7 @@ sub displaySubByDates { '<td><b>Status </b></td></tr>'; my ($version); my %mark; + my %orders; $mark{'correct_by_student'} = $checkIcon; if (!exists($$record{'1:timestamp'})) { return '<br /> <font color="red">Nothing submitted - no attempts</font><br />'; @@ -3070,10 +3146,14 @@ sub displaySubByDates { $displaySub[0].='Trial '. $$record{"$version:resource.$partid.tries"}; } - &Apache::lonnet::logthis("Part is $partid responseType is ".join(':',%$responseType)); 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,$$symbx).'<br />'; + &cleanRecord($$record{$version.':'.$matchKey},$responseType,$symb,$partid,$responseId,$record,$orders{$partid}->{$responseId},"$version:").'<br />'; } } if (exists $$record{"$version:resource.$partid.award"}) { @@ -3858,6 +3938,11 @@ sub send_header { #remotewindow.close(); #</script>"); $request->print(&Apache::loncommon::bodytag('Grading')); + foreach my $key (sort(keys(%ENV))) { + if ($key =~ /^form\./) { + Apache->request->print("$key => $ENV{$key} <br />"); + } + } } sub send_footer {