oqapi/webgui
2
0
Fork 0
Code Issues Pull requests Projects Releases Packages Wiki Activity Actions

Survey Branch Expressions now allow you to "tag" data along the way and store

Browse source 
it in the response data structure along with the actual user input. Tag data
can be used in subsequent expressions, in [[tag]] templated text replacement,
and to classify responses in an arbitrary way.

Refactored Survey expression utility subs that lookup values/scores/tags in
external assets.

Fixed bug whereby only highest precedence Survey expression was being evaluated
rather than letting them all run and do their own short-circuiting.
This commit is contained in:
Patrick Donelan 2009-05-04 06:28:05 +00:00
parent ac1a00b252
commit 3dda2b49d4
4 changed files with 322 additions and 119 deletions
Download patch file Download diff file Expand all files Collapse all files

89
t/Asset/Wobject/Survey/ExpressionEngine.t
View file

@ -22,7 +22,7 @@ my $session = WebGUI::Test->session;
#----------------------------------------------------------------------------
# Tests
my $tests = 42;
my $tests = 49;
plan tests => $tests + 1;
#----------------------------------------------------------------------------
@ -41,7 +41,7 @@ SKIP: {
is( $e->run( $session, 'jump { 1 } target' ),
undef, "Nothing happens unless we turn on enableSurveyExpressionEngine in config" );
$session->config->set( 'enableSurveyExpressionEngine', 1 );
is( $e->run( $session, 'jump { 1 } target' ), 'target', "..now we're in business!" );
cmp_deeply( $e->run( $session, 'jump { 1 } target' ), { jump => 'target', tags => {} }, "..now we're in business!" );
my %values = (
n => 5,
@ -54,7 +54,7 @@ SKIP: {
);
# These should all jump to 'target'
my @should_pass = (
my @should_jump = (
q{jump { 1 } target},
q{jump { return 1 } target},
q{jump { "string" } target},
@ -78,27 +78,38 @@ SKIP: {
q{jump { answered(n) && !answered(X) } target}, # answered() works
);
my @should_fail = (
my @should_not_jump = (
q{}, # empty
q{ return }, # empty
q{1}, # doesn't call jump
q|{|, # doesn't compile
q{blah-dee-blah-blah}, # rubbish expression
q{jump {} target}, # empty anon sub to jump
q{jump { 0 } target}, # false sub to jump
q{jump { value(n) == 500 } target},
q{jump { value(s1) eq 'blah' } target},
);
my @should_fail = (
q|{|, # doesn't compile
q{jump { time } target}, # time and other opcodes not allowed
);
for my $expr (@should_pass) {
is( $e->run( $session, $expr, { values => \%values, scores => \%scores } ),
'target', "\"$expr\" jumps as expected" );
# These ones should have 'target' as the jump target
for my $expr (@should_jump) {
cmp_deeply( $e->run( $session, $expr, { values => \%values, scores => \%scores, tags => {} } ),
{ jump => 'target', tags => {} }, "\"$expr\" jumps as expected" );
}
# These ones should come back with an undefined jump target
for my $expr (@should_not_jump) {
cmp_deeply( $e->run( $session, $expr, { values => \%values, scores => \%scores, tags => {} } ),
{ jump => undef, tags => {} }, "\"$expr\" does not jump" );
}
# These ones should return undef (general failure to run)
for my $expr (@should_fail) {
is( $e->run( $session, $expr, { values => \%values, scores => \%scores } ),
undef, "\"$expr\" fails as expected" );
undef,, "\"$expr\" fails as expected" );
}
$e->run( $session, q{jump {$x = value(s1); $x = 'X'} target}, { values => \%values } );
@ -107,11 +118,44 @@ SKIP: {
like( $e->run( $session, '{', { validate => 1 } ), qr/Missing right curly/, "Validation option works" );
# Check validTargets option
is( $e->run( $session, q{jump {1} target}, { values => \%values, validTargets => { a => 1 } } ),
undef, 'target is not valid' );
is( $e->run( $session, q{jump {1} target}, { values => \%values, validTargets => { target => 1 } } ),
'target', '..whereas now it is ok' );
cmp_deeply( $e->run( $session, q{jump {1} target}, { values => \%values, validTargets => { a => 1 } } ),
{ jump => undef, tags => {} }, 'target is not valid' );
cmp_deeply( $e->run( $session, q{jump {1} target}, { values => \%values, validTargets => { target => 1 } } ),
{ jump => 'target', tags => {} }, '..whereas now it is ok' );
# Try some tagging
cmp_deeply(
$e->run( $session, q{}, { values => \%values } ),
{ jump => undef, tags => {} },
'returns empty hash for tags by default'
);
cmp_deeply(
$e->run( $session, q{}, { values => \%values, tags => { a => 1 } } ),
{ jump => undef, tags => { a => 1 } },
'existing tag values survive'
);
cmp_deeply(
$e->run( $session, q{ tag(a,2) }, { values => \%values, tags => { a => 1 } } ),
{ jump => undef, tags => { a => 2 } },
'..but can be changed'
);
cmp_deeply(
$e->run( $session, q{ tag(b,1) }, { values => \%values, tags => { a => 1 } } ),
{ jump => undef, tags => { a => 1, b => 1 } },
'..and new values can be set'
);
cmp_deeply(
$e->run( $session, q{ jump{ tag(a) == 'abc' } target }, { values => \%values, tags => { a => 'abc' } } ),
{ jump => 'target', tags => { a => 'abc' } },
'..tag value resolved by tag() with single arg'
);
cmp_deeply(
$e->run( $session, q{ tag(a,xyz); jump{ tag(a) == 'xyz' } target }, { values => {a => 'def'}, tags => { a => 'abc' } } ),
{ jump => 'target', tags => { a => 'xyz' } },
'..overwritten tag value can be used too everything else'
);
# Create a test user
$user = WebGUI::User->new( $session, 'new' );
WebGUI::Test->usersToDelete($user);
@ -148,20 +192,23 @@ SKIP: {
'0-0-0' => 'My ext_s0q0a0 answer',
'0-1-0' => 'My ext_s0q1a0 answer',
});
$rJSON->processExpression(q{ tag(ext_tag, 199) });
# Remember to persist our changes..
$survey->persistSurveyJSON();
$survey->persistResponseJSON();
$survey->surveyEnd;
is( $e->run( $session, qq{jump {value('$id', ext_s0q0) eq 'ext_s0q0a0'} target}, {userId => $user->userId} ),
'target', 'external value resolves ok when id used' );
is( $e->run( $session, qq{jump {value('$url', ext_s0q0) eq 'ext_s0q0a0'} target}, {userId => $user->userId} ),
'target', 'external value resolves ok when url used' );
is( $e->run( $session, qq{jump {score('$url', ext_s0q0) == 150} target}, {userId => $user->userId} ),
'target', 'external score resolves ok too' );
is( $e->run( $session, qq{jump {score('$url', ext_s0) == 200} target}, {userId => $user->userId} ),
'target', 'external score section totals work too' );
cmp_deeply( $e->run( $session, qq{jump {valueX('$id', ext_s0q0) eq 'ext_s0q0a0'} target}, {userId => $user->userId} ),
{ jump => 'target', tags => {} }, 'external value resolves ok when id used' );
cmp_deeply( $e->run( $session, qq{jump {valueX('$url', ext_s0q0) eq 'ext_s0q0a0'} target}, {userId => $user->userId} ),
{ jump => 'target', tags => {} }, 'external value resolves ok when url used' );
cmp_deeply( $e->run( $session, qq{jump {scoreX('$url', ext_s0q0) == 150} target}, {userId => $user->userId} ),
{ jump => 'target', tags => {} }, 'external score resolves ok too' );
cmp_deeply( $e->run( $session, qq{jump {scoreX('$url', ext_s0) == 200} target}, {userId => $user->userId} ),
{ jump => 'target', tags => {} }, 'external score section totals work too' );
cmp_deeply( $e->run( $session, qq{jump {tagX('$url', ext_tag) == 199} target}, {userId => $user->userId} ),
{ jump => 'target', tags => {} }, 'external tag lookups work too' );
}
#----------------------------------------------------------------------------

45
t/Asset/Wobject/Survey/ResponseJSON.t
View file

@ -22,7 +22,7 @@ my $session = WebGUI::Test->session;
#----------------------------------------------------------------------------
# Tests
my $tests = 83;
my $tests = 87;
plan tests => $tests + 1;
#----------------------------------------------------------------------------
@ -346,7 +346,7 @@ cmp_deeply($rJSON->responseScoresByVariableName, { s1q0 => 100, s1q1 => 200, s1
####################################################
#
# processGotoExpression
# processExpression
#
####################################################
# Turn on the survey Expression Engine
@ -378,64 +378,73 @@ $rJSON->recordResponses({
is($rJSON->nextResponse, 2, 'nextResponse at 2 (s0q1) after first response');
$rJSON->processGotoExpression('blah-dee-blah-blah {');
$rJSON->processExpression('blah-dee-blah-blah {');
is($rJSON->nextResponse, 2, '..unchanged after duff expression');
$rJSON->processGotoExpression('jump { value(s0q0) == 4} s1');
$rJSON->processExpression('jump { value(s0q0) == 4} s1');
is($rJSON->nextResponse, 2, '..unchanged after false expression');
$rJSON->processGotoExpression('jump { value(s0q0) == 4} s0; jump { value(s1q0) == 5} s1;');
$rJSON->processExpression('jump { value(s0q0) == 4} s0; jump { value(s1q0) == 5} s1;');
is($rJSON->nextResponse, 2, '..similarly for multi-statement false expression');
$rJSON->processGotoExpression('jump { value(s0q0) == 3} DUFF_TARGET');
$rJSON->processExpression('jump { value(s0q0) == 3} DUFF_TARGET');
is($rJSON->nextResponse, 2, '..similarly for expression with invalid target');
$rJSON->processGotoExpression('jump { value(s0q0) == 3} s1');
$rJSON->processExpression('jump { value(s0q0) == 3} s1');
is($rJSON->nextResponse, 3, 'jumps to index of first question in section');
$rJSON->processGotoExpression('jump { value(s0q0) == 3} s2');
$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->processGotoExpression('jump { value(s0q0) == 3} s3');
$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->processGotoExpression('jump { value(s0q0) == 3} s3q1');
$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->processGotoExpression('jump { value(s0q0) == 3} NEXT_SECTION');
$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->processGotoExpression('jump { value(s0q0) == 3} NEXT_SECTION');
$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->processGotoExpression('jump { value(s0q0) == 3} NEXT_SECTION');
$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->processGotoExpression('jump { value(s0q0) == 3} END_SURVEY');
$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->processGotoExpression('jump { value(s0q0) == 4} s0; jump { value(s0q0) == 3} s1');
$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->processGotoExpression('jump { score(s0q0) == 100} s1');
$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->processGotoExpression('jump { score("s0") == 300} s1');
$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->processGotoExpression('jump { answered(s0q0) && !answered(ABCDEFG) } s1');
$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
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 {tag(a) + tag(b) == 150} s1');
cmp_deeply($rJSON->tags, { a => 100, b => 50 }, 'Tag data cumulative');
is($rJSON->nextResponse, 3, '..and is useful for jump expressions');
$rJSON->responses({});
$rJSON->questionsAnswered(-1 * $rJSON->questionsAnswered);