From 9ea4f1cd205a381d9bfe21a53771f6f38c066b16 Mon Sep 17 00:00:00 2001 From: Patrick Donelan Date: Wed, 8 Apr 2009 08:12:14 +0000 Subject: [PATCH] Replaced Survey parseGotoExpression with dedicated ExpressionEngine. Improved gotoExpression validation error reporting Added lots more tests --- .../Asset/Wobject/Survey/ExpressionEngine.pm | 183 ++++++++++++++++++ .../Asset/Wobject/Survey/ResponseJSON.pm | 121 +----------- lib/WebGUI/Asset/Wobject/Survey/SurveyJSON.pm | 36 ++-- t/Asset/Wobject/Survey/ExpressionEngine.t | 102 ++++++++++ t/Asset/Wobject/Survey/ResponseJSON.t | 85 ++------ 5 files changed, 325 insertions(+), 202 deletions(-) create mode 100644 lib/WebGUI/Asset/Wobject/Survey/ExpressionEngine.pm create mode 100644 t/Asset/Wobject/Survey/ExpressionEngine.t diff --git a/lib/WebGUI/Asset/Wobject/Survey/ExpressionEngine.pm b/lib/WebGUI/Asset/Wobject/Survey/ExpressionEngine.pm new file mode 100644 index 000000000..111ca5f46 --- /dev/null +++ b/lib/WebGUI/Asset/Wobject/Survey/ExpressionEngine.pm @@ -0,0 +1,183 @@ +package WebGUI::Asset::Wobject::Survey::ExpressionEngine; + +=head1 NAME + +Package WebGUI::Asset::Wobject::Survey::ExpressionEngine + +=head1 DESCRIPTION + +This class is used to process Survey gotoExpressions. + +See L for more details. + +=cut + +use strict; +use Params::Validate qw(:all); +use Safe; +use Data::Dumper; +use List::Util qw/sum/; +Params::Validate::validation_options( on_fail => sub { WebGUI::Error::InvalidParam->throw( error => shift ) } ); + +# We need these as semi-globals so that utility subs (which are shared with the safe compartment) +# can access them. +my $session; +my $vars; +my $jump_count; +my $validate; +my $validTargets; + +=head2 var + +Utility sub shared with Safe compartment so that expressions can access allowed vars. + +=cut + +sub var($) { + my $key = shift; + my $value = $vars->{$key}; + $session->log->debug("[$key] resolves to [$value]"); + return $value; # scalar variable, so no need to clone +} + +=head2 jump + +Utility sub shared with Safe compartment so that expressions can call individual jump tests. + +Throws an exception containing the jump target when a jump matches, thus allowing L to +catch the first successful jump. + +=cut + +sub jump(&$) { + my ( $sub, $target ) = @_; + $jump_count++; + + # If $validTargets known, make sure target is valid + if ($validTargets && !exists $validTargets->{$target}) { + $session->log->debug("Invalid target [$target]"); + if ($validate) { + die("Invalid jump target \"$target\""); # bail and report error + } else { + return; # skip jump but continue with expression + } + } + + if ( $sub->() ) { + $session->log->debug("jump call #$jump_count is truthy"); + die( { jump => $target } ); + } + else { + $session->log->debug("jump call #$jump_count is falsey"); + } +} + +=head2 avg + +Utility sub shared with Safe compartment to allows expressions to easily compute the average +of a number of values + +=cut + +sub avg { + my @vals = @_; + return sum(@vals) / @vals; +} + +=head2 run ( $session, $expression, $opts ) + +Class method. + +Evaluates the given expression in a Safe compartment, giving the expression access to vars. + +=head3 session + +A WebGUI::Session + +=head3 expression + +The expression to run. + +A gotoExpression is essentially a perl expression that gets evaluated in a Safe compartment. + +To access Section/Question response values, the expression calls L. +To trigger a jump, the expression calls L. The first truthy jump succeeds. +We also give expressions access to some useful utility subs such as avg(), and all of the +handy subs from List::Util (min, max, sum, etc..). + +A very simple expression that checks if the response to s1q1 is 0 might look like: + + jump { var(s1q1) == 0 } target + +A more complicated gotoExpression with two possible jumps might look like: + + jump { var('my_var') > 5 and var('my_var2') =~ m/textmatch/ } target1; + jump { $avg = (var(q1) + var(q2) + var(q3)) / 3; return $avg > 10 } target2; + +=head3 opts (optional) + +Supported options are: + +=over 3 + +=item * vars + +Hashref of vars to make available to the expression via the L utility sub + +=item * validate + +Return errors rather than just logging them (useful for displaying survey validation errors to users) + +=back + +=cut + +sub run { + my $class = shift; + my ( $s, $expression, $opts ) + = validate_pos( @_, { isa => 'WebGUI::Session' }, { type => SCALAR }, { type => HASHREF, default => {} } ); + + # Init package globals + ( $session, $vars, $jump_count, $validate, $validTargets ) = ( $s, $opts->{vars}, 0, $opts->{validate}, $opts->{validTargets} ); + + # Create the Safe compartment + my $compartment = Safe->new(); + + # Share our utility subs with the compartment + $compartment->share('&var'); + $compartment->share('&jump'); + $compartment->share('&avg'); + + # Give them all of List::Util too + $compartment->share_from('List::Util', ['&first', '&max', '&maxstr', '&min', '&minstr', '&reduce', '&shuffle', '&sum',]); + + $session->log->debug("Expression is: \"$expression\""); + $compartment->reval($expression); + + # See if we ran the engine just to check for errors + if ($opts->{validate}) { + if ($@ && ref $@ ne 'HASH') { + my $error = $@; + $error =~ s/(.*?) at .*/$1/s; # don't reveal too much + return $error; + } + return; # no validation errors + } + + # A successful jump triggers a hashref containing the jump target to be thrown + if ( ref $@ && ref $@ eq 'HASH' && $@->{jump} ) { + my $jump = $@->{jump}; + $session->log->debug("Returning [$jump]"); + return $jump; + } + + # Log all other errors (for example compile errors from bad expressions) + if ($@) { + $session->log->error($@); + } + + # Return undef on failure + return; +} + +1; diff --git a/lib/WebGUI/Asset/Wobject/Survey/ResponseJSON.pm b/lib/WebGUI/Asset/Wobject/Survey/ResponseJSON.pm index 00097d045..a4dceebea 100644 --- a/lib/WebGUI/Asset/Wobject/Survey/ResponseJSON.pm +++ b/lib/WebGUI/Asset/Wobject/Survey/ResponseJSON.pm @@ -649,64 +649,21 @@ indicates that we should branch. =head3 $gotoExpression -The gotoExpression. - -A gotoExpression is a string representing a list of expressions (one per line) of the form: - - target: expression - target: expression - ... - -This subroutine iterates through the list, processing each line and, all things being -well, evaluates the expression. The first expression to evaluate to true triggers a -call to L<"processGoto">. - -The expression should be valid perl. Any section/question variables that you refer to -should be written as $var, as if your perl code had access to that variable. In reality, -those variables don't exist - they're substituted in via L and -then the expression is evaluated in a safe compartment. - -Here is an example using section variables S1 and S2 as jump targets and question -variables Q1-3 in the expression. It jumps to S1 if the user's answer to Q1 has a value -of 3, jumps to S2 if Q2 + Q3 < 10, and otherwise doesn't branch at all (the default). - - S1: $Q1 == 3 - S2: $Q2 + $Q3 < 10 - -You can do advanced branching by creating your own variables within the expression, for -example, to branch when the average of 3 questions is greater than 5: - S1: $avg = ($Q1 + $Q2 + $Q3) / 3; $avg > 5 +The gotoExpression. See L for more info. =cut - + sub processGotoExpression { my $self = shift; my ($expression) = validate_pos(@_, {type => SCALAR}); - - my $responsesByVariableName = $self->responsesByVariableName(); - - # Parse gotoExpressions one after the other (first one that's true wins) - foreach my $line (split /\n/, $expression) { - my $processed = WebGUI::Asset::Wobject::Survey::ResponseJSON->parseGotoExpression($self->session, $line, $responsesByVariableName); - - next if !$processed; - - # Eval expression in a safe compartment - # N.B. Expression does not need access to any variables - my $compartment = Safe->new(); - my $result = $compartment->reval($processed->{expression}); - - $self->session->log->warn($@) if $@; ## no critic - - if ($result) { - $self->session->log->debug("Truthy, goto [$processed->{target}]"); - $self->processGoto($processed->{target}); - return $processed; - } else { - $self->session->log->debug('Falsy, not branching'); - next; - } + + use WebGUI::Asset::Wobject::Survey::ExpressionEngine; + my $engine = "WebGUI::Asset::Wobject::Survey::ExpressionEngine"; + if (my $jump = $engine->run($self->session, $expression, { vars => $self->responsesByVariableName} )) { + $self->session->log->debug("Hit. Jumping to [$jump]"); + $self->processGoto($jump); } + $self->session->log->debug("No hits, falling through"); return; } @@ -788,66 +745,6 @@ sub responsesByVariableName { #------------------------------------------------------------------- -=head2 parseGotoExpression( ( $expression, $responses) - -Parses a single gotoExpression. Returns undef if processing fails, or the following hashref -if things work out well: - { target => $target, expression => $expression } - -=head3 $expression - -The expression to process - -=head3 $responses - -Hashref that maps questionNames to response values - -=head3 Explanation: - -Uses the following simple strategy: - -First, parse the expression as: - target: expression - -Replace each "$questionName" with its response value (from the $responses hashref) - -=cut - -sub parseGotoExpression { - my $class = shift; - my ($session, $expression, $responses) = validate_pos(@_, { isa => 'WebGUI::Session'}, { type => SCALAR }, { type => HASHREF, default => {} }); - - $session->log->debug("Parsing gotoExpression: $expression"); - - my ( $target, $rest ) = $expression =~ /\s* ([^:]+?) \s* : \s* (.*)/x; - - $session->log->debug("Parsed as Target: [$target], Expression: [$rest]"); - - if ( !defined $target ) { - $session->log->warn('Target undefined'); - return; - } - - if ( !defined $rest || $rest eq q{} ) { - $session->log->warn('Expression undefined'); - return; - } - - # Replace each "$questionName" with its response value - while ( my ( $questionName, $response ) = each %{$responses} ) { - $rest =~ s/\$$questionName/$response/g; - } - - $session->log->debug("Processed as: $rest"); - - return { - target => $target, - expression => $rest, - }; -} - -#------------------------------------------------------------------- - =head2 getTemplatedText ($text, $responses) Scans a string of text for instances of "[[var]]". Looks up each match in the given hash reference diff --git a/lib/WebGUI/Asset/Wobject/Survey/SurveyJSON.pm b/lib/WebGUI/Asset/Wobject/Survey/SurveyJSON.pm index c9abef908..458d6db7d 100644 --- a/lib/WebGUI/Asset/Wobject/Survey/SurveyJSON.pm +++ b/lib/WebGUI/Asset/Wobject/Survey/SurveyJSON.pm @@ -1222,13 +1222,13 @@ sub validateSurvey{ my $sNum = $s + 1; my $section = $self->section([$s]); if(! $self->validateGoto($section,$goodTargets)){ - push @messages,"Section $sNum has invalid Jump target: $section->{goto}"; + push @messages,"Section $sNum has invalid Jump target: \"$section->{goto}\""; } if(! $self->validateGotoInfiniteLoop($section)){ - push(@messages,"Section $sNum jumps to itself."); + push @messages,"Section $sNum jumps to itself."; } - if(! $self->validateGotoExpression($section,$goodTargets)){ - push(@messages,"Section $sNum has invalid Jump Expression: $section->{gotoExpression}"); + if(my $error = $self->validateGotoExpression($section,$goodTargets)){ + push @messages,"Section $sNum has invalid Jump Expression: \"$section->{gotoExpression}\". Error: $error"; } if (my $var = $section->{variable}) { if (my $count = $duplicateTargets->{$var}) { @@ -1242,19 +1242,19 @@ sub validateSurvey{ my $qNum = $q + 1; my $question = $self->question([$s,$q]); if(! $self->validateGoto($question,$goodTargets)){ - push(@messages,"Section $sNum Question $qNum has invalid Jump target: $question->{goto}"); + push @messages,"Section $sNum Question $qNum has invalid Jump target: \"$question->{goto}\""; } if(! $self->validateGotoInfiniteLoop($question)){ - push(@messages,"Section $sNum Question $qNum jumps to itself."); + push @messages,"Section $sNum Question $qNum jumps to itself."; } - if(! $self->validateGotoExpression($question,$goodTargets)){ - push(@messages,"Section $sNum Question $qNum has invalid Jump Expression: $question->{gotoExpression}"); + if(my $error = $self->validateGotoExpression($question,$goodTargets)){ + push @messages,"Section $sNum Question $qNum has invalid Jump Expression: \"$question->{gotoExpression}\". Error: $error"; } if($#{$question->{answers}} < 0){ - push(@messages,"Section $sNum Question $qNum does not have any answers."); + push @messages,"Section $sNum Question $qNum does not have any answers."; } if(! $question->{text} =~ /\w/){ - push(@messages,"Section $sNum Question $qNum does not have any text."); + push @messages,"Section $sNum Question $qNum does not have any text."; } if (my $var = $question->{variable}) { if (my $count = $duplicateTargets->{$var}) { @@ -1268,13 +1268,13 @@ sub validateSurvey{ my $aNum = $a + 1; my $answer = $self->answer([$s,$q,$a]); if(! $self->validateGoto($answer,$goodTargets)){ - push(@messages,"Section $sNum Question $qNum Answer $aNum has invalid Jump target: $answer->{goto}"); + push @messages,"Section $sNum Question $qNum Answer $aNum has invalid Jump target: \"$answer->{goto}\""; } if(! $self->validateGotoInfiniteLoop($answer)){ - push(@messages,"Section $sNum Question $qNum Answer $aNum jumps to itself."); + push @messages,"Section $sNum Question $qNum Answer $aNum jumps to itself."; } - if(! $self->validateGotoExpression($answer,$goodTargets)){ - push(@messages,"Section $sNum Question $qNum Answer $aNum has invalid Jump Expression: $answer->{gotoExpression}"); + if(my $error = $self->validateGotoExpression($answer,$goodTargets)){ + push @messages,"Section $sNum Question $qNum Answer $aNum has invalid Jump Expression: \"$answer->{gotoExpression}\". Error: $error"; } } } @@ -1301,10 +1301,12 @@ sub validateGotoInfiniteLoop{ sub validateGotoExpression{ my $self = shift; my $object = shift; - return 1 unless $object->{gotoExpression} =~ /\w/; + my $goodTargets = shift; + return unless $object->{gotoExpression}; - # The best we can do is return true/false on whether the gotoExpression parses - return WebGUI::Asset::Wobject::Survey::ResponseJSON->parseGotoExpression($self->session, $object->{gotoExpression}); + use WebGUI::Asset::Wobject::Survey::ExpressionEngine; + my $engine = "WebGUI::Asset::Wobject::Survey::ExpressionEngine"; + return $engine->run($self->session, $object->{gotoExpression}, { validate => 1, validTargets => $goodTargets } ); } =head2 section ($address) diff --git a/t/Asset/Wobject/Survey/ExpressionEngine.t b/t/Asset/Wobject/Survey/ExpressionEngine.t new file mode 100644 index 000000000..d21cbfd5f --- /dev/null +++ b/t/Asset/Wobject/Survey/ExpressionEngine.t @@ -0,0 +1,102 @@ +# 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 Tie::IxHash; + +#---------------------------------------------------------------------------- +# Init +my $session = WebGUI::Test->session; + +#---------------------------------------------------------------------------- +# Tests +my $tests = 33; +plan tests => $tests + 1; + +#---------------------------------------------------------------------------- +# put your tests here + +my $usedOk = use_ok('WebGUI::Asset::Wobject::Survey::ExpressionEngine'); + +SKIP: { + + skip $tests, "Unable to load ExpressionEngine" unless $usedOk; + + my $e = "WebGUI::Asset::Wobject::Survey::ExpressionEngine"; + + my %vars = ( + n => 5, + s1 => 'my string', + ); + + # These should all jump to 'target' + my @should_pass = ( + q{jump { 1 } target}, + q{jump { return 1 } target}, + q{jump { "string" } target}, + q{jump { var(n) == 5 } target}, + q{jump { var(n) > 0 } target}, + q{jump { var(s1) eq "my string" } target}, + q{jump { var(s1) =~ m/my/ } target}, + q{jump { var(n) == 4 or var(n) == 5 } target}, + q{jump { var(n) == 5 && var(n) > 0 } target}, + q{jump { (var(n) > 1 ? 10 : 11) == 10 } target}, + q{jump { $a=1; $a++; $a++; $a *= 2; $a == 6 } target}, + q{jump { @a = (1..10); $a[0] == 1 && @a == 10 } target}, # arrays + q{jump { if (var(n) == 5) { 1 } else { 0 } } target}, # if statement + q{jump { $q2 = 3; $avg = (var(n) + $q2) / 2; $avg == 4 } target}, # look ma, averages! + q{jump { $q2 = 3; avg(var(n), $q2) == 4 } target}, # look ma, built-in avg sub! + q{jump { var(n) == 5 } target; jump { var(n) == 5 } targetX}, # first jump wins + q{jump { var(n) == 0 } targetX; jump { var(n) == 5 } target}, # false jumps ignored + q{jump { min(3,5,2) == 2 } target}, # List::Util min + q{jump { sum(var(n),1,1,1) == 8 } target}, # List::Util sum, etc.. + ); + + my @should_fail = ( + 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 { var(n) == 500 } target}, + q{jump { var(s1) eq 'blah' } target}, + q{jump { time } target}, # time and other opcodes not allowed + ); + + for my $expr (@should_pass) { + is( $e->run( $session, $expr, { vars => \%vars } ), 'target', "\"$expr\" jumps as expected" ); + } + + for my $expr (@should_fail) { + is( $e->run( $session, $expr, { vars => \%vars } ), undef, "\"$expr\" fails as expected" ); + } + + $e->run( $session, q{jump {$x = var(s1); $x = 'X'} target}, { vars => \%vars } ); + is( $vars{s1}, 'my string', "Expression can't modify vars" ); + + like( $e->run( $session, '{', { validate => 1 } ), qr/Missing right curly/, "Validation option works" ); + + # Check validTargets option + is( $e->run( $session, q{jump {1} target}, { vars => \%vars, validTargets => { a => 1 } } ), + undef, 'target is not valid' ); + is( $e->run( $session, q{jump {1} target}, { vars => \%vars, validTargets => { target => 1 } } ), + 'target', '..whereas now it is ok' ); +} + +#---------------------------------------------------------------------------- +# Cleanup +END { } diff --git a/t/Asset/Wobject/Survey/ResponseJSON.t b/t/Asset/Wobject/Survey/ResponseJSON.t index aea8e451e..603706a22 100644 --- a/t/Asset/Wobject/Survey/ResponseJSON.t +++ b/t/Asset/Wobject/Survey/ResponseJSON.t @@ -22,7 +22,7 @@ my $session = WebGUI::Test->session; #---------------------------------------------------------------------------- # Tests -my $tests = 91; +my $tests = 59; plan tests => $tests + 1; #---------------------------------------------------------------------------- @@ -321,36 +321,6 @@ 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'); -#################################################### -# -# parseGotoExpression -# -#################################################### -my $c = 'WebGUI::Asset::Wobject::Survey::ResponseJSON'; -throws_ok { $c->parseGotoExpression($session, ) } 'WebGUI::Error::InvalidParam', 'processGotoExpression takes exception to empty arguments'; -is($c->parseGotoExpression($session, q{}), - undef, '.. and undef with empty expression'); -is($c->parseGotoExpression($session, 'blah-dee-blah-blah'), - undef, '.. and undef with duff expression'); -is($c->parseGotoExpression($session, ':'), - undef, '.. and undef with missing target'); -is($c->parseGotoExpression($session, 't1:'), - undef, '.. and undef with missing expression'); -cmp_deeply($c->parseGotoExpression($session, 't1: 1'), - { target => 't1', expression => '1'}, 'works for simple numeric expression'); -cmp_deeply($c->parseGotoExpression($session, 't1: 1 - 23 + 456 * (78 / 9.0)'), - { target => 't1', expression => '1 - 23 + 456 * (78 / 9.0)'}, 'works for expression using all algebraic tokens'); -cmp_deeply($c->parseGotoExpression($session, 't1: 1 != 3 <= 4 >= 5'), - { target => 't1', expression => '1 != 3 <= 4 >= 5'}, q{..works with other ops too}); -cmp_deeply($c->parseGotoExpression($session, 't1: $q1 + $q2 * $q3 - 4', { q1 => 11, q2 => 22, q3 => 33}), - { target => 't1', expression => '11 + 22 * 33 - 4'}, 'substitues q for value'); -cmp_deeply($c->parseGotoExpression($session, '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'); -cmp_deeply($c->parseGotoExpression($session, 't1: ($A < 4) and ($B < 4) or ($B > 6) && 1 || 1', { A => 2, B => 3}), - { target => 't1', expression => '(2 < 4) and (3 < 4) or (3 > 6) && 1 || 1'}, 'Boolean expressions ok'); -cmp_deeply($c->parseGotoExpression($session, 't1: $a = 1; $a++; $a > 1'), - { target => 't1', expression => '$a = 1; $a++; $a > 1'}, 'Assignment and compound statements ok too'); - #################################################### # # processGotoExpression @@ -368,53 +338,22 @@ $rJSON->recordResponses({ '1-0-0' => 'My chosen 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 <= 2 is false'); -ok(!$rJSON->processGotoExpression('s0: $s1q0 < 2 or $s1q0 < 1'), '3 < 2 || 3 < 1 is false'); -ok($rJSON->processGotoExpression('s0: $s1q0 < 2 or $s1q0 < 5'), '3 < 2 || 3 < 5 is true'); -ok(!$rJSON->processGotoExpression('s0: $s1q0 == 4 and 1 == 1'), '3 == 4 && 1 == 1 is false'); -ok($rJSON->processGotoExpression('s0: $s1q0 == 3 and 1 == 1'), '3 == 3 && 1 == 1 is true'); -ok(!$rJSON->processGotoExpression('s0: ($s1q0 > 1 ? 10 : 11) == 11'), '(3 > 1 ? 10 : 11) == 11 is false'); -ok($rJSON->processGotoExpression('s0: ($s1q0 > 1 ? 10 : 11) == 10'), '(3 > 1 ? 10 : 11) == 10 is true'); -ok($rJSON->processGotoExpression('s0: $a=1; $a++; $a++; $a *= 2; $a == 6'), 'Assignment and compound statements ok'); -ok(!$rJSON->processGotoExpression('s0: $a=1; $a++; $a++; $a *= 2; $a == 7'), '..negative ones too'); -ok($rJSON->processGotoExpression('s0: @a = (1..10); $a[0] == 1 && @a == 10'), 'arrays work too'); -ok($rJSON->processGotoExpression('s0: if ($s1q0 == 3) { 1 } else { 0 }'), 'if statements work'); -ok(!$rJSON->processGotoExpression('s0: if (time) { 1 } else { 1 }'), 'time and other things not allowed'); -ok($rJSON->processGotoExpression('s0: $q2 = 5; $avg = ($s1q0 + $q2) / 2; $avg == 4'), 'look ma, averages!'); +is($rJSON->lastResponse, 4, 'lastResponse at 4 before any gotoExpressions processed'); -cmp_deeply($rJSON->processGotoExpression(<<'END_EXPRESSION'), {target => 's2', expression => '3 == 3'}, 'first true expression wins'); -s0: $s1q0 <= 2 -s2: $s1q0 == 3 -END_EXPRESSION +$rJSON->processGotoExpression('blah-dee-blah-blah {'); +is($rJSON->lastResponse, 4, '..unchanged after duff expression'); -ok(!$rJSON->processGotoExpression(<<'END_EXPRESSION'), 'but multiple false expressions still false'); -s0: $s1q0 <= 2 -s2: $s1q0 == 345 -END_EXPRESSION +$rJSON->processGotoExpression('jump { var(s1q0) == 4} s0'); +is($rJSON->lastResponse, 4, '..unchanged after false 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->processGotoExpression('jump { var(s1q0) == 4} s0; jump { var(s1q0) == 5} s0;'); +is($rJSON->lastResponse, 4, '..similarly for multi-statement false expression'); -$rJSON->survey->question([1,0])->{questionType} = 'Text'; -$rJSON->lastResponse(2); -$rJSON->recordResponses({ - '1-0-0' => 'My text answer', -}); -is( $rJSON->responses->{'1-0-0'}->{value}, 'My text answer', 'Text type uses entered text' ); +$rJSON->processGotoExpression('jump { var(s1q0) == 3} s0'); +is($rJSON->lastResponse, -1, '..but updated to s0 after true expression'); -# Coming soon. -#ok($rJSON->processGotoExpression('s0: $s1q0 eq "Text answer"; print "hola!\n"'), 'text match'); -#ok(!$rJSON->processGotoExpression('s0: $s1q0 eq "Not the right text answer"'), 'negative text match'); +$rJSON->processGotoExpression('jump { var(s1q0) == 4} s0; jump { var(s1q0) == 3} s2'); +is($rJSON->lastResponse, 4, '..changed again for multi-statement true expression'); $rJSON->responses({}); $rJSON->questionsAnswered(-1 * $rJSON->questionsAnswered);