Merge pull request #302 from mgage/develop_multiAnswer_fix

Develop multi answer fix

lib/PGcore.pm

@@ -491,6 +491,8 @@ sub record_array_name {  # currently the same as record ans name
 	$label;
 
 }
+
+
 sub extend_ans_group {         # modifies the group type
 	my $self = shift;
 	my $label = shift;
@@ -507,6 +509,7 @@ sub extend_ans_group {         # modifies the group type
     }
     $label;
 }
+
 sub record_unlabeled_ans_name {
 	my $self = shift;
     $self->{unlabeled_answer_blank_count}++;

lib/Value/AnswerChecker.pm

@@ -396,24 +396,31 @@ sub ans_matrix {
   $self->{ans_name} = $ename;
   $self->{ans_rows} = $rows;
   $self->{ans_cols} = $cols;
+  # warn "ans_matrix: ename=$ename answer_group_name=$options{answer_group_name}";
   my @array = ();
   foreach my $i (0..$rows-1) {
     my @row = ();
     foreach my $j (0..$cols-1) {
       my $label;
       if ($options{aria_label}) {
-	$label = $options{aria_label}.'row '.($i+1).' col '.($j+1);
+		$label = $options{aria_label}.'row '.($i+1).' col '.($j+1);
       } else {
-	$label = pgCall('generate_aria_label',ANS_NAME($ename,$i,$j));
+		$label = pgCall('generate_aria_label',ANS_NAME($ename,$i,$j));
       }
+      my $answer_group_name = $options{answer_group_name}//$name;
       if ($i == 0 && $j == 0) {
-	if ($extend) {
-	  push(@row,&$named_extension($name,$size,ans_label=>$name,aria_label=>$label));
-	} else {
-	  push(@row,&$named_ans_rule($name,$size,aria_label=>$label));
-	}
-      } else {
-	push(@row,&$named_extension(ANS_NAME($ename,$i,$j),$size,ans_label=>$name,aria_label=>$label));
+		if ($extend) {  
+		  push(@row,&$named_extension($name,$size,
+				answer_group_name=> $answer_group_name,
+				aria_label=>$label)
+		  );
+		} else {
+		  push(@row,&$named_ans_rule($name,$size,aria_label=>$label));
+		}
+      } else { 
+		push(@row,&$named_extension(ANS_NAME($ename,$i,$j),$size,
+			 answer_group_name => $answer_group_name,
+			 aria_label=>$label));
       }
     }
     push(@array,[@row]);

macros/PG.pl

@@ -300,16 +300,18 @@ sub CLEAR_RESPONSES {
 	}
 	'';
 }
+
+#FIXME -- examine the difference between insert_response and extend_response
 sub INSERT_RESPONSE { 
 	my $ans_label  = shift;
 	my $response_label = shift;
 	my $ans_value  = shift;
 	my $selected   = shift;
-	# warn "\n\nanslabel $ans_label responselabel $response_label value $ans_value";
+	# warn "\n\nin PG.pl\nanslabel $ans_label responselabel $response_label value $ans_value";
 	if (defined ($PG->{PG_ANSWERS_HASH}->{$ans_label}) ) {
 		my $responsegroup = $PG->{PG_ANSWERS_HASH}->{$ans_label}->{response};
 		$responsegroup->append_response($response_label, $ans_value, $selected);
-		#warn "\n$responsegroup responses are now ", $responsegroup->responses;
+		# warn "There are  ", scalar($responsegroup->responses), " $responsegroup responses." ;
 	}
     '';
 }
@@ -319,14 +321,15 @@ sub EXTEND_RESPONSE { # for radio buttons and checkboxes
 	my $response_label = shift;
 	my $ans_value  = shift;
 	my $selected   = shift;
-	# warn "\n\nanslabel $ans_label responselabel $response_label value $ans_value";
+	# warn "\n\nin PG.pl \nanslabel $ans_label responselabel $response_label value $ans_value";
 	if (defined ($PG->{PG_ANSWERS_HASH}->{$ans_label}) ) {
 		my $responsegroup = $PG->{PG_ANSWERS_HASH}->{$ans_label}->{response};
 		$responsegroup->extend_response($response_label, $ans_value,$selected);
-		#warn "\n$responsegroup responses are now ", pretty_print($response_group);
+		# warn "\n$responsegroup responses are now ", pretty_print($response_group);
 	}
     '';
 }
+
 sub ENDDOCUMENT {
 	# check that answers match
 	# gather up PG_FLAGS elements

macros/PGbasicmacros.pl

@@ -447,7 +447,7 @@ sub NAMED_ANS_RULE_OPTION {   # deprecated
 }
 
 sub NAMED_ANS_RULE_EXTENSION {
-	my $name = shift;
+	my $name = shift;   # this is the name of the response item
 	my $col = shift;
 	my %options = @_;
 
@@ -457,7 +457,13 @@ sub NAMED_ANS_RULE_EXTENSION {
 	} else {
 	    $label = generate_aria_label($name);
 	}
-
+	# this is the name of the parent answer group
+	my $answer_group_name = $options{answer_group_name}//''; 
+	unless ($answer_group_name) {
+		WARN_MESSAGE("Error in NAMED_ANSWER_RULE_EXTENSION: every call to this subroutine needs
+		to have \$options{answer_group_name} defined. Answer blank name: $name");
+	}
+    # warn "from named answer rule extension in PGbasic answer_group_name: |$answer_group_name|";
 	my $answer_value = '';
 	$answer_value = ${$inputs_ref}{$name} if defined(${$inputs_ref}{$name});
 	if ( defined( $rh_sticky_answers->{$name} ) ) {
@@ -466,7 +472,9 @@ sub NAMED_ANS_RULE_EXTENSION {
 	}
 #	$answer_value =~ tr/\\$@`//d;   #`## make sure student answers can not be interpolated by e.g. EV3
 	$answer_value =~ s/\s+/ /g;     ## remove excessive whitespace from student answer
-	INSERT_RESPONSE($name,$name,$answer_value);  #FIXME hack -- this needs more work to decide how to make it work
+	# warn "from NAMED_ANSWER_RULE_EXTENSION in PGbasic: 
+	# 	answer_group_name: |$answer_group_name| name: |$name| answer value: |$answer_value|";
+	INSERT_RESPONSE($answer_group_name,$name,$answer_value);  #FIXME hack -- this needs more work to decide how to make it work
 	$answer_value = encode_pg_and_html($answer_value);
 
 	my $tcol = $col/2 > 3 ? $col/2 : 3;  ## get max
@@ -1092,8 +1100,23 @@ sub NAMED_ANS_ARRAY_EXTENSION{
 
 #	$answer_value =~ tr/\\$@`//d;   #`## make sure student answers can not be interpolated by e.g. EV3
 #	warn "ans_label $options{ans_label} $name $answer_value";
-	if (defined($options{ans_label}) ) {
-		INSERT_RESPONSE($options{ans_label}, $name, $answer_value);
+    my $answer_group_name; # the name of the answer evaluator controlling this collection of responses.
+    # catch deprecated use of ans_label to pass answer_group_name
+    if (defined($options{ans_label})) {
+    	WARN_MESSAGE("Error in NAMED_ANS_ARRAY_EXTENSION: the answer group name should be passed in ",
+    		"\%options using answer_group_name=>\$answer_group_name",
+    		"The use of ans_label=>\$answer_group_name is deprecated.",
+    		"Answer blank name: $name"
+    		);
+    	$answer_group_name = $options{ans_label};
+    }
+	if (defined($options{answer_group_name}) ) {
+		$answer_group_name = $options{answer_group_name};
+	}
+	if ($answer_group_name) {
+		INSERT_RESPONSE($options{answer_group_name}, $name, $answer_value);
+	} else {
+		WARN_MESSAGE("Error: answer_group_name must be defined for $name");
 	}
 	$answer_value = encode_pg_and_html($answer_value);
 

macros/parserMultiAnswer.pl

@@ -450,9 +450,16 @@ sub ans_rule {
       my $label = main::generate_aria_label($answerPrefix.$name."_0");
       return $data->named_ans_rule($name,$size,@_,aria_label=>$label);
   }
-  return $data->named_ans_rule_extension($self->NEW_NAME($name),$size,@_)
-    if ($self->{singleResult} && $self->{part} > 1);
-  return $data->named_ans_rule($name,$size,@_);
+  if ($self->{singleResult} && $self->{part} > 1) {
+  	 my $extension_ans_rule = 
+  	 	$data->named_ans_rule_extension(
+  	 	$name,$size, answer_group_name => $self->{answerName}, 
+  	 	@_);
+  	 # warn "extension rule created: $extension_ans_rule for ", ref($data);
+  	 return $extension_ans_rule; 
+  } else {
+  	 return $data->named_ans_rule($name,$size,@_);
+  }
 }
 
 #
@@ -466,10 +473,14 @@ sub ans_array {
   my $name = $self->ANS_NAME($self->{part}++);
   if ($self->{singleResult} && $self->{part} == 1) {
       my $label = main::generate_aria_label($answerPrefix.$name."_0");
-      return $data->named_ans_array($name,$size,@_,aria_label=>$label);
+      return $data->named_ans_array($name,$size,
+             answer_group_name => $self->{answerName},
+             @_,aria_label=>$label);
   }
   if ($self->{singleResult} && $self->{part} > 1) {
-    $HTML = $data->named_ans_array_extension($self->NEW_NAME($name),$size,@_);
+    $HTML = $data->named_ans_array_extension($self->NEW_NAME($name),$size,
+      answer_group_name => $self->{answerName}, @_);
+    # warn "array extension rule created: $HTML for ", ref($data);
   } else {
     $HTML = $data->named_ans_array($name,$size,@_);
   }