--- loncom/homework/grades.pm 2003/10/28 23:20:03 1.145 +++ loncom/homework/grades.pm 2003/11/07 19:10:51 1.150 @@ -1,7 +1,7 @@ # The LearningOnline Network with CAPA # The LON-CAPA Grading handler # -# $Id: grades.pm,v 1.145 2003/10/28 23:20:03 albertel Exp $ +# $Id: grades.pm,v 1.150 2003/11/07 19:10:51 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); + } + } + } + } + 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 @parts; + return @stores; } # --- Get the symbolic name of a problem and the url @@ -115,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 @@ -137,42 +160,104 @@ 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)); + (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.''; - 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'}, @@ -580,8 +665,9 @@ LISTJAVASCRIPT my ($foo,$partid,$foo1) = split(/\./,$_); if ($status{'resource.'.$partid.'.submitted_by'} ne '') { $submitted = 0; + my ($part)=split(/\./,$partid); $gradeTable.=''; } } @@ -1400,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 ? '' : '
')); @@ -1447,8 +1533,10 @@ KEYWORDS $result.=$$fullname{$_}.'     '; } $result.='
'."\n"; + my ($part)=split(/\./,$_); $result.=''."\n"; + '" value="'.$part.':'.(join ':',@goodcollaborators).'" />'. + "\n"; } if (scalar(@badcollaborators) > 0) { $result.='\n"; if ($$timestamp eq '') { $lastsubonly.='
'; @@ -1474,25 +1562,29 @@ 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=''. - 'Collaborative submission by: '. - ''. - $$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)."
'.$$string[0]; } else { + my %seenparts; for my $part (sort keys(%$handgrade)) { - my ($responsetype,$foo) = split(/:/,$$handgrade{$part}); my ($partid,$respid) = split(/_/,$part); + if ($ENV{"form.$uname:$udom:$partid:submitted_by"}) { + if (exists($seenparts{$partid})) { next; } + $seenparts{$partid}=1; + my $submitby='Part '.$partid. + ' Collaborative submission by: '. + ''. + $$fullname{$ENV{"form.$uname:$udom:$partid:submitted_by"}}.'
'; + $request->print($submitby); + next; + } + my $responsetype = $responseType->{$partid}->{$respid}; if (!exists($record{'resource.'.$partid.'.'.$respid.'.submission'})) { $lastsubonly.='
Part '. $partid.' ( ID '.$respid. @@ -1500,7 +1592,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 @@ -1520,6 +1612,7 @@ KEYWORDS &keywords_highlight($oessay).'
'; } } + my $order=&get_order($partid,$respid,$symb,$uname,$udom); $lastsubonly.='
Part '. $partid.' ( ID '.$respid. ' )   '. @@ -1530,11 +1623,11 @@ 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' && - $$handgrade{$part} =~ /:yes$/)); + $$handgrade{$part} eq 'yes')); } } } @@ -1542,10 +1635,9 @@ KEYWORDS } $lastsubonly.='
'."\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'}, @@ -1718,18 +1810,27 @@ 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("Not allowed to modify grades for $_:$udom"); - next; - } else { - if ($message ne '') { - $msgstatus = &Apache::lonmsg::user_normal_msg ($_,$udom, - $ENV{'form.msgsub'}, - $message); + &Apache::lonnet::logthis('collab '.(join(':',@{ $ENV{'form.collaborator'.$ctr} }))); + 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("Not allowed to modify grades for $_:$udom"); + next; + } else { + if ($message ne '') { + $msgstatus = &Apache::lonmsg::user_normal_msg($_,$udom,$ENV{'form.msgsub'},$message); + } + } } } @@ -1881,7 +1982,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'); } @@ -1889,6 +1990,9 @@ sub saveHandGrade { my %newrecord = (); my ($pts,$wgt) = ('',''); foreach (split(/:/,$ENV{'form.partlist'.$newflg})) { + &Apache::lonnet::logthis("-$submitter-$stuname-$part-$_"); + #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') { @@ -1924,6 +2028,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'}"; @@ -2151,7 +2256,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; @@ -2193,7 +2298,7 @@ sub viewgrades { $result.= '
'."\n". ''. '\n"; - my (@parts) = sort(&getpartlist($url)); + my (@parts) = sort(&getpartlist($url,$symb)); foreach my $part (@parts) { my $display=&Apache::lonnet::metadata($url,$part.'.display'); $display =~ s|^Number of Attempts|Tries
|; # makes the column narrower @@ -2310,7 +2415,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}; @@ -2575,8 +2680,8 @@ ENDPICK } 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; @@ -2659,7 +2764,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); @@ -2970,9 +3075,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' : ''); @@ -3007,7 +3119,7 @@ sub displayPage { } sub displaySubByDates { - my ($symbx,$record,$parts,$responseType,$checkIcon) = @_; + my ($symb,$record,$parts,$responseType,$checkIcon,$uname,$udom) = @_; my $studentTable='
 No. '.&nameUserString('header')."
'. ''. ''. @@ -3015,33 +3127,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; @@ -3803,6 +3944,11 @@ sub send_header { #remotewindow.close(); #"); $request->print(&Apache::loncommon::bodytag('Grading')); + foreach my $key (sort(keys(%ENV))) { + if ($key =~ /^form\./) { + Apache->request->print("$key => $ENV{$key}
"); + } + } } sub send_footer {