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

Renamed ResponseJSON branching methods

Browse source
This commit is contained in:
Patrick Donelan 2009-02-06 01:56:18 +00:00
parent 932a033b58
commit 345989370f
2 changed files with 87 additions and 63 deletions
Download patch file Download diff file Expand all files Collapse all files

88
lib/WebGUI/Asset/Wobject/Survey/ResponseJSON.pm
View file

@ -37,11 +37,21 @@ number of questions answered (L<"questionsAnswered">) and the Survey start time
This package is not intended to be used by any other Asset in WebGUI.
=head2 surveyOrder
Many methods in this class operate on the surveyOrder property.
This data strucutre is a deep set of arrays, similar in structure to
L<WebGUI::Asset::Wobject::Survey::SurveyJSON/Address Parameter>.
This data strucutre is an array of Survey addresses (see
L<WebGUI::Asset::Wobject::Survey::SurveyJSON/Address Parameter>), stored in the order
in which items are presented to the user.
By making use of L<WebGUI::Asset::Wobject::Survey::SurveyJSON> methods which expect address params as
arguments, you can access Section/Question/Answer items in order by iterating over surveyOrder.
For example:
# Access sections in order..
for my $address (@{ $self->surveyOrder }) {
my $section = $self->survey->section( $address );
# etc..
}
In general, the surveyOrder data structure looks like:
@ -133,12 +143,9 @@ sub new {
=head2 createSurveyOrder
Computers and stores the order of Sections, Questions and Aswers for this Survey.
The order is represented as an array of addresses
(see L<WebGUI::Asset::Wobject::Survey::SurveyJSON/Address Parameter>),
and is stored in the L<"surveyOrder"> property.
See L<"surveyOrder">.
Questions and Answers that are set to be randomized are shuffled into a random order.
The L<"surveyOrder"> property is useful for keeping a record of what the user was presented with.
=cut
@ -563,8 +570,8 @@ sub recordResponses {
$self->lastResponse( $self->lastResponse + @questions );
# Do any requested branching..
$self->goto($goto) if ( defined $goto );
$self->gotoExpression($gotoExpression) if ( defined $gotoExpression );
$self->processGoto($goto) if ( defined $goto );
$self->processGotoExpression($gotoExpression) if ( defined $gotoExpression );
}
else {
# Required responses were missing, so we don't let the Survey terminate
@ -580,38 +587,55 @@ sub recordResponses {
#-------------------------------------------------------------------
=head2 goto ( $variable )
=head2 processGoto ( $variable )
Looks through all sections and questions for their variable key, in order. If the requested
Looks through all sections and questions for their variable key, in order. If the requested
$variable matches a variable, then the lastResponse is set so that that section or question
is the next displayed. If more than one section or question matches, then the first is used.
is the next displayed. If more than one variable name matches, then the first is used.
=head3 $variable
The variable to look for in all sections and questions.
A variable name to match against all section and question variable names.
=cut
sub goto {
sub processGoto {
my $self = shift;
my $goto = shift;
for ( my $i = 0; $i <= $#{ $self->surveyOrder() }; $i++ ) {
my $section = $self->survey->section( $self->surveyOrder()->[$i] );
my $question = $self->survey->question( $self->surveyOrder()->[$i] );
if ( ref $section eq 'HASH' and $section->{variable} eq $goto ) {
$self->lastResponse( $i - 1 );
my ($goto) = validate_pos(@_, {type => SCALAR});
# Iterate over items in order..
my $itemIndex = 0;
for my $address (@{ $self->surveyOrder }) {
# Retreive the section and question for this address..
my $section = $self->survey->section( $address );
my $question = $self->survey->question( $address );
# See if our goto variable matches the section variable..
if ( ref $section eq 'HASH' && $section->{variable} eq $goto ) {
# Fudge lastReponse so that the next response item will be our matching item
$self->lastResponse( $itemIndex - 1 );
last;
}
if ( ref $question eq 'HASH' and $question->{variable} eq $goto ) {
$self->lastResponse( $i - 1 );
# See if our goto variable matches the question variable..
if ( ref $question eq 'HASH' && $question->{variable} eq $goto ) {
# Fudge lastReponse so that the next response item will be our matching item
$self->lastResponse( $itemIndex - 1 );
last;
}
# Increment the item index counter
$itemIndex++;
}
} ## end sub goto
return;
}
#-------------------------------------------------------------------
=head2 gotoExpression ( $gotoExpression )
=head2 processGotoExpression ( $gotoExpression )
=head3 $gotoExpression
@ -654,7 +678,7 @@ But for now those things can be done manually using the limited subset defined.
=cut
sub gotoExpression {
sub processGotoExpression {
my $self = shift;
my $expression = shift;
@ -670,9 +694,9 @@ sub gotoExpression {
}
}
# Process gotoExpressions one after the other (first one that's true wins)
# Parse gotoExpressions one after the other (first one that's true wins)
foreach my $line (split '\n', $expression) {
my $processed = $self->processGotoExpression($line, \%responses);
my $processed = $self->parseGotoExpression($line, \%responses);
next unless $processed;
@ -682,7 +706,7 @@ sub gotoExpression {
if ($result) {
$self->session->log->debug("Truthy, goto [$processed->{target}]");
$self->goto($processed->{target});
$self->processGoto($processed->{target});
return $processed;
} else {
$self->session->log->debug("Falsy, not branching");
@ -692,7 +716,7 @@ sub gotoExpression {
return;
}
=head2 processGotoExpression ( $expression, $responses)
=head2 parseGotoExpression( ( $expression, $responses)
Parses a single gotoExpression. Returns undef if processing fails, or the following hashref
if things work out well:
@ -722,12 +746,12 @@ the expression generate an error because our list of valid tokens doesn't includ
=cut
sub processGotoExpression {
sub parseGotoExpression {
my $self = shift;
my $expression = shift;
my $responses = shift;
$self->session->log->debug("Processing gotoExpression: $expression");
$self->session->log->debug("Parsing gotoExpression: $expression");
# Valid gotoExpression tokens are..
my $tokens = qr{\s|[-0-9=!<>+*/.()]};

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

@ -307,13 +307,13 @@ $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');
####################################################
@ -321,28 +321,28 @@ is($rJSON->lastResponse(), 5, 'goto: finds first if there are duplicates');
# processGotoExpression
#
####################################################
is($rJSON->processGotoExpression(),
is($rJSON->parseGotoExpression(),
undef, 'processGotoExpression undef with empty arguments');
is($rJSON->processGotoExpression('blah-dee-blah-blah'),
is($rJSON->parseGotoExpression('blah-dee-blah-blah'),
undef, '.. and undef with duff expression');
is($rJSON->processGotoExpression(':'),
is($rJSON->parseGotoExpression(':'),
undef, '.. and undef with missing target');
is($rJSON->processGotoExpression('t1:'),
is($rJSON->parseGotoExpression('t1:'),
undef, '.. and undef with missing expression');
cmp_deeply($rJSON->processGotoExpression('t1: 1'),
cmp_deeply($rJSON->parseGotoExpression('t1: 1'),
{ target => 't1', expression => '1'}, 'works for simple numeric expression');
cmp_deeply($rJSON->processGotoExpression('t1: 1 - 23 + 456 * (78 / 9.0)'),
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->processGotoExpression('t1: 1 + &'), undef, '.. but disallows expression containing non-whitelisted token');
cmp_deeply($rJSON->processGotoExpression('t1: 1 = 3'),
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->processGotoExpression('t1: 1 != 3 <= 4 >= 5'),
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->processGotoExpression('t1: q1 + q2 * q3 - 4', { q1 => 11, q2 => 22, q3 => 33}),
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->processGotoExpression('t1: a silly var name * 10 + another var name', { 'a silly var name' => 345, 'another var name' => 456}),
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->processGotoExpression('t1: qX + 3', { q1 => '7'}),
is($rJSON->parseGotoExpression('t1: qX + 3', { q1 => '7'}),
undef, q{..but doesn't like invalid var names});
####################################################
@ -362,30 +362,30 @@ $rJSON->recordResponses({
'1-0-0' => 'First answer',
'1-0-0comment' => 'Section 1, question 0, answer 0 comment',
});
is($rJSON->gotoExpression('blah-dee-blah-blah'), undef, 'invalid gotoExpression is false');
ok($rJSON->gotoExpression('s0: s1q0 = 3'), '3 == 3 is true');
ok(!$rJSON->gotoExpression('s0: s1q0 = 4'), '3 == 4 is false');
ok($rJSON->gotoExpression('s0: s1q0 != 2'), '3 != 2 is true');
ok(!$rJSON->gotoExpression('s0: s1q0 != 3'), '3 != 3 is false');
ok($rJSON->gotoExpression('s0: s1q0 > 2'), '3 > 2 is true');
ok($rJSON->gotoExpression('s0: s1q0 < 4'), '3 < 2 is true');
ok(!$rJSON->gotoExpression('s0: s1q0 >= 4'), '3 >= 4 is false');
ok(!$rJSON->gotoExpression('s0: s1q0 <= 2'), '3 >= 4 is false');
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->gotoExpression(<<"END_EXPRESSION"), {target => 's2', expression => '3 == 3'}, 'first true expression wins');
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->gotoExpression(<<"END_EXPRESSION"), 'but multiple false expressions still false');
ok(!$rJSON->processGotoExpression(<<"END_EXPRESSION"), 'but multiple false expressions still false');
s0: s1q0 <= 2
s2: s1q0 = 345
END_EXPRESSION
$rJSON->gotoExpression('s0: s1q0 = 3');
is($rJSON->lastResponse(), -1, '.. lastResponse changed to -1 due to goto(s0)');
$rJSON->gotoExpression('s2: s1q0 = 3');
is($rJSON->lastResponse(), 4, '.. lastResponse changed to 4 due to goto(s2)');
$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);