merged with HEAD and other interesting changes

This commit is contained in:
David Delikat 2009-03-19 04:12:03 +00:00
parent 66c6c0fae5
commit 856cc06d04
151 changed files with 7335 additions and 2602 deletions

View file

@ -9,7 +9,9 @@ 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;
@ -20,7 +22,7 @@ my $session = WebGUI::Test->session;
#----------------------------------------------------------------------------
# Tests
my $tests = 52;
my $tests = 79;
plan tests => $tests + 1;
#----------------------------------------------------------------------------
@ -40,17 +42,16 @@ skip $tests, "Unable to load ResponseJSON" unless $usedOk;
####################################################
my $newTime = time();
$responseJSON = WebGUI::Asset::Wobject::Survey::ResponseJSON->new('{}', $session->log);
$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($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');
is_deeply( $responseJSON->surveyOrder, [], 'new: by default, responses is an empty arrayref');
my $now = time();
my $rJSON = WebGUI::Asset::Wobject::Survey::ResponseJSON->new(qq!{ "startTime": $now }!, $session->log);
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');
####################################################
@ -81,13 +82,13 @@ ok( ! $rJSON->hasTimedOut(4*60), 'hasTimedOut, limit check');
####################################################
#
# createSurveyOrder
# initSurveyOrder
#
####################################################
$rJSON = WebGUI::Asset::Wobject::Survey::ResponseJSON->new(q!{}!, $session->log, buildSurveyJSON($session));
$rJSON = WebGUI::Asset::Wobject::Survey::ResponseJSON->new(buildSurveyJSON($session), q!{}!);
$rJSON->createSurveyOrder();
#$rJSON->initSurveyOrder();
cmp_deeply(
$rJSON->surveyOrder,
[
@ -101,7 +102,7 @@ cmp_deeply(
[ 3, 1, [0, 1, 2, 3, 4, 5, 6] ],
[ 3, 2, [0] ],
],
'createSurveyOrder, enumerated all sections, questions and answers'
'initSurveyOrder, enumerated all sections, questions and answers'
);
####################################################
@ -118,38 +119,39 @@ cmp_deeply(
####################################################
#
# createSurveyOrder, part 2
# initSurveyOrder, part 2
#
####################################################
{
no strict "refs";
no warnings;
my $rJSON = WebGUI::Asset::Wobject::Survey::ResponseJSON->new(q!{}!, $session->log, buildSurveyJSON($session));
$rJSON->survey->section([0])->{randomizeQuestions} = 0;
my $shuffleName = "WebGUI::Asset::Wobject::Survey::ResponseJSON::shuffle";
my $shuffleCalled = 0;
my $shuffleRef = \&$shuffleName;
*$shuffleName = sub {
$shuffleCalled = 1;
goto &$shuffleRef;
};
$rJSON->createSurveyOrder();
is($shuffleCalled, 0, 'createSurveyOrder did not call shuffle on a section');
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');
$shuffleCalled = 0;
$rJSON->survey->section([0])->{randomizeQuestions} = 1;
$rJSON->createSurveyOrder();
is($shuffleCalled, 1, 'createSurveyOrder called shuffle on a section');
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');
$shuffleCalled = 0;
$rJSON->survey->section([0])->{randomizeQuestions} = 0;
$rJSON->survey->question([0,0])->{randomizeAnswers} = 1;
$rJSON->createSurveyOrder();
is($shuffleCalled, 1, 'createSurveyOrder called shuffle on a question');
##Restore the subroutine to the original
*$shuffleName = &$shuffleRef;
$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');
}
####################################################
@ -169,51 +171,51 @@ ok( $rJSON->surveyEnd(), 'surveyEnd, with 9 elements, 20 >= end of survey');
####################################################
#
# nextSectionId, nextSection, currentSection
# nextResponseSectionIndex, nextResponseSection, lastResponseSectionIndex
#
####################################################
$rJSON->lastResponse(0);
is($rJSON->nextSectionId(), 0, 'nextSectionId, lastResponse=0, nextSectionId=0');
is($rJSON->nextResponseSectionIndex, 0, 'nextResponseSectionIndex, lastResponse=0, nextResponseSectionIndex=0');
cmp_deeply(
$rJSON->nextSection,
$rJSON->nextResponseSection,
$rJSON->survey->section([0]),
'lastResponse=0, nextSection = section 0'
'lastResponse=0, nextResponseSection = section 0'
);
cmp_deeply(
$rJSON->currentSection,
$rJSON->survey->section([0]),
'lastResponse=0, currentSection = section 0'
is(
$rJSON->lastResponseSectionIndex,
0,
'lastResponse=0, lastResponseSectionIndex = 0'
);
$rJSON->lastResponse(2);
is($rJSON->nextSectionId(), 1, 'nextSectionId, lastResponse=2, nextSectionId=1');
is($rJSON->nextResponseSectionIndex(), 1, 'nextResponseSectionIndex, lastResponse=2, nextResponseSectionIndex=1');
cmp_deeply(
$rJSON->nextSection,
$rJSON->nextResponseSection,
$rJSON->survey->section([1]),
'lastResponse=2, nextSection = section 1'
'lastResponse=2, nextResponseSection = section 1'
);
cmp_deeply(
$rJSON->currentSection,
$rJSON->survey->section([0]),
'lastResponse=2, currentSection = section 0'
is(
$rJSON->lastResponseSectionIndex,
0,
'lastResponse=2, lastResponseSectionIndex = 0'
);
$rJSON->lastResponse(6);
is($rJSON->nextSectionId(), 3, 'nextSectionId, lastResponse=6, nextSectionId=3');
is($rJSON->nextResponseSectionIndex(), 3, 'nextResponseSectionIndex, lastResponse=6, nextResponseSectionIndex=3');
cmp_deeply(
$rJSON->nextSection,
$rJSON->nextResponseSection,
$rJSON->survey->section([3]),
'lastResponse=0, nextSection = section 3'
'lastResponse=0, nextResponseSection = section 3'
);
cmp_deeply(
$rJSON->currentSection,
$rJSON->survey->section([3]),
'lastResponse=6, currentSection = section 3'
$rJSON->lastResponseSectionIndex,
3,
'lastResponse=6, lastResponseSectionIndex = 3'
);
$rJSON->lastResponse(20);
is($rJSON->nextSectionId(), undef, 'nextSectionId, lastResponse > surveyEnd, nextSectionId=undef');
is($rJSON->nextResponseSectionIndex(), undef, 'nextResponseSectionIndex, lastResponse > surveyEnd, nextResponseSectionIndex=undef');
####################################################
#
@ -223,14 +225,14 @@ is($rJSON->nextSectionId(), undef, 'nextSectionId, lastResponse > surveyEnd, nex
$rJSON->lastResponse(20);
ok($rJSON->surveyEnd, 'nextQuestions: lastResponse indicates end of survey');
is_deeply($rJSON->nextQuestions, [], 'nextQuestions returns an empty array ref if there are no questions available');
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(),
[$rJSON->nextQuestions],
[
superhashof({
sid => 0,
@ -262,7 +264,7 @@ cmp_deeply(
$rJSON->lastResponse(1);
cmp_deeply(
$rJSON->nextQuestions(),
[$rJSON->nextQuestions],
[
superhashof({
sid => 0,
@ -286,9 +288,9 @@ cmp_deeply(
$rJSON->lastResponse(4);
cmp_deeply(
$rJSON->nextQuestions(),
undef,
'nextQuestions: returns undef if the next section is empty'
[$rJSON->nextQuestions],
[],
'nextQuestions: returns an empty array if the next section is empty'
);
####################################################
@ -310,15 +312,90 @@ $rJSON->survey->question([3,1])->{variable} = 'goto 3-0'; ##Intentional duplica
$rJSON->survey->question([3,2])->{variable} = 'goto 3-2';
$rJSON->lastResponse(0);
$rJSON->goto('goto 80');
$rJSON->processGoto('goto 80');
is($rJSON->lastResponse(), 0, 'goto: no change in lastResponse if the variable cannot be found');
$rJSON->goto('goto 1');
$rJSON->processGoto('goto 1');
is($rJSON->lastResponse(), 2, 'goto: works on existing section');
$rJSON->goto('goto 0-1');
$rJSON->processGoto('goto 0-1');
is($rJSON->lastResponse(), 0, 'goto: works on existing question');
$rJSON->goto('goto 3-0');
$rJSON->processGoto('goto 3-0');
is($rJSON->lastResponse(), 5, 'goto: finds first if there are duplicates');
####################################################
#
# processGotoExpression
#
####################################################
throws_ok { $rJSON->parseGotoExpression() } 'WebGUI::Error::InvalidParam', 'processGotoExpression takes exception to empty arguments';
is($rJSON->parseGotoExpression(q{}),
undef, '.. and undef with empty expression');
is($rJSON->parseGotoExpression('blah-dee-blah-blah'),
undef, '.. and undef with duff expression');
is($rJSON->parseGotoExpression(':'),
undef, '.. and undef with missing target');
is($rJSON->parseGotoExpression('t1:'),
undef, '.. and undef with missing expression');
cmp_deeply($rJSON->parseGotoExpression('t1: 1'),
{ target => 't1', expression => '1'}, 'works for simple numeric expression');
cmp_deeply($rJSON->parseGotoExpression('t1: 1 - 23 + 456 * (78 / 9.0)'),
{ target => 't1', expression => '1 - 23 + 456 * (78 / 9.0)'}, 'works for expression using all algebraic tokens');
is($rJSON->parseGotoExpression('t1: 1 + &'), undef, '.. but disallows expression containing non-whitelisted token');
cmp_deeply($rJSON->parseGotoExpression('t1: 1 = 3'),
{ target => 't1', expression => '1 == 3'}, 'converts single = to ==');
cmp_deeply($rJSON->parseGotoExpression('t1: 1 != 3 <= 4 >= 5'),
{ target => 't1', expression => '1 != 3 <= 4 >= 5'}, q{..but doesn't mess with other ops containing =});
cmp_deeply($rJSON->parseGotoExpression('t1: q1 + q2 * q3 - 4', { q1 => 11, q2 => 22, q3 => 33}),
{ target => 't1', expression => '11 + 22 * 33 - 4'}, 'substitues q for value');
cmp_deeply($rJSON->parseGotoExpression('t1: a silly var name * 10 + another var name', { 'a silly var name' => 345, 'another var name' => 456}),
{ target => 't1', expression => '345 * 10 + 456'}, '..it even works for vars with spaces in their names');
is($rJSON->parseGotoExpression('t1: qX + 3', { q1 => '7'}),
undef, q{..but doesn't like invalid var names});
####################################################
#
# gotoExpression
#
####################################################
$rJSON->survey->section([0])->{variable} = 's0';
$rJSON->survey->section([2])->{variable} = 's2';
$rJSON->survey->question([1,0])->{variable} = 's1q0';
$rJSON->survey->answer([1,0,0])->{value} = 3;
$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',
});
is($rJSON->processGotoExpression('blah-dee-blah-blah'), undef, 'invalid gotoExpression is false');
ok($rJSON->processGotoExpression('s0: s1q0 = 3'), '3 == 3 is true');
ok(!$rJSON->processGotoExpression('s0: s1q0 = 4'), '3 == 4 is false');
ok($rJSON->processGotoExpression('s0: s1q0 != 2'), '3 != 2 is true');
ok(!$rJSON->processGotoExpression('s0: s1q0 != 3'), '3 != 3 is false');
ok($rJSON->processGotoExpression('s0: s1q0 > 2'), '3 > 2 is true');
ok($rJSON->processGotoExpression('s0: s1q0 < 4'), '3 < 2 is true');
ok(!$rJSON->processGotoExpression('s0: s1q0 >= 4'), '3 >= 4 is false');
ok(!$rJSON->processGotoExpression('s0: s1q0 <= 2'), '3 >= 4 is false');
cmp_deeply($rJSON->processGotoExpression(<<"END_EXPRESSION"), {target => 's2', expression => '3 == 3'}, 'first true expression wins');
s0: s1q0 <= 2
s2: s1q0 = 3
END_EXPRESSION
ok(!$rJSON->processGotoExpression(<<"END_EXPRESSION"), 'but multiple false expressions still false');
s0: s1q0 <= 2
s2: s1q0 = 345
END_EXPRESSION
$rJSON->processGotoExpression('s0: s1q0 = 3');
is($rJSON->lastResponse(), -1, '.. lastResponse changed to -1 due to processGoto(s0)');
$rJSON->processGotoExpression('s2: s1q0 = 3');
is($rJSON->lastResponse(), 4, '.. lastResponse changed to 4 due to processGoto(s2)');
$rJSON->responses({});
$rJSON->questionsAnswered(-1 * $rJSON->questionsAnswered);
####################################################
#
# recordResponses
@ -328,7 +405,7 @@ is($rJSON->lastResponse(), 5, 'goto: finds first if there are duplicates');
$rJSON->lastResponse(4);
my $terminals;
cmp_deeply(
$rJSON->recordResponses($session, {}),
$rJSON->recordResponses({}),
[ 0, undef ],
'recordResponses, if section has no questions, returns terminal info in the section. With no terminal info, returns [0, undef]',
);
@ -339,7 +416,7 @@ $rJSON->survey->section([2])->{terminalUrl} = '/terminal';
$rJSON->lastResponse(4);
cmp_deeply(
$rJSON->recordResponses($session, {}),
$rJSON->recordResponses({}),
[ 1, '/terminal' ],
'recordResponses, if section has no questions, returns terminal info in the section.',
);
@ -350,7 +427,7 @@ $rJSON->survey->question([1,0])->{terminalUrl} = 'question 1-0 terminal';
$rJSON->lastResponse(2);
cmp_deeply(
$rJSON->recordResponses($session, {
$rJSON->recordResponses({
'1-0comment' => 'Section 1, question 0 comment',
'1-0-0' => 'First answer',
'1-0-0comment' => 'Section 1, question 0, answer 0 comment',
@ -358,6 +435,7 @@ cmp_deeply(
[ 1, 'question 1-0 terminal' ],
'recordResponses: question terminal overrides section terminal',
);
is($rJSON->lastResponse(), 4, 'lastResponse advanced to next page of questions');
is($rJSON->questionsAnswered, 1, 'questionsAnswered=1, answered one question');
@ -370,7 +448,7 @@ cmp_deeply(
'1-0-0' => {
comment => 'Section 1, question 0, answer 0 comment',
'time' => num(time(), 3),
value => 1,
value => 1, # 'recordedAnswer' value used because question is multi-choice
},
'1-1' => {
comment => undef,
@ -379,14 +457,44 @@ cmp_deeply(
'recordResponses: recorded responses correctly, two questions, one answer, comments, values and time'
);
# 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->questionsAnswered(-1 * $rJSON->questionsAnswered);
$rJSON->recordResponses({
'1-0comment' => 'Section 1, question 0 comment',
'1-0-0' => 'First answer',
'1-0-0comment' => 'Section 1, question 0, answer 0 comment',
});
cmp_deeply(
$rJSON->responses,
{
'1-0' => {
comment => 'Section 1, question 0 comment',
},
'1-0-0' => {
comment => 'Section 1, question 0, answer 0 comment',
'time' => num(time(), 3),
value => 'First answer', # submitted answer value used this time because non-mc
},
'1-1' => {
comment => undef,
}
},
'recordResponses: recorded responses correctly, two questions, one answer, comments, values and time'
);
$rJSON->survey->question([1,0])->{questionType} = 'Multiple Choice'; # revert change
$rJSON->survey->question([1,0,0])->{terminal} = 1;
$rJSON->survey->question([1,0,0])->{terminalUrl} = 'answer 1-0-0 terminal';
$rJSON->{responses} = {};
$rJSON->responses({});
$rJSON->lastResponse(2);
$rJSON->questionsAnswered(-1 * $rJSON->questionsAnswered);
cmp_deeply(
$rJSON->recordResponses($session, {
$rJSON->recordResponses({
'1-0comment' => 'Section 1, question 0 comment',
'1-0-0' => "\t\t\t\n\n\n\t\t\t", #SOS in whitespace
'1-0-0comment' => 'Section 1, question 0, answer 0 comment',
@ -408,6 +516,9 @@ cmp_deeply(
'recordResponses: if the answer is all whitespace, it is skipped over'
);
is($rJSON->questionsAnswered, 0, 'question was all whitespace, not answered');
#delete $rJSON->{_session};
#delete $rJSON->survey->{_session};
#diag(Dumper($rJSON));
}
@ -419,7 +530,7 @@ is($rJSON->questionsAnswered, 0, 'question was all whitespace, not answered');
sub buildSurveyJSON {
my $session = shift;
my $sjson = WebGUI::Asset::Wobject::Survey::SurveyJSON->new(undef, $session->log);
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([]);