Renamed ResponseJSON branching methods

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

View file

@ -38,10 +38,20 @@ This package is not intended to be used by any other Asset in WebGUI.
=head2 surveyOrder =head2 surveyOrder
Many methods in this class operate on the surveyOrder property. 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.
This data strucutre is a deep set of arrays, similar in structure to By making use of L<WebGUI::Asset::Wobject::Survey::SurveyJSON> methods which expect address params as
L<WebGUI::Asset::Wobject::Survey::SurveyJSON/Address Parameter>. 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: In general, the surveyOrder data structure looks like:
@ -133,12 +143,9 @@ sub new {
=head2 createSurveyOrder =head2 createSurveyOrder
Computers and stores the order of Sections, Questions and Aswers for this Survey. Computers and stores the order of Sections, Questions and Aswers for this Survey.
The order is represented as an array of addresses See L<"surveyOrder">.
(see L<WebGUI::Asset::Wobject::Survey::SurveyJSON/Address Parameter>),
and is stored in the L<"surveyOrder"> property.
Questions and Answers that are set to be randomized are shuffled into a random order. 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 =cut
@ -563,8 +570,8 @@ sub recordResponses {
$self->lastResponse( $self->lastResponse + @questions ); $self->lastResponse( $self->lastResponse + @questions );
# Do any requested branching.. # Do any requested branching..
$self->goto($goto) if ( defined $goto ); $self->processGoto($goto) if ( defined $goto );
$self->gotoExpression($gotoExpression) if ( defined $gotoExpression ); $self->processGotoExpression($gotoExpression) if ( defined $gotoExpression );
} }
else { else {
# Required responses were missing, so we don't let the Survey terminate # 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 $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 =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 =cut
sub goto { sub processGoto {
my $self = shift; my $self = shift;
my $goto = shift; my ($goto) = validate_pos(@_, {type => SCALAR});
for ( my $i = 0; $i <= $#{ $self->surveyOrder() }; $i++ ) {
my $section = $self->survey->section( $self->surveyOrder()->[$i] ); # Iterate over items in order..
my $question = $self->survey->question( $self->surveyOrder()->[$i] ); my $itemIndex = 0;
if ( ref $section eq 'HASH' and $section->{variable} eq $goto ) { for my $address (@{ $self->surveyOrder }) {
$self->lastResponse( $i - 1 );
# 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; 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; last;
} }
# Increment the item index counter
$itemIndex++;
} }
} ## end sub goto return;
}
#------------------------------------------------------------------- #-------------------------------------------------------------------
=head2 gotoExpression ( $gotoExpression ) =head2 processGotoExpression ( $gotoExpression )
=head3 $gotoExpression =head3 $gotoExpression
@ -654,7 +678,7 @@ But for now those things can be done manually using the limited subset defined.
=cut =cut
sub gotoExpression { sub processGotoExpression {
my $self = shift; my $self = shift;
my $expression = 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) { foreach my $line (split '\n', $expression) {
my $processed = $self->processGotoExpression($line, \%responses); my $processed = $self->parseGotoExpression($line, \%responses);
next unless $processed; next unless $processed;
@ -682,7 +706,7 @@ sub gotoExpression {
if ($result) { if ($result) {
$self->session->log->debug("Truthy, goto [$processed->{target}]"); $self->session->log->debug("Truthy, goto [$processed->{target}]");
$self->goto($processed->{target}); $self->processGoto($processed->{target});
return $processed; return $processed;
} else { } else {
$self->session->log->debug("Falsy, not branching"); $self->session->log->debug("Falsy, not branching");
@ -692,7 +716,7 @@ sub gotoExpression {
return; return;
} }
=head2 processGotoExpression ( $expression, $responses) =head2 parseGotoExpression( ( $expression, $responses)
Parses a single gotoExpression. Returns undef if processing fails, or the following hashref Parses a single gotoExpression. Returns undef if processing fails, or the following hashref
if things work out well: if things work out well:
@ -722,12 +746,12 @@ the expression generate an error because our list of valid tokens doesn't includ
=cut =cut
sub processGotoExpression { sub parseGotoExpression {
my $self = shift; my $self = shift;
my $expression = shift; my $expression = shift;
my $responses = shift; my $responses = shift;
$self->session->log->debug("Processing gotoExpression: $expression"); $self->session->log->debug("Parsing gotoExpression: $expression");
# Valid gotoExpression tokens are.. # Valid gotoExpression tokens are..
my $tokens = qr{\s|[-0-9=!<>+*/.()]}; my $tokens = qr{\s|[-0-9=!<>+*/.()]};

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->survey->question([3,2])->{variable} = 'goto 3-2';
$rJSON->lastResponse(0); $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'); 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'); 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'); 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'); 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 # processGotoExpression
# #
#################################################### ####################################################
is($rJSON->processGotoExpression(), is($rJSON->parseGotoExpression(),
undef, 'processGotoExpression undef with empty arguments'); 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'); undef, '.. and undef with duff expression');
is($rJSON->processGotoExpression(':'), is($rJSON->parseGotoExpression(':'),
undef, '.. and undef with missing target'); undef, '.. and undef with missing target');
is($rJSON->processGotoExpression('t1:'), is($rJSON->parseGotoExpression('t1:'),
undef, '.. and undef with missing expression'); 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'); { 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'); { 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'); is($rJSON->parseGotoExpression('t1: 1 + &'), undef, '.. but disallows expression containing non-whitelisted token');
cmp_deeply($rJSON->processGotoExpression('t1: 1 = 3'), cmp_deeply($rJSON->parseGotoExpression('t1: 1 = 3'),
{ target => 't1', expression => '1 == 3'}, 'converts single = to =='); { 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 =}); { 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'); { 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'); { 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}); undef, q{..but doesn't like invalid var names});
#################################################### ####################################################
@ -362,30 +362,30 @@ $rJSON->recordResponses({
'1-0-0' => 'First answer', '1-0-0' => 'First answer',
'1-0-0comment' => 'Section 1, question 0, answer 0 comment', '1-0-0comment' => 'Section 1, question 0, answer 0 comment',
}); });
is($rJSON->gotoExpression('blah-dee-blah-blah'), undef, 'invalid gotoExpression is false'); is($rJSON->processGotoExpression('blah-dee-blah-blah'), undef, 'invalid gotoExpression is false');
ok($rJSON->gotoExpression('s0: s1q0 = 3'), '3 == 3 is true'); ok($rJSON->processGotoExpression('s0: s1q0 = 3'), '3 == 3 is true');
ok(!$rJSON->gotoExpression('s0: s1q0 = 4'), '3 == 4 is false'); ok(!$rJSON->processGotoExpression('s0: s1q0 = 4'), '3 == 4 is false');
ok($rJSON->gotoExpression('s0: s1q0 != 2'), '3 != 2 is true'); ok($rJSON->processGotoExpression('s0: s1q0 != 2'), '3 != 2 is true');
ok(!$rJSON->gotoExpression('s0: s1q0 != 3'), '3 != 3 is false'); ok(!$rJSON->processGotoExpression('s0: s1q0 != 3'), '3 != 3 is false');
ok($rJSON->gotoExpression('s0: s1q0 > 2'), '3 > 2 is true'); ok($rJSON->processGotoExpression('s0: s1q0 > 2'), '3 > 2 is true');
ok($rJSON->gotoExpression('s0: s1q0 < 4'), '3 < 2 is true'); ok($rJSON->processGotoExpression('s0: s1q0 < 4'), '3 < 2 is true');
ok(!$rJSON->gotoExpression('s0: s1q0 >= 4'), '3 >= 4 is false'); ok(!$rJSON->processGotoExpression('s0: s1q0 >= 4'), '3 >= 4 is false');
ok(!$rJSON->gotoExpression('s0: s1q0 <= 2'), '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 s0: s1q0 <= 2
s2: s1q0 = 3 s2: s1q0 = 3
END_EXPRESSION 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 s0: s1q0 <= 2
s2: s1q0 = 345 s2: s1q0 = 345
END_EXPRESSION END_EXPRESSION
$rJSON->gotoExpression('s0: s1q0 = 3'); $rJSON->processGotoExpression('s0: s1q0 = 3');
is($rJSON->lastResponse(), -1, '.. lastResponse changed to -1 due to goto(s0)'); is($rJSON->lastResponse(), -1, '.. lastResponse changed to -1 due to processGoto(s0)');
$rJSON->gotoExpression('s2: s1q0 = 3'); $rJSON->processGotoExpression('s2: s1q0 = 3');
is($rJSON->lastResponse(), 4, '.. lastResponse changed to 4 due to goto(s2)'); is($rJSON->lastResponse(), 4, '.. lastResponse changed to 4 due to processGoto(s2)');
$rJSON->responses({}); $rJSON->responses({});
$rJSON->questionsAnswered(-1 * $rJSON->questionsAnswered); $rJSON->questionsAnswered(-1 * $rJSON->questionsAnswered);