oqapi/webgui
2
0
Fork 0
Code Issues Pull requests Projects Releases Packages Wiki Activity Actions
webgui/t/Asset/Wobject/Survey/ResponseJSON.t
Patrick Donelan 9702ffcaac Fixed Survey section-level branch precedence bug 
For Sections with questions spread out over multiple pages, branch
expressions should only happen on the last page of the Section.
Added explicit test.
2009-06-03 02:12:00 +00:00

1069 lines
36 KiB
Perl
Raw Blame History

# Tests WebGUI::Asset::Wobject::Survey
#
#
use strict;
use warnings;
use FindBin;
use lib "$FindBin::Bin/../../../lib";
use Test::More;
use Test::Deep;
use Test::MockObject::Extends;
use Test::Exception;
use Data::Dumper;
use List::Util qw/shuffle/;
use WebGUI::Test; # Must use this before any other WebGUI modules
use WebGUI::Session;
use WebGUI::Asset::Wobject::Survey::SurveyJSON;
#----------------------------------------------------------------------------
# Init
my $session = WebGUI::Test->session;
#----------------------------------------------------------------------------
# Tests
my $tests = 115;
plan tests => $tests + 1;
#----------------------------------------------------------------------------
# put your tests here
my $usedOk = use_ok('WebGUI::Asset::Wobject::Survey::ResponseJSON');
my ($responseJSON);
SKIP: {
skip $tests, "Unable to load ResponseJSON" unless $usedOk;
####################################################
#
# new, part 1
#
####################################################
my $newTime = time();
$responseJSON = WebGUI::Asset::Wobject::Survey::ResponseJSON->new(buildSurveyJSON($session), '{}');
isa_ok($responseJSON , 'WebGUI::Asset::Wobject::Survey::ResponseJSON');
is($responseJSON->lastResponse(), -1, 'new: default lastResponse is -1');
is($responseJSON->questionsAnswered, 0, 'new: questionsAnswered is 0 by default');
cmp_ok((abs$responseJSON->startTime - $newTime), '<=', 2, 'new: by default startTime set to time');
is_deeply( $responseJSON->responses, {}, 'new: by default, responses is an empty hashref');
my $now = time();
my $rJSON = WebGUI::Asset::Wobject::Survey::ResponseJSON->new(buildSurveyJSON($session), qq!{ "startTime": $now }!);
cmp_ok(abs($rJSON->startTime() - $now), '<=', 2, 'new: startTime set using JSON');
####################################################
#
# startTime
#
####################################################
$rJSON->startTime(780321600);
is($rJSON->startTime, 780321600, 'startTime: set and get');
####################################################
#
# hasTimedOut
#
####################################################
##Reset for next set of tests
$rJSON->startTime(time());
ok( ! $rJSON->hasTimedOut(1), 'hasTimedOut, not timed out, checked with 1 minute timeout');
ok( ! $rJSON->hasTimedOut(0), 'hasTimedOut, not timed out, checked with 0 minute timeout');
$rJSON->startTime(time()-7200);
ok( $rJSON->hasTimedOut(1), 'hasTimedOut, timed out');
ok( ! $rJSON->hasTimedOut(0), 'hasTimedOut, bad limit');
ok( ! $rJSON->hasTimedOut(4*60), 'hasTimedOut, limit check');
####################################################
#
# initSurveyOrder
#
####################################################
$rJSON = WebGUI::Asset::Wobject::Survey::ResponseJSON->new(buildSurveyJSON($session), q!{}!);
#$rJSON->initSurveyOrder();
cmp_deeply(
$rJSON->surveyOrder,
[
[ 0, 0, [0] ],
[ 0, 1, [0] ],
[ 0, 2, [0, 1] ],
[ 1, 0, [0, 1] ],
[ 1, 1, [0, 1] ],
[ 2 ],
[ 3, 0, [0, 1] ],
[ 3, 1, [0, 1, 2, 3, 4, 5, 6] ],
[ 3, 2, [0] ],
],
'initSurveyOrder, enumerated all sections, questions and answers'
);
####################################################
#
# shuffle
#
####################################################
{
my @dataToRandomize = 0..49;
my @randomizedData = WebGUI::Asset::Wobject::Survey::ResponseJSON::shuffle(@dataToRandomize);
cmp_bag(\@dataToRandomize, \@randomizedData, 'shuffle: No data lost during shuffling');
}
####################################################
#
# initSurveyOrder, part 2
#
####################################################
{
my $rJSON = WebGUI::Asset::Wobject::Survey::ResponseJSON->new(buildSurveyJSON($session), q!{}!);
$rJSON->survey->section([0])->{randomizeQuestions} = 0;
$rJSON->initSurveyOrder();
my @question_order = map {$_->[1]} grep {$_->[0] == 0} @{$rJSON->surveyOrder};
cmp_deeply(\@question_order, [0,1,2], 'initSurveyOrder did not shuffle questions');
$rJSON->survey->section([0])->{randomizeQuestions} = 1;
srand(42); # Make shuffle predictable
$rJSON->initSurveyOrder();
@question_order = map {$_->[1]} grep {$_->[0] == 0} @{$rJSON->surveyOrder};
srand(42);
my @expected_order = shuffle(0,1,2);
cmp_deeply(\@question_order, \@expected_order, 'initSurveyOrder shuffled questions in first section');
$rJSON->survey->section([0])->{randomizeQuestions} = 0;
$rJSON->survey->question([0,0])->{randomizeAnswers} = 0;
$rJSON->initSurveyOrder();
my @answer_order = map {@{$_->[2]}} grep {$_->[0] == 3 && $_->[1] == 1} @{$rJSON->surveyOrder};
cmp_deeply(\@answer_order, [0,1,2,3,4,5,6], 'initSurveyOrder did not shuffle answers');
$rJSON->survey->question([3,1])->{randomizeAnswers} = 1;
srand(42); # Make shuffle predictable
$rJSON->initSurveyOrder();
@answer_order = map {@{$_->[2]}} grep {$_->[0] == 3 && $_->[1] == 1} @{$rJSON->surveyOrder};
srand(42); # Make shuffle predictable
@expected_order = shuffle(0..6);
cmp_deeply(\@answer_order, \@expected_order, 'initSurveyOrder shuffled answers');
}
####################################################
#
# surveyEnd
#
####################################################
$rJSON->lastResponse(2);
ok( ! $rJSON->surveyEnd(), 'surveyEnd, with 9 elements, 2 != end of survey');
$rJSON->lastResponse(7);
ok( ! $rJSON->surveyEnd(), 'surveyEnd, with 9 elements, 7 != end of survey');
$rJSON->lastResponse(8);
ok( $rJSON->surveyEnd(), 'surveyEnd, with 9 elements, 8 == end of survey');
$rJSON->lastResponse(20);
ok( $rJSON->surveyEnd(), 'surveyEnd, with 9 elements, 20 >= end of survey');
####################################################
#
# nextResponseSectionIndex, nextResponseSection, lastResponseSectionIndex
#
####################################################
$rJSON->lastResponse(0);
is($rJSON->nextResponseSectionIndex, 0, 'nextResponseSectionIndex, lastResponse=0, nextResponseSectionIndex=0');
cmp_deeply(
$rJSON->nextResponseSection,
$rJSON->survey->section([0]),
'lastResponse=0, nextResponseSection = section 0'
);
is(
$rJSON->lastResponseSectionIndex,
0,
'lastResponse=0, lastResponseSectionIndex = 0'
);
$rJSON->lastResponse(2);
is($rJSON->nextResponseSectionIndex(), 1, 'nextResponseSectionIndex, lastResponse=2, nextResponseSectionIndex=1');
cmp_deeply(
$rJSON->nextResponseSection,
$rJSON->survey->section([1]),
'lastResponse=2, nextResponseSection = section 1'
);
is(
$rJSON->lastResponseSectionIndex,
0,
'lastResponse=2, lastResponseSectionIndex = 0'
);
$rJSON->lastResponse(6);
is($rJSON->nextResponseSectionIndex(), 3, 'nextResponseSectionIndex, lastResponse=6, nextResponseSectionIndex=3');
cmp_deeply(
$rJSON->nextResponseSection,
$rJSON->survey->section([3]),
'lastResponse=0, nextResponseSection = section 3'
);
cmp_deeply(
$rJSON->lastResponseSectionIndex,
3,
'lastResponse=6, lastResponseSectionIndex = 3'
);
$rJSON->lastResponse(20);
is($rJSON->nextResponseSectionIndex(), undef, 'nextResponseSectionIndex, lastResponse > surveyEnd, nextResponseSectionIndex=undef');
####################################################
#
# nextQuestions
#
####################################################
$rJSON->lastResponse(20);
ok($rJSON->surveyEnd, 'nextQuestions: lastResponse indicates end of survey');
is_deeply([$rJSON->nextQuestions], [], 'nextQuestions returns an empty array if there are no questions available');
$rJSON->survey->section([0])->{questionsPerPage} = 2;
$rJSON->survey->section([1])->{questionsPerPage} = 2;
$rJSON->survey->section([2])->{questionsPerPage} = 2;
$rJSON->survey->section([3])->{questionsPerPage} = 2;
$rJSON->lastResponse(-1);
cmp_deeply(
[$rJSON->nextQuestions],
[
superhashof({
sid => 0,
id => '0-0',
text => 'Question 0-0',
type => 'question',
answers => [
superhashof({
type => 'answer',
id => '0-0-0',
}),
],
}),
superhashof({
sid => 0,
id => '0-1',
text => 'Question 0-1',
type => 'question',
answers => [
superhashof({
type => 'answer',
id => '0-1-0',
}),
],
}),
],
'nextQuestions returns the correct data structre, amounts and members'
);
$rJSON->lastResponse(1);
cmp_deeply(
[$rJSON->nextQuestions],
[
superhashof({
sid => 0,
id => '0-2',
text => 'Question 0-2',
type => 'question',
answers => [
superhashof({
type => 'answer',
id => '0-2-0',
}),
superhashof({
type => 'answer',
id => '0-2-1',
}),
],
}),
],
'nextQuestions obeys questionPerPage'
);
$rJSON->lastResponse(4);
cmp_deeply(
[$rJSON->nextQuestions],
[],
'nextQuestions: returns an empty array if the next section is empty'
);
####################################################
#
# goto
#
####################################################
$rJSON->survey->section([0])->{variable} = 'goto 0';
$rJSON->survey->question([0,0])->{variable} = 'goto 0-0';
$rJSON->survey->question([0,1])->{variable} = 'goto 0-1';
$rJSON->survey->question([0,2])->{variable} = 'goto 0-2';
$rJSON->survey->section([1])->{variable} = 'goto 1';
$rJSON->survey->question([1,0])->{variable} = 'goto 1-0';
$rJSON->survey->question([1,1])->{variable} = 'goto 1-1';
$rJSON->survey->section([2])->{variable} = 'goto 2';
$rJSON->survey->section([3])->{variable} = 'goto 2';
$rJSON->survey->question([3,0])->{variable} = 'goto 3-0';
$rJSON->survey->question([3,1])->{variable} = 'goto 3-0'; ##Intentional duplicate
$rJSON->survey->question([3,2])->{variable} = 'goto 3-2';
$rJSON->reset;
$rJSON->processGoto('goto 80');
is($rJSON->lastResponse(), -1, 'goto: no change in lastResponse if the variable cannot be found');
$rJSON->processGoto('goto 1');
is($rJSON->lastResponse(), 2, 'goto: works on existing section');
$rJSON->processGoto('goto 0-1');
is($rJSON->lastResponse(), 0, 'goto: works on existing question');
$rJSON->processGoto('goto 3-0');
is($rJSON->lastResponse(), 5, 'goto: finds first if there are duplicates');
####################################################
#
# surveyOrderIndex
#
####################################################
my $expect = {
'goto 0' => 0,
'goto 0-0' => 0,
'goto 0-1' => 1,
'goto 0-2' => 2,
'goto 1' => 3,
'goto 1-0' => 3,
'goto 1-1' => 4,
'goto 2' => 5,
'goto 3-0' => 6,
'goto 3-2' => 8,
};
cmp_deeply($rJSON->surveyOrderIndex(), $expect, 'surveyOrderIndex');
####################################################
#
# responseScoresByVariableName
#
####################################################
$rJSON->survey->section([0])->{variable} = 's0';
$rJSON->survey->section([1])->{variable} = 's1';
$rJSON->survey->section([2])->{variable} = 's2';
$rJSON->survey->section([3])->{variable} = 's3';
$rJSON->survey->question([1,0])->{variable} = 's1q0';
$rJSON->survey->question([1,1])->{variable} = 's1q1';
$rJSON->survey->answer([1,0,0])->{value} = 100; # set answer score
$rJSON->survey->answer([1,1,0])->{value} = 200; # set answer score
cmp_deeply($rJSON->responseScoresByVariableName, {}, 'scores initially empty');
$rJSON->lastResponse(2);
$rJSON->recordResponses({
'1-0-0' => 'My chosen answer',
'1-1-0' => 'My chosen answer',
});
cmp_deeply($rJSON->responseScoresByVariableName, { s1q0 => 100, s1q1 => 200, s1 => 300}, 'scores now reflect q answers and section totals');
####################################################
#
# processExpression
#
####################################################
# Turn on the survey Expression Engine
WebGUI::Test->originalConfig('enableSurveyExpressionEngine');
$session->config->set('enableSurveyExpressionEngine', 1);
$rJSON->survey->section([0])->{variable} = 's0';
$rJSON->survey->question([0,0])->{variable} = 's0q0'; # surveyOrder index = 0
$rJSON->survey->question([0,1])->{variable} = 's0q1'; # surveyOrder index = 1
$rJSON->survey->question([0,2])->{variable} = 's0q2'; # surveyOrder index = 2
$rJSON->survey->section([1])->{variable} = 's1';
$rJSON->survey->question([1,0])->{variable} = 's1q0'; # surveyOrder index = 3
$rJSON->survey->question([1,1])->{variable} = 's1q1'; # surveyOrder index = 4
$rJSON->survey->section([2])->{variable} = 's2'; # empty section appears as surveyOrder index = 5
$rJSON->survey->section([3])->{variable} = 's3';
$rJSON->survey->question([3,0])->{variable} = 's3q0'; # surveyOrder index = 6
$rJSON->survey->question([3,1])->{variable} = 's3q1'; # surveyOrder index = 7
$rJSON->survey->question([3,2])->{variable} = 's3q2'; # surveyOrder index = 8
$rJSON->survey->answer([0,0,0])->{value} = 100; # set answer score
$rJSON->survey->answer([0,1,0])->{value} = 200; # set answer score
$rJSON->survey->answer([0,1,0])->{verbatim} = 1; # make this answer verbatim
# Reset responses and record first answer
$rJSON->reset;
$rJSON->recordResponses({
'0-0-0' => 3, # it's a funny email address I know...
'0-1-0' => '13 11 66',
'0-1-0verbatim' => 'So you want to know more',
});
is($rJSON->nextResponse, 2, 'nextResponse at 2 (s0q1) after first response');
$rJSON->processExpression('blah-dee-blah-blah {');
is($rJSON->nextResponse, 2, '..unchanged after duff expression');
$rJSON->processExpression('jump { value(s0q0) == 4} s1');
is($rJSON->nextResponse, 2, '..unchanged after false expression');
$rJSON->processExpression('jump { value(s0q0) == 4} s0; jump { value(s1q0) == 5} s1;');
is($rJSON->nextResponse, 2, '..similarly for multi-statement false expression');
$rJSON->processExpression('jump { value(s0q0) == 3} DUFF_TARGET');
is($rJSON->nextResponse, 2, '..similarly for expression with invalid target');
$rJSON->processExpression('jump { value(s0q0) == 3} s1');
is($rJSON->nextResponse, 3, 'jumps to index of first question in section');
$rJSON->processExpression('jump { value(s0q0) == 3} s2');
is($rJSON->nextResponse, 5, '..and updated to s2 with different jump target');
$rJSON->nextResponse(2); # pretend we just finished s0q2
$rJSON->processExpression('jump { value(s0q0) == 3} s3');
is($rJSON->nextResponse, 6, '..and updated to s3 with different jump target');
$rJSON->nextResponse(2); # pretend we just finished s0q2
$rJSON->processExpression('jump { value(s0q0) == 3} s3q1');
is($rJSON->nextResponse, 7, '..we can also jump to a question rather than a section');
$rJSON->nextResponse(2); # pretend we just finished s0q2
$rJSON->processExpression('jump { value(s0q0) == 3} NEXT_SECTION');
is($rJSON->nextResponse, 3, '..we can also use the NEXT_SECTION target');
$rJSON->lastResponse(3); # pretend we just finished s1q0
$rJSON->processExpression('jump { value(s0q0) == 3} NEXT_SECTION');
is($rJSON->nextResponse, 5, '..try that again from a different starting point');
$rJSON->lastResponse(8); # pretend we just finished s3q2
$rJSON->processExpression('jump { value(s0q0) == 3} NEXT_SECTION');
is($rJSON->nextResponse, 9, '..NEXT_SECTION on the last section is ok, it just ends the survey');
$rJSON->nextResponse(2); # pretend we just finished s0q2
$rJSON->processExpression('jump { value(s0q0) == 3} END_SURVEY');
is($rJSON->nextResponse, 9, '..we can also jump to end with END_SURVEY target');
$rJSON->nextResponse(2); # pretend we just finished s0q2
$rJSON->processExpression('jump { value(s0q0) == 4} s0; jump { value(s0q0) == 3} s1');
is($rJSON->nextResponse, 3, '..first true statement wins');
$rJSON->nextResponse(2); # pretend we just finished s0q2
$rJSON->processExpression('jump { score(s0q0) == 100} s1');
is($rJSON->nextResponse, 3, '..and again when score used');
$rJSON->nextResponse(2); # pretend we just finished s0q2
$rJSON->processExpression('jump { score("s0") == 300} s1');
is($rJSON->nextResponse, 3, '..and again when section score total used');
$rJSON->nextResponse(2); # pretend we just finished s0q2
$rJSON->processExpression('jump { answered(s0q0) && !answered(ABCDEFG) } s1');
is($rJSON->nextResponse, 3, '..and again when answered() used');
$rJSON->nextResponse(2); # pretend we just finished s0q2
$rJSON->processExpression('jump { value(s0q1_verbatim) eq "So you want to know more" } s1');
is($rJSON->nextResponse, 3, '..and we can access verbatim values');
$rJSON->nextResponse(2); # pretend we just finished s0q2
cmp_deeply($rJSON->tags, {}, 'No tag data');
$rJSON->processExpression('tag(a,100)');
cmp_deeply($rJSON->tags, { a => 100 }, 'Tag data set');
$rJSON->processExpression('tag(b,50); jump {tagged(a) + tagged(b) == 150} s1');
cmp_deeply($rJSON->tags, { a => 100, b => 50 }, 'Tag data cumulative');
is($rJSON->nextResponse, 3, '..and is useful for jump expressions');
# Check multi-answer questions
$rJSON->survey->question([0,2])->{maxAnswers} = 2; # Make it possible to select both "Yes" and "No" to this Yes/No mc question
$rJSON->survey->answer([0,2,0])->{value} = 4; # set 'Yes' answer score
$rJSON->survey->answer([0,2,0])->{verbatim} = 1;
$rJSON->survey->answer([0,2,1])->{value} = 6; # set 'No' answer score
$rJSON->survey->answer([0,2,1])->{verbatim} = 1;
# Record the next question in section 0
$rJSON->nextResponse(2); # pretend we just finished s0q2
$rJSON->recordResponses({
'0-2-0' => 'I chose both Yes',
'0-2-0verbatim' => 'YesYesYes',
'0-2-1' => '..and No to this mc question',
'0-2-1verbatim' => 'NoNoNo',
});
is($rJSON->nextResponse, 3, 'nextResponse at 3 (s1q0) after first response');
$rJSON->processExpression(q{jump { value(s0q2) eq '1, 0' } s2});
is($rJSON->nextResponse, 5, 'value() understands multi-answer questions, and knows how to stringify');
$rJSON->nextResponse(2); # pretend we just finished s0q2
$rJSON->processExpression(q{jump { (value(s0q2))[0] == 1 && (value(s0q2))[1] == 0 } s2});
is($rJSON->nextResponse, 5, '..and it can give us a list if thats what we want');
$rJSON->nextResponse(2); # pretend we just finished s0q2
$rJSON->processExpression(q{jump { score(s0q2) == 10 } s2});
is($rJSON->nextResponse, 5, '..and score() knows how to sum multi-answer questions');
$rJSON->nextResponse(2); # pretend we just finished s0q2
$rJSON->processExpression(q{jump { (value(s0q2_verbatim))[0] eq 'YesYesYes' && (value(s0q2_verbatim))[1] eq 'NoNoNo' } s2});
is($rJSON->nextResponse, 5, '..and we can get list of verbatims too');
$rJSON->nextResponse(2); # pretend we just finished s0q2
cmp_deeply($rJSON->processExpression(q{restart()}), { restart => 1 }, 'restart works');
cmp_deeply($rJSON->processExpression(q{exitUrl(blah)}), { exitUrl => 'blah' }, 'explicit exitUrl works');
cmp_deeply($rJSON->processExpression(q{exitUrl()}), { exitUrl => undef }, 'unspecified exitUrl works too');
# Section branching should not happen until all questions in a section have been completed
$rJSON->survey->section([0])->{questionsPerPage} = 2; # Has 3 questions, so first submit will not trigger section-branching
$rJSON->survey->section([0])->{gotoExpression} = q{ tag('not so fast'); };
$rJSON->reset;
$rJSON->recordResponses({
'0-0-0' => 1,
'0-1-0' => '13 11 66',
});
cmp_deeply($rJSON->tags, {}, 'No tags yet, section branching should not run yet');
$rJSON->recordResponses({
'0-2-1' => 1,
});
cmp_deeply($rJSON->tags, { 'not so fast' => 1 }, 'Section branching has now run');
# Clean up after this set of tests
$rJSON->reset;
$rJSON->survey->section([0])->{gotoExpression} = undef;
$rJSON->questionsAnswered(-1 * $rJSON->questionsAnswered);
####################################################
#
# recordResponses
#
####################################################
$rJSON->survey->question([1,0])->{questionType} = 'Multiple Choice';
$rJSON->lastResponse(4);
my $terminals;
is(
$rJSON->recordResponses({}),
undef,
'recordResponses, with no terminal info, returns undef',
);
is($rJSON->lastResponse(), 5, 'recordResponses, increments lastResponse if there are no questions in the section');
$rJSON->survey->section([2])->{terminal} = 1;
$rJSON->survey->section([2])->{terminalUrl} = '/terminal';
$rJSON->lastResponse(4);
cmp_deeply(
$rJSON->recordResponses({}),
{ terminal => '/terminal' },
'recordResponses, if section has no questions, returns terminal info in the section.',
);
is($rJSON->questionsAnswered, 0, 'questionsAnswered=0, no questions answered');
$rJSON->survey->question([1,0])->{terminal} = 1;
$rJSON->survey->question([1,0])->{terminalUrl} = 'question 1-0 terminal';
$rJSON->lastResponse(2);
$rJSON->survey->answer([1,0,0])->{recordedAnswer} = 1; # Set recordedAnswer
# Check that raw input is recorded for verbatim mc answers
$rJSON->survey->answer([1,0,0])->{verbatim} = 1;
$rJSON->lastResponse(2);
$rJSON->responses({});
$rJSON->questionsAnswered(-1 * $rJSON->questionsAnswered);
$rJSON->recordResponses({
'1-0comment' => 'Section 1, question 0 comment',
'1-0-0' => 'First answer',
'1-0-0verbatim' => 'Section 1, question 0, answer 0 verbatim',
});
cmp_deeply(
$rJSON->responses,
{
'1-0' => {
comment => 'Section 1, question 0 comment',
},
'1-0-0' => {
'time' => num(time(), 3),
value => 1, # 'recordedAnswer' value used because question is multi-choice
verbatim => 'Section 1, question 0, answer 0 verbatim',
},
},
'recordResponses: verbatim answer recorded responses correctly'
);
# Repeat with non multi-choice question, to check that submitted answer value is used
# instead of recordedValue
$rJSON->survey->question([1,0])->{questionType} = 'Text';
$rJSON->lastResponse(2);
$rJSON->responses({});
$rJSON->questionsAnswered(-1 * $rJSON->questionsAnswered);
$rJSON->recordResponses({
'1-0comment' => 'Section 1, question 0 comment',
'1-0-0' => 'First answer',
'1-0-0verbatim' => 'Section 1, question 0, answer 0 comment',
});
cmp_deeply(
$rJSON->responses,
{
'1-0' => {
comment => 'Section 1, question 0 comment',
},
'1-0-0' => {
verbatim => 'Section 1, question 0, answer 0 comment',
'time' => num(time(), 3),
value => 'First answer', # submitted answer value used this time because non-mc
},
},
'recordResponses: recorded responses correctly, two questions, one answer, comments, values and time'
);
$rJSON->survey->question([1,0])->{questionType} = 'Multiple Choice'; # revert change
$rJSON->survey->answer([1,0,0])->{verbatim} = 0; # revert change
$rJSON->survey->answer([1,0,0])->{terminal} = 1;
$rJSON->survey->answer([1,0,0])->{terminalUrl} = 'answer 1-0-0 terminal';
$rJSON->responses({});
$rJSON->lastResponse(2);
$rJSON->questionsAnswered(-1 * $rJSON->questionsAnswered);
cmp_deeply(
$rJSON->recordResponses({
'1-0comment' => 'Section 1, question 0 comment',
'1-0-0' => 1,
'1-0-0comment' => 'Section 1, question 0, answer 0 comment',
}),
{ terminal => 'answer 1-0-0 terminal'},
'recordResponses: answer terminal overrides section terminals',
);
$rJSON->responses({});
$rJSON->lastResponse(2);
$rJSON->questionsAnswered(-1 * $rJSON->questionsAnswered);
cmp_deeply(
$rJSON->responses,
{
# '1-0' => {
# comment => 'Section 1, question 0 comment',
# },
# '1-1' => {
# comment => undef,
# }
},
'recordResponses: if the answer is all whitespace, it is skipped over'
);
is($rJSON->questionsAnswered, 0, 'question was all whitespace, not answered');
####################################################
#
# pop
#
####################################################
$rJSON->responses({});
$rJSON->lastResponse(2);
is($rJSON->pop, undef, 'pop with no responses returns undef');
cmp_deeply($rJSON->responses, {}, 'initially no responses');
$rJSON->recordResponses({
'1-0comment' => 'Section 1, question 0 comment',
'1-0-0' => 'First answer',
'1-1comment' => 'Section 1, question 1 comment',
'1-1-0' => 'Second answer',
});
my $popped = $rJSON->pop;
cmp_deeply($popped, {
# the first q answer
'1-0-0' => {
value => 1,
time => num(time(), 3),
},
# the second q answer
'1-1-0' => {
value => 0,
time => num(time(), 3),
},
# the first question comment
'1-0' => {
comment => 'Section 1, question 0 comment',
},
# the second question comment
'1-1' => {
comment => 'Section 1, question 1 comment',
}
}, 'pop removes only existing response');
cmp_deeply($rJSON->responses, {}, 'and now back to no responses');
is($rJSON->pop, undef, 'additional pop has no effect');
$rJSON->responses({});
$rJSON->lastResponse(2);
$rJSON->recordResponses({
'1-0comment' => 'Section 1, question 0 comment',
'1-0-0' => 'First answer',
'1-0-0comment' => 'Section 1, question 0, answer 0 comment',
'1-1comment' => 'Section 1, question 1 comment',
'1-1-0' => 'Second answer',
'1-1-0comment' => 'Section 1, question 1, answer 0 comment',
});
# fake time so that pop thinks first response happened earlier
$rJSON->responses->{'1-0-0'}->{time} -= 1;
cmp_deeply($rJSON->pop, {
# the second q answer
'1-1-0' => {
value => 0,
time => num(time(), 3),
},
# the second question comment
'1-1' => {
comment => 'Section 1, question 1 comment',
}
}, 'pop now only removes the most recent response');
cmp_deeply($rJSON->responses, {
# the first q answer
'1-0-0' => {
value => 1,
time => num(time(), 3),
},
# the first question comment
'1-0' => {
comment => 'Section 1, question 0 comment',
},
}, 'and first response left in tact');
cmp_deeply($rJSON->pop, {
# the first q answer
'1-0-0' => {
value => 1,
time => num(time(), 3),
},
# the first question comment
'1-0' => {
comment => 'Section 1, question 0 comment',
},
}, 'second pop removes first response');
cmp_deeply($rJSON->responses, {}, '..and now responses hash empty again');
is($rJSON->pop, undef, 'additional pop has no effect');
####################################################
#
# Question Types
#
####################################################
$rJSON = WebGUI::Asset::Wobject::Survey::ResponseJSON->new(buildSurveyJSON($session));
# Use Section 1 (containing 2 questions) for testing. This allows us to test 2 different responses at once.
########
# Country
for my $q (0,1) {
$rJSON->survey->updateQuestionAnswers([1,$q], 'Country');
$rJSON->survey->answer([1,$q,0])->{recordedAnswer} = '-';
$rJSON->survey->answer([1,$q,0])->{verbatim} = 1;
}
$rJSON->reset;
$rJSON->lastResponse(2);
$rJSON->recordResponses( {
'1-0-0' => 'Australia',
'1-0-0verbatim' => 'insert witty comment',
'1-1-0' => 'JTville',
'1-1-0verbatim' => '',
});
cmp_deeply(
$rJSON->responses->{'1-0-0'},
{
'verbatim' => 'insert witty comment',
'time' => num(time(), 3),
'value' => 'Australia'
},
'Valid value recorded correctly'
);
is($rJSON->responses->{'1-1-0'}, undef, 'Invalid country ignored');
########
# Date
for my $q (0,1) {
$rJSON->survey->updateQuestionAnswers([1,$q], 'Date');
$rJSON->survey->answer([1,$q,0])->{recordedAnswer} = '-';
$rJSON->survey->answer([1,$q,0])->{verbatim} = 1;
}
$rJSON->reset;
$rJSON->lastResponse(2);
$rJSON->recordResponses( {
'1-0-0' => '2009/05/01',
'1-0-0verbatim' => 'insert witty comment',
'1-1-0' => '12345',
});
cmp_deeply(
$rJSON->responses->{'1-0-0'},
{
'verbatim' => 'insert witty comment',
'time' => num(time(), 3),
'value' => '2009/05/01'
},
'Valid value recorded correctly'
);
# All date input accepted until validation options supported
#is($rJSON->responses->{'1-1-0'}, undef, 'Invalid date ignored');
########
# Number
for my $q (0,1) {
$rJSON->survey->updateQuestionAnswers([1,$q], 'Number');
$rJSON->survey->answer([1,$q,0])->{recordedAnswer} = '-';
$rJSON->survey->answer([1,$q,0])->{verbatim} = 1;
$rJSON->survey->answer([1,$q,0])->{min} = '-5';
$rJSON->survey->answer([1,$q,0])->{max} = '10';
}
$rJSON->reset;
$rJSON->lastResponse(2);
$rJSON->recordResponses( {
'1-0-0' => '-3',
'1-0-0verbatim' => 'insert witty comment',
'1-1-0' => '11',
});
cmp_deeply(
$rJSON->responses->{'1-0-0'},
{
'verbatim' => 'insert witty comment',
'time' => num(time(), 3),
'value' => '-3'
},
'Valid value recorded correctly'
);
is($rJSON->responses->{'1-1-0'}, undef, 'Invalid number ignored');
########
# Slider
for my $q (0,1) {
$rJSON->survey->updateQuestionAnswers([1,$q], 'Slider');
$rJSON->survey->answer([1,$q,0])->{recordedAnswer} = '-';
$rJSON->survey->answer([1,$q,0])->{verbatim} = 1;
$rJSON->survey->answer([1,$q,0])->{min} = '-5';
$rJSON->survey->answer([1,$q,0])->{max} = '10';
$rJSON->survey->answer([1,$q,0])->{step} = '1';
}
$rJSON->reset;
$rJSON->lastResponse(2);
$rJSON->recordResponses( {
'1-0-0' => '-3',
'1-0-0verbatim' => 'insert witty comment',
'1-1-0' => '11',
});
cmp_deeply(
$rJSON->responses->{'1-0-0'},
{
'verbatim' => 'insert witty comment',
'time' => num(time(), 3),
'value' => '-3'
},
'Valid value recorded correctly'
);
is($rJSON->responses->{'1-1-0'}, undef, 'Invalid slider value ignored');
########
# Yes/No
$rJSON->survey->updateQuestionAnswers([1,0], 'Yes/No');
$rJSON->survey->updateQuestionAnswers([1,1], 'Yes/No');
for my $q (0,1) {
$rJSON->survey->answer([1,$q,0])->{recordedAnswer} = 'Yes';
$rJSON->survey->answer([1,$q,1])->{recordedAnswer} = 'No';
$rJSON->survey->answer([1,$q,0])->{verbatim} = 1;
$rJSON->survey->answer([1,$q,1])->{verbatim} = 1;
}
$rJSON->reset;
$rJSON->lastResponse(2);
$rJSON->recordResponses( {
'1-0-0' => 1, # Multi-choice answers are submitted like this,
'1-0-0verbatim' => 'insert witty comment',
'1-1-1' => 1, # with the selected answer set to 1
'1-1-1verbatim' => ' ',
});
cmp_deeply(
$rJSON->responses->{'1-0-0'},
{
'verbatim' => 'insert witty comment',
'time' => num(time(), 3),
'value' => 'Yes'
},
'Yes recorded correctly'
);
cmp_deeply(
$rJSON->responses->{'1-1-1'},
{
'verbatim' => ' ',
'time' => num(time(), 3),
'value' => 'No'
},
'No recorded correctly'
);
########
# True/False
$rJSON->survey->updateQuestionAnswers([1,0], 'True/False');
$rJSON->survey->updateQuestionAnswers([1,1], 'True/False');
for my $q (0,1) {
$rJSON->survey->answer([1,$q,0])->{recordedAnswer} = 'True';
$rJSON->survey->answer([1,$q,1])->{recordedAnswer} = 'False';
$rJSON->survey->answer([1,$q,0])->{verbatim} = 0;
$rJSON->survey->answer([1,$q,1])->{verbatim} = 0;
}
$rJSON->reset;
$rJSON->lastResponse(2);
$rJSON->recordResponses( {
'1-0-0' => 1, # Multi-choice answers are submitted like this,
'1-0-0verbatim' => 'will be ignored',
'1-1-1' => 1, # with the selected answer set to 1
'1-1-1verbatim' => 'will be ignored',
});
cmp_deeply(
$rJSON->responses->{'1-0-0'},
{
'time' => num(time(), 3),
'value' => 'True'
},
'True recorded correctly'
);
cmp_deeply(
$rJSON->responses->{'1-1-1'},
{
'time' => num(time(), 3),
'value' => 'False'
},
'False recorded correctly'
);
####################################################
#
# logical sections
#
####################################################
$rJSON = WebGUI::Asset::Wobject::Survey::ResponseJSON->new(buildSurveyJSON($session));
cmp_deeply(
$rJSON->surveyOrder,
[ [ 0, 0, [0] ], # S0Q0 (surveyOrder: 0)
[ 0, 1, [0] ], # S0Q1 (surveyOrder: 1)
[ 0, 2, [ 0, 1 ] ], # S0Q2 (surveyOrder: 2)
[ 1, 0, [ 0, 1 ] ], # S1Q0 (surveyOrder: 3)
[ 1, 1, [ 0, 1 ] ], # S1Q1 (surveyOrder: 4)
[2], # S2 (surveyOrder: 5)
[ 3, 0, [ 0, 1 ] ], # S3Q0 (surveyOrder: 6)
[ 3, 1, [ 0, 1, 2, 3, 4, 5, 6 ] ], #S3Q1 (surveyOrder: 7)
[ 3, 2, [0] ], #S3Q2 (surveyOrder: 8)
],
'surveyOrder',
);
$rJSON->survey->section([$_])->{gotoExpression} = qq{tag('tagged at s$_')} for (0..3);
$rJSON->survey->section([$_])->{variable} = "S$_" for (0..3);
$rJSON->survey->answer([0,2,1])->{goto} = 'S2';
# Submit section 0, should fall through to section 2 because section 1 is logical
# If we submit S0 normally, nextResponse will be 3 (S1 / S1Q0)
$rJSON->recordResponses( {
'0-0-0' => 'me@email.com',
'0-1-0' => 'my phone',
'0-2-0' => 1,
});
is($rJSON->nextResponse, 3, 'Natural progression');
# However if S1 is logical, nextResponse will be 5 (S2)
$rJSON->reset;
$rJSON->survey->section([1])->{logical} = 1;
$rJSON->recordResponses( {
'0-0-0' => 'me@email.com',
'0-1-0' => 'my phone',
'0-2-0' => 1,
});
is($rJSON->nextResponse, 5, 'Logical section processed automatically');
cmp_deeply($rJSON->tags, { 'tagged at s0' => 1, 'tagged at s1' => 1, }, 'Logical section gotoExpression can still tag data');
$rJSON->survey->section([1])->{logical} = 0;
# Check behaviour when first section is logical
$rJSON->reset;
cmp_deeply( [ $rJSON->nextQuestions ],
[
superhashof( { id => '0-0' } ),
superhashof( { id => '0-1' } ),
superhashof( { id => '0-2' } ),
],
'Normally nextQuestions returns all questions in first section'
);
$rJSON->survey->section([0])->{logical} = 1;
$rJSON->reset;
cmp_deeply( [ $rJSON->nextQuestions ],
[
superhashof( { id => '1-0' } ),
superhashof( { id => '1-1' } ),
],
'..but when first section logical, second section questions returned instead'
);
cmp_deeply($rJSON->tags, { 'tagged at s0' => 1 }, '..and s0 gotoExpression was run');
# Check behaviour when all sections logical
$rJSON->survey->section([$_])->{logical} = 1 for (0..3);
$rJSON->reset;
cmp_deeply($rJSON->tags,
{
'tagged at s0' => 1,
'tagged at s1' => 1,
'tagged at s2' => 1,
'tagged at s3' => 1,
},
'..all gotoExpressions run'
);
$rJSON->survey->section([$_])->{logical} = 0 for (0..3);
# Check that we can jump to a logical section
$rJSON->survey->section([2])->{logical} = 1;
$rJSON->reset;
$rJSON->recordResponses( {
'0-0-0' => 'me@email.com',
'0-1-0' => 'my phone',
'0-2-1' => 1, # goto -> S2
});
is($rJSON->nextResponse, 6, 'S2 processed automatically and we land as S3');
}
####################################################
#
# Utility test routines
#
####################################################
sub buildSurveyJSON {
my $session = shift;
my $sjson = WebGUI::Asset::Wobject::Survey::SurveyJSON->new($session);
##Build 4 sections. Remembering that one is created by default when you make an empty SurveyJSON object
$sjson->newObject([]);
$sjson->newObject([]);
$sjson->newObject([]);
##Add questions to the sections
$sjson->newObject([0]);
$sjson->newObject([0]);
$sjson->newObject([0]);
$sjson->newObject([1]);
$sjson->newObject([1]);
##Section 3 has no questions
$sjson->newObject([3]);
$sjson->newObject([3]);
$sjson->newObject([3]);
##Add questions
$sjson->updateQuestionAnswers([0,0], 'Email');
$sjson->updateQuestionAnswers([0,1], 'Phone Number');
$sjson->updateQuestionAnswers([0,2], 'Yes/No');
$sjson->updateQuestionAnswers([1,0], 'True/False');
$sjson->updateQuestionAnswers([1,1], 'Gender');
$sjson->updateQuestionAnswers([3,0], 'Date Range');
$sjson->updateQuestionAnswers([3,1], 'Ideology');
$sjson->updateQuestionAnswers([3,2], 'Email');
##Title the sections and questions
$sjson->section([0])->{title} = "Section 0";
$sjson->section([1])->{title} = "Section 1";
$sjson->section([2])->{title} = "Section 2";
$sjson->section([3])->{title} = "Section 3";
$sjson->question([0,0])->{text} = "Question 0-0";
$sjson->question([0,1])->{text} = "Question 0-1";
$sjson->question([0,2])->{text} = "Question 0-2";
$sjson->question([1,0])->{text} = "Question 1-0";
$sjson->question([1,1])->{text} = "Question 1-1";
$sjson->question([3,0])->{text} = "Question 3-0";
$sjson->question([3,1])->{text} = "Question 3-1";
$sjson->question([3,2])->{text} = "Question 3-2";
return $sjson;
}
#----------------------------------------------------------------------------
# Cleanup
END { }
Reference in a new issue View git blame Copy permalink