[LON-CAPA-cvs] cvs: loncom /homework grades.pm

albertel lon-capa-cvs@mail.lon-capa.org
Thu, 14 Sep 2006 21:47:23 -0000


albertel		Thu Sep 14 17:47:23 2006 EDT

  Modified files:              
    /loncom/homework	grades.pm 
  Log:
  - Fix more of BUG#5016, resp/part ids with _ in them were not being handled properly
  
  
  
Index: loncom/homework/grades.pm
diff -u loncom/homework/grades.pm:1.374 loncom/homework/grades.pm:1.375
--- loncom/homework/grades.pm:1.374	Thu Sep 14 13:52:22 2006
+++ loncom/homework/grades.pm	Thu Sep 14 17:47:22 2006
@@ -1,7 +1,7 @@
 # The LearningOnline Network with CAPA
 # The LON-CAPA Grading handler
 #
-# $Id: grades.pm,v 1.374 2006/09/14 17:52:22 albertel Exp $
+# $Id: grades.pm,v 1.375 2006/09/14 21:47:22 albertel Exp $
 #
 # Copyright Michigan State University Board of Trustees
 #
@@ -123,7 +123,7 @@
     foreach (split(/,/,&Apache::lonnet::metadata($url,'packages'))) {
 	if (/^\w+response_.*/ || /^Task_/) {
 	    my ($responsetype,$part) = split(/_/,$_,2);
-	    my ($partid,$respid) = split(/_/,$part);
+	    my ($partid,$respid) = split(/_/,$part,2);
 	    if ($responsetype eq 'Task') { $respid='0'; }
 	    if (&Apache::loncommon::check_if_partid_hidden($partid,$symb)) {
 		next;
@@ -144,6 +144,18 @@
     return (\@partlist,\%handgrade,\%responseType);
 }
 
+sub flatten_responseType {
+    my ($responseType) = @_;
+    my @part_response_id =
+	map { 
+	    my $part = $_;
+	    map {
+		[$part,$_]
+		} sort(keys(%{ $responseType->{$part} }));
+	} sort(keys(%$responseType));
+    return @part_response_id;
+}
+
 sub get_display_part {
     my ($partID,$symb)=@_;
     my $display=&Apache::lonnet::EXT('resource.'.$partID.'.display',$symb);
@@ -168,25 +180,26 @@
     my %resptype = ();
     my $hdgrade='no';
     my %partsseen;
-    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>';
-	if ($checkboxes) {
-	    if (exists($partsseen{$partID})) {
-		$result.="<td>&nbsp;</td>";
-	    } else {
-		$result.="<td><input type='checkbox' name='vPart' value='$partID' checked='on' /></td>";
+    foreach my $partID (sort keys(%$responseType)) {
+	foreach my $resID (sort keys(%{ $responseType->{$partID} })) {
+	    my $handgrade=$$handgrade{$partID.'_'.$resID};
+	    my $responsetype = $responseType->{$partID}->{$resID};
+	    $hdgrade = $handgrade if ($handgrade eq 'yes');
+	    $result.='<tr>';
+	    if ($checkboxes) {
+		if (exists($partsseen{$partID})) {
+		    $result.="<td>&nbsp;</td>";
+		} else {
+		    $result.="<td><input type='checkbox' name='vPart' value='$partID' checked='on' /></td>";
+		}
+		$partsseen{$partID}=1;
 	    }
-	    $partsseen{$partID}=1;
-	}
-	my $display_part=&get_display_part($partID,$symb);
-	$result.='<td><b>Part: </b>'.$display_part.' <font color="#999999">'.
-	    $resID.'</font></td>'.
-	    '<td><b>Type: </b>'.$responsetype.'</td></tr>';
+	    my $display_part=&get_display_part($partID,$symb);
+	    $result.='<td><b>Part: </b>'.$display_part.' <font color="#999999">'.
+		$resID.'</font></td>'.
+		'<td><b>Type: </b>'.$responsetype.'</td></tr>';
 #	    '<td><b>Handgrade: </b>'.$handgrade.'</td></tr>';
+	}
     }
     $result.='</table>'."\n";
     return $result,$responseType,$hdgrade,$partlist,$handgrade;
@@ -1538,10 +1551,11 @@
     my ($symb,$uname,$udom,$counter,$partid,$record) = @_;
     my ($partlist,$handgrade,$responseType) = &response_type($symb);
     my (@respids);
-    foreach my $part_resp (sort(keys(%$handgrade))) {
-        my ($part,$resp) = split(/_/,$part_resp);
+     my @part_response_id = &flatten_responseType($responseType);
+    foreach my $part_response_id (@part_response_id) {
+    	my ($part,$resp) = @{ $part_response_id };
         if ($part eq $partid) {
-            push @respids,$resp;
+            push(@respids,$resp);
         }
     }
     my $result;
@@ -1858,8 +1872,9 @@
 	    $lastsubonly.='<tr><td bgcolor="#ffffe6">'.$$string[0]; 
 	} else {
 	    my %seenparts;
-	    for my $part (sort keys(%$handgrade)) {
-		my ($partid,$respid) = split(/_/,$part);
+	    my @part_response_id = &flatten_responseType($responseType);
+	    foreach my $part (@part_response_id) {
+		my ($partid,$respid) = @{ $part };
 		my $display_part=&get_display_part($partid,$symb);
 		if ($env{"form.$uname:$udom:$partid:submitted_by"}) {
 		    if (exists($seenparts{$partid})) { next; }
@@ -1883,7 +1898,7 @@
 		}
 		foreach (@$string) {
 		    my ($partid,$respid) = /^resource\.([^\.]*)\.([^\.]*)\.submission/;
-		    if ($part ne ($partid.'_'.$respid)) { next; }
+		    if (join('_',@{$part}) ne ($partid.'_'.$respid)) { next; }
 		    my ($ressub,$subval) = split(/:/,$_,2);
 		    # Similarity check
 		    my $similar='';
@@ -1993,8 +2008,10 @@
     my %seen = ();
     my @partlist;
     my @gradePartRespid;
-    for my $part_resp (sort(keys(%$handgrade))) {
-	my ($partid,$respid) = split(/_/, $part_resp);
+    my @part_response_id = &flatten_responseType($responseType);
+    foreach my $part_response_id (@part_response_id) {
+    	my ($partid,$respid) = @{ $part_response_id };
+	my $part_resp = join('_',@{ $part_response_id });
 	next if ($seen{$partid} > 0);
 	$seen{$partid}++;
 	next if ($$handgrade{$part_resp} =~ /:no$/ && $env{'form.lastSub'} =~ /^(hdgrade)$/);
@@ -2440,8 +2457,11 @@
     my ($request,$symb,$stuname,$domain,$newflg,$new_part,$newrecord) = @_;
     my $portfolio_root = &propath($domain,$stuname).'/userfiles/portfolio';
     my ($partlist,$handgrade,$responseType) = &response_type($symb);
-        foreach my $part_resp (sort(keys(%$handgrade))) {
-            my ($part_id, $resp_id) = split(/_/,$part_resp);
+
+    my @part_response_id = &flatten_responseType($responseType);
+    foreach my $part_response_id (@part_response_id) {
+    	my ($part_id,$resp_id) = @{ $part_response_id };
+	my $part_resp = join('_',@{ $part_response_id });
             if (($env{'form.'.$newflg.'_'.$part_resp.'_returndoc1'}) && ($new_part == $part_id)) {
                 # if multiple files are uploaded names will be 'returndoc2','returndoc3'
                 my $file_counter = 1;
@@ -2874,16 +2894,18 @@
 	'<table border=0><tr bgcolor="#ffffdd"><td>';
     #radio buttons/text box for assigning points for a section or class.
     #handles different parts of a problem
-    my ($partlist,$handgrade) = &response_type($symb);
+    my ($partlist,$handgrade,$responseType) = &response_type($symb);
     my %weight = ();
     my $ctsparts = 0;
     $result.='<table border="0">';
     my %seen = ();
-    for (sort keys(%$handgrade)) {
-	my ($partid,$respid) = split (/_/,$_,2);
+    my @part_response_id = &flatten_responseType($responseType);
+    foreach my $part_response_id (@part_response_id) {
+    	my ($partid,$respid) = @{ $part_response_id };
+	my $part_resp = join('_',@{ $part_response_id });
 	next if $seen{$partid};
 	$seen{$partid}++;
-	my $handgrade=$$handgrade{$_};
+	my $handgrade=$$handgrade{$part_resp};
 	my $wgt = &Apache::lonnet::EXT('resource.'.$partid.'.weight',$symb);
 	$weight{$partid} = $wgt eq '' ? '1' : $wgt;