--- loncom/homework/grades.pm 2003/11/04 19:38:09 1.146 +++ 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.146 2003/11/04 19:38:09 albertel Exp $ +# $Id: grades.pm,v 1.148 2003/11/07 08:56:52 albertel Exp $ # # Copyright Michigan State University Board of Trustees # @@ -133,9 +133,9 @@ 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)) { @@ -143,13 +143,15 @@ sub response_type { } $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 @@ -158,42 +160,105 @@ sub showResourceInfo { my ($url,$probTitle) = @_; my $result =''. ''."\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.=''. + $result.=''. ''; # ''; } $result.='
Current Resource: '.$probTitle.'
Part '.$partID.'
Part '.$partID.' '. + $resID.'Type: '.$responsetype.'
Handgrade: '.$handgrade.'
'."\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.''; - push @ans,$ans; + my ($answer,$response,$symb,$partid,$respid,$record,$order,$version) = @_; + my $grayFont = ''; + 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.=''.$answer{$foil}.' '; + } else { + $toprow.=''.$answer{$foil}.' '; + } + $bottomrow.=''.$grayFont.$foil.' '; } - my $grayFont = ''; return '
'. - ''. - ''. - '
Answer'. - (join '',@ans).'
'.$grayFont.'Option ID'.$grayFont. - (join ''.$grayFont,@IDs).'
'; - } - if ($response eq 'essay') { + 'Answer'.$toprow.''. + ''.$grayFont.'Option ID'. + $grayFont.$bottomrow.''.''; + } 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.=''.$item.' '; + $middlerow.=''.$grayFont.$answer{$foil}.' '; + } else { + $toprow.=''.$item.' '; + $middlerow.=''.$grayFont.$answer{$foil}.' '; + } + $bottomrow.=''.$grayFont.$foil.' '; + } + return '
'. + ''.$toprow.''. + ''. + $middlerow.''. + ''. + $bottomrow.''.'
Answer
'.$grayFont.'Item ID
'.$grayFont.'Option ID
'; + } 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.='true'; + } else { + $toprow.='true'; + } + } else { + $toprow.='false'; + } + $bottomrow.=''.$grayFont.$foil.' '; + } + return '
'. + ''.$toprow.''. + ''. + $grayFont.$bottomrow.''.'
Answer
'.$grayFont.'Option ID
'; + } elsif ($response eq 'essay') { if (! exists ($ENV{'form.'.$symb})) { my (%keyhash) = &Apache::lonnet::dump('nohist_handgrade', $ENV{'course.'.$ENV{'request.course.id'}.'.domain'}, @@ -1421,7 +1486,7 @@ KEYWORDS 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 ? '' : '
')); @@ -1504,7 +1569,7 @@ KEYWORDS $$fullname{$ENV{'form.'.$uname.':'.$udom.':submitted_by'}}.''; $request->print($submitby); } else { - my ($string,$timestamp)= &get_last_submission (\%record); + my ($string,$timestamp)= &get_last_submission(\%record); my $lastsubonly=''. ($$timestamp eq '' ? '' : 'Date Submitted: '. $$timestamp)."\n"; @@ -1512,8 +1577,8 @@ KEYWORDS $lastsubonly.=''.$$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.='Part '. $partid.' ( ID '.$respid. @@ -1521,7 +1586,7 @@ KEYWORDS 'Nothing submitted - no attempts

'; } 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 @@ -1541,6 +1606,7 @@ KEYWORDS &keywords_highlight($oessay).'
'; } } + my $order=&get_order($partid,$respid,$symb,$uname,$udom); $lastsubonly.='Part '. $partid.' ( ID '.$respid. ' )   '. @@ -1551,7 +1617,7 @@ KEYWORDS 'Like all files provided by users, '. 'this file may contain virusses
':''). 'Submitted Answer: '. - &cleanRecord($subval,$responsetype,$symb). + &cleanRecord($subval,$responsetype,$symb,$partid,$respid,\%record,$order). '

'.$similar."\n" if ($ENV{'form.lastSub'} eq 'lastonly' || ($ENV{'form.lastSub'} eq 'hdgrade' && @@ -1566,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'}, @@ -2172,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; @@ -2991,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' : ''); @@ -3028,7 +3101,7 @@ sub displayPage { } sub displaySubByDates { - my ($symbx,$record,$parts,$responseType,$checkIcon) = @_; + my ($symb,$record,$parts,$responseType,$checkIcon,$uname,$udom) = @_; my $studentTable='
'. ''. ''. @@ -3036,33 +3109,62 @@ sub displaySubByDates { ''; my ($version); my %mark; + my %orders; $mark{'correct_by_student'} = $checkIcon; - return '
 Nothing submitted - no attempts
' - if (!exists($$record{'1:timestamp'})); + if (!exists($$record{'1:timestamp'})) { + return '
 Nothing submitted - no attempts
'; + } for ($version=1;$version<=$$record{'version'};$version++) { my $timestamp = scalar(localtime($$record{$version.':timestamp'})); $studentTable.=''; 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]}) ? - 'Part '.$partid.' '. - ($$record{"$version:resource.$partid.tries"} eq '' ? 'Trial not counted' : - 'Trial '.$$record{"$version:resource.$partid.tries"}).'  '. - &cleanRecord($$record{$version.':'.$matchKey[0]},$$responseType{$partid},$$symbx).'
' : ''; - $displaySub[1].=(exists $$record{"$version:resource.$partid.award"}) ? - 'Part '.$partid.'  '. - lc($$record{"$version:resource.$partid.award"}).' '. - $mark{$$record{"$version:resource.$partid.solved"}}.'
' : ''; - $displaySub[2].=(exists $$record{"$version:resource.$partid.regrader"}) ? - $$record{"$version:resource.$partid.regrader"}.' (Part: '.$partid.')' : ''; - } - $displaySub[2].=(exists $$record{"$version:resource.regrader"}) ? - $$record{"$version:resource.regrader"} : ''; # needed because old essay regrader has not parts info - $studentTable.=''; + foreach my $matchKey (@matchKey) { + if (exists $$record{$version.':'.$matchKey}) { + my ($responseId)=($matchKey=~ /^resource\.\Q$partid\E\.(.*?)\.submission$/); + $displaySub[0].='Part '.$partid.' '; + $displaySub[0].='(ID '. + $responseId.') '; + 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].='  '. + &cleanRecord($$record{$version.':'.$matchKey},$responseType,$symb,$partid,$responseId,$record,$orders{$partid}->{$responseId},"$version:").'
'; + } + } + if (exists $$record{"$version:resource.$partid.award"}) { + $displaySub[1].='Part '.$partid.'  '. + lc($$record{"$version:resource.$partid.award"}).' '. + $mark{$$record{"$version:resource.$partid.solved"}}. + '
'; + } + if (exists $$record{"$version:resource.$partid.regrader"}) { + $displaySub[2].=$$record{"$version:resource.$partid.regrader"}. + ' (Part: '.$partid.')'; + } + } + # needed because old essay regrader has not parts info + if (exists $$record{"$version:resource.regrader"}) { + $displaySub[2].=$$record{"$version:resource.regrader"}; + } + $studentTable.=''; + } $studentTable.='
Date/TimeStatus 
'.$timestamp.''.$displaySub[0].' '.$displaySub[1]. - ($displaySub[2] eq '' ? '' : 'Manually graded by '.$displaySub[2]).' 
'.$displaySub[0].' '.$displaySub[1]; + if ($displaySub[2]) { + $studentTable.='Manually graded by '.$displaySub[2]; + } + $studentTable.=' 
'; return $studentTable;