diff --git a/lib/WebGUI/Asset/Wobject/Survey/SurveyJSON.pm b/lib/WebGUI/Asset/Wobject/Survey/SurveyJSON.pm index 2aa9e3a76..31330b1bc 100644 --- a/lib/WebGUI/Asset/Wobject/Survey/SurveyJSON.pm +++ b/lib/WebGUI/Asset/Wobject/Survey/SurveyJSON.pm @@ -651,8 +651,8 @@ sub update { $newQuestion = 1; # make note that a new question was created push @{ $self->questions($address) }, $object; } - # We need to update all of the answers to reflect the new questionType - if ( $properties->{questionType} ne $object->{questionType} ) { + # If questionType supplied, see if we need to update all of the answers to reflect the new questionType + if ( $properties->{questionType} && $properties->{questionType} ne $object->{questionType} ) { $self->updateQuestionAnswers( $address, $properties->{questionType} ); } } @@ -957,6 +957,11 @@ sub newAnswer { Remove all existing answers and add a default set of answers to a question, based on question type. +N.B. You probably don't want to call this method directly to update a question's questionType, as it +doesn't actually change the stored value of questionType. Instead, call: + + $surveyJSON->update( $address, { questionType => "some question type" } ); + =head3 $address See L<"Address Parameter">. Determines question to add answers to. @@ -1032,7 +1037,8 @@ sub getMultiChoiceBundle { my $self = shift; my ($type) = validate_pos( @_, { type => SCALAR | UNDEF } ); - return $self->{multipleChoiceTypes}->{$type}; + # Return a cloned copy of the bundle structure + return clone $self->{multipleChoiceTypes}->{$type}; } =head2 addAnswersToQuestion ($address, $answers) diff --git a/lib/WebGUI/Asset/Wobject/Survey/Test.pm b/lib/WebGUI/Asset/Wobject/Survey/Test.pm index 49da91428..87c77310d 100644 --- a/lib/WebGUI/Asset/Wobject/Survey/Test.pm +++ b/lib/WebGUI/Asset/Wobject/Survey/Test.pm @@ -305,20 +305,28 @@ sub _test_mc { my @tap; my $aIndex = 0; for my $spec (@specs) { + + # Reset responses between sub-tests $self->_resetResponses($rJSON); + # Test runs from $variable $rJSON->nextResponse($index); my $responses = {}; my $testCount = ++${$opts{testCount_ref}}; - # assume spec can only be a target - my $next = $spec; + my ($next, $tags); + if (ref $spec eq 'HASH') { + ($next, $tags) = @{$spec}{qw(next tags)}; + } else { + $next = $spec; + } my $answerAddress = "$address->[0]-$address->[1]-$aIndex"; my $answer = $answers->[$aIndex]; my $recordedAnswer = $answer->{recordedAnswer}; $responses->{$answerAddress} = $recordedAnswer; + $self->session->log->debug("Recording answer for mc question $variable at index $aIndex ($answerAddress) => $recordedAnswer"); push @tap, $self->_recordResponses( { responseJSON => $rJSON, @@ -328,6 +336,7 @@ sub _test_mc { next => $next, testCount => $testCount, what => "$variable mc answer " . ($aIndex + 1) . " jumps to $next", + tags => $tags, }); $aIndex++; @@ -351,6 +360,7 @@ sub _recordResponses { next => 1, testCount => 1, what => 0, + tags => 0, }); # assemble the top-level ingredients.. @@ -361,6 +371,7 @@ sub _recordResponses { my $next = $opts{next}; my $testCount = $opts{testCount}; my $what = $opts{what}; + my $tags = $opts{tags}; $rJSON->recordResponses($responses); @@ -369,28 +380,51 @@ sub _recordResponses { my $nextAddress = $surveyOrder->[$nextResponse]; my $nextSection = $rJSON->survey->section($nextAddress); my $nextQuestion = $rJSON->survey->question($nextAddress); - # Get the lowest section surveyOrderIndex from lookup my $got; my $svar = $nextSection->{variable}; my $qvar = $nextQuestion->{variable}; if ($surveyOrderIndexByVariableName->{$svar} == $nextResponse) { - $got = "$svar (<-- a section)"; - $got .= " and $qvar (<-- a question)" if $qvar; + $got = "'$svar' (<-- a section)"; + $got .= " and '$qvar' (<-- a question)" if $qvar; } elsif ($qvar) { - $got = "$qvar (<-- a question)"; + $got = "'$qvar' (<-- a question)"; } else { $got = 'Unknown!'; } - my $expectedNextResponse = $surveyOrderIndexByVariableName->{$next}; if ($nextResponse != $expectedNextResponse) { return fail($testCount, $what, <tags; + for my $tag (@$tags) { + my ($tagKey, $tagValue); + if (ref $tag eq 'HASH') { + ($tagKey, $tagValue) = @$tag; # individual tag spec only has one key and one value + } else { + ($tagKey, $tagValue) = ($tag, 1); # defaults to 1 (boolean truth flag) + } + if (!exists $currentTags->{$tagKey}) { + $self->session->log->debug("Tag not found: $tagKey"); + return fail($testCount, $what, "Tag not found: $tagKey"); + } + my $currentTagValue = $currentTags->{$tagKey}; + if ($currentTagValue != $tagValue) { + $self->session->log->debug("Incorrect tag value: $currentTagValue != $tagValue"); + return fail($testCount, $what, <surveyJSON_update([0], { variable => 'S0' }); # Add 2 questions to S0 $survey->surveyJSON_newObject([0]); # S0Q0 -$survey->surveyJSON_update([0,0], { variable => 'S0Q0' }); +$survey->surveyJSON_update([0,0], { variable => 'S0Q0', questionType => 'Yes/No' }); $survey->surveyJSON_newObject([0]); # S0Q1 -$survey->surveyJSON_update([0,1], { variable => 'S0Q1' }); +$survey->surveyJSON_update([0,1], { variable => 'S0Q1', questionType => 'Yes/No' }); # Add a new section (S1) $survey->surveyJSON_newObject([]); # S1 @@ -92,8 +92,8 @@ ok($s->responseId, '..(and similarly for responseId)'); # Restart the survey $s->submitQuestions({ - '0-0-0' => 'My chosen answer', - '0-1-0' => 'My chosen answer', + '0-0-0' => 'this text ignored', + '0-1-0' => 'this text ignored', }); cmp_deeply( @@ -103,13 +103,13 @@ cmp_deeply( 'verbatim' => undef, 'comment' => undef, 'time' => num( time, 5 ), - 'value' => '' + 'value' => 1 }, '0-0-0' => { 'verbatim' => undef, 'comment' => undef, 'time' => num( time, 5 ), - 'value' => '' + 'value' => 1 }, } ), diff --git a/t/Asset/Wobject/Survey/Test.t b/t/Asset/Wobject/Survey/Test.t index 2e66b55ed..94b0306c8 100644 --- a/t/Asset/Wobject/Survey/Test.t +++ b/t/Asset/Wobject/Survey/Test.t @@ -21,7 +21,7 @@ my $session = WebGUI::Test->session; #---------------------------------------------------------------------------- # Tests -plan tests => 22; +plan tests => 25; my ( $s, $t1 ); @@ -39,53 +39,88 @@ isa_ok( $s, 'WebGUI::Asset::Wobject::Survey' ); $s->responseIdCookies(0); -# Load bare-bones survey, containing a single section (S0) +# N.B. Survey starts off with a single empty section (S0) + +# Add some sections and questions +$s->surveyJSON_newObject( [] ); # S1 +$s->surveyJSON_newObject( [] ); # S2 +$s->surveyJSON_newObject( [] ); # S3 +$s->surveyJSON_newObject( [] ); # S4 + +# Name the sections $s->surveyJSON_update( [0], { variable => 'S0' } ); -$s->surveyJSON_newObject( [0] ); -$s->surveyJSON_newObject( [] ); -$s->surveyJSON_newObject( [1] ); -$s->surveyJSON_newObject( [1] ); -$s->surveyJSON_newObject( [] ); -$s->surveyJSON_newObject( [2] ); -$s->surveyJSON_newObject( [] ); - -$s->surveyJSON_update( [ 0, 0 ], { variable => 'S0Q0' } ); $s->surveyJSON_update( [1], { variable => 'S1' } ); -$s->surveyJSON_update( [ 1, 0 ], { variable => 'S1Q0' } ); -$s->surveyJSON_update( [ 1, 1 ], { variable => 'S1Q1' } ); $s->surveyJSON_update( [2], { variable => 'S2' } ); -$s->surveyJSON_update( [ 2, 0 ], { variable => 'S2Q0' } ); $s->surveyJSON_update( [3], { variable => 'S3' } ); +$s->surveyJSON_update( [4], { variable => 'S4' } ); -$s->surveyJSON->updateQuestionAnswers( [ 0, 0 ], 'Yes/No' ); -$s->surveyJSON->updateQuestionAnswers( [ 1, 0 ], 'Yes/No' ); -$s->surveyJSON->updateQuestionAnswers( [ 1, 1 ], 'Yes/No' ); +# ..and now some questions +$s->surveyJSON_newObject( [0] ); # S0Q0 +$s->surveyJSON_newObject( [1] ); # S1Q0 +$s->surveyJSON_newObject( [2] ); # S2Q0 +$s->surveyJSON_newObject( [3] ); # S3Q0 +$s->surveyJSON_newObject( [3] ); # S3Q1 +$s->surveyJSON_newObject( [4] ); # S4Q0 +$s->surveyJSON_newObject( [4] ); # S4Q1 +# Name the questions +$s->surveyJSON_update( [ 0, 0 ], { variable => 'S0Q0' } ); +$s->surveyJSON_update( [ 1, 0 ], { variable => 'S1Q0' } ); +$s->surveyJSON_update( [ 2, 0 ], { variable => 'S2Q0' } ); +$s->surveyJSON_update( [ 3, 0 ], { variable => 'S3Q0' } ); +$s->surveyJSON_update( [ 3, 1 ], { variable => 'S3Q1' } ); +$s->surveyJSON_update( [ 4, 0 ], { variable => 'S4Q0' } ); +$s->surveyJSON_update( [ 4, 1 ], { variable => 'S4Q1' } ); + +# Set additional options.. +$s->surveyJSON_update( [ 0, 0 ], { questionType => 'Yes/No' } ); # S0Q0 is a Yes/No +$s->surveyJSON_update( [ 0, 0 ], { gotoExpression => q{ tag('tagged at S0Q0'); } } ); # S0Q0 tags data + +$s->surveyJSON_update( [ 1, 0 ], { questionType => 'Yes/No' } ); # S1Q0 is a Yes/No +$s->surveyJSON_update( [ 1, 0, 0 ], { goto => 'S3' } ); # S1Q0 jumps to S3 + +# And finally, persist the changes.. $s->persistSurveyJSON; cmp_deeply( - $s->responseJSON->surveyOrder, - [ [ 0, 0, [ 0, 1 ] ], [ 1, 0, [0, 1] ], [ 1, 1, [0, 1] ], [ 2, 0, [0] ], [ 3 ] ], - 'At this stage our surveyOrder has 3 items' + $s->responseJSON->surveyOrder, [ + [ 0, 0, [ 0, 1 ] ], # S0Q0 + [ 1, 0, [ 0, 1 ] ], # S1Q0 + [ 2, 0, [] ], # S2Q0 + [ 3, 0, [] ], # S3Q0 + [ 3, 1, [] ], # S3Q1 + [ 4, 0, [] ], # S4Q0 + [ 4, 1, [] ], # S4Q1 + ], 'surveyOrder is correct' ); cmp_deeply( - $s->responseJSON->surveyOrderIndexByVariableName, - { 'S0' => 0, + $s->responseJSON->surveyOrderIndexByVariableName, + { + 'S0' => 0, 'S0Q0' => 0, 'S1' => 1, 'S1Q0' => 1, - 'S1Q1' => 2, - 'S2' => 3, - 'S2Q0' => 3, - 'S3' => 4, + 'S2' => 2, + 'S2Q0' => 2, + 'S3' => 3, + 'S3Q0' => 3, + 'S3Q1' => 4, + 'S4' => 5, + 'S4Q0' => 5, + 'S4Q1' => 6, }, - '..which corresponds to' + 'surveyOrderIndexByVariableName correct' ); $t1 = WebGUI::Asset::Wobject::Survey::Test->create( $session, { assetId => $s->getId } ); my $spec; +###### +# test +###### + +# Both answers for S0Q0 jump to the next item, which can be referred to as either S1 or S1Q0 $spec = < <surveyJSON_update( [ 0, 0, 0 ], { goto => 'S1Q1' } ); - # deliberately pass in a spec that will fail $spec = < < 1 } ); -1..2 -not ok 1 - jumps to S1 +1..1 +not ok 1 - jumps to S2 # Compared next section/question -# got : S1Q1 (<-- a question) -# expect : S1 -ok 2 - jumps to S1 +# got : 'S1' (<-- a section) and 'S1Q0' (<-- a question) +# expect : 'S2' END_TAP -# try now with a spec that will pass +# now try it on a question that has branching, and doesn't start on the first page $spec = < < < < < < <purge() if $s; - $t1->delete(); + $t1->delete() if $t1; }