diff --git a/lib/WebGUI/Asset/Wobject/Survey/ExpressionEngine.pm b/lib/WebGUI/Asset/Wobject/Survey/ExpressionEngine.pm index 7d0742aee..17d4d5de1 100644 --- a/lib/WebGUI/Asset/Wobject/Survey/ExpressionEngine.pm +++ b/lib/WebGUI/Asset/Wobject/Survey/ExpressionEngine.pm @@ -38,10 +38,10 @@ my $other_instances; Utility sub that gives expressions access to recorded response values -value(question_variable) returns the recorded response value for the answer to question_variable +Returns the recorded response value for the answer to question_variable -value(asset_spec, question_variable) returns value(question_variable) on the most recent completed response - for the user on the survey instance given by asset_spec (either an assetId or a url) +If two arguments are provided, the first argument is assumed to be an asset spec (assetId or url). In this +case the sub is applied to the most recent completed response for the user on the survey instance given by asset_spec. =cut @@ -71,8 +71,12 @@ sub value { Utility sub that gives expressions access to recorded response scores. -score(question_variable) returns the score for the answer selected for question_variable -score(section_variable) returns the summed score for the answers to all the questions in section_variable +If the argument is a question variable, returns the score for the answer selected for question_variable. + +If the argument is a section variable, returns the summed score for the answers to all the questions in section_variable + +If two arguments are provided, the first argument is assumed to be an asset spec (assetId or url). In this +case the sub is applied to the most recent completed response for the user on the survey instance given by asset_spec. =cut @@ -98,6 +102,37 @@ sub score { return $score; # scalar variable, so no need to clone } +=head2 answered + +Returns true/false depending on whether use has actually reached and responded to the given question + +If two arguments are provided, the first argument is assumed to be an asset spec (assetId or url). In this +case the sub is applied to the most recent completed response for the user on the survey instance given by asset_spec. + +=cut + +sub answered { + # Two arguments implies the first arg is an asset_spec + if ( @_ == 2 ) { + my ( $asset_spec, $key ) = @_; + + # See if $other_instances already contains the external survey + if (my $other_instance = $other_instances->{$asset_spec}) { + my $values = $other_instance->{values}; + my $answered = exists $values->{$key}; + $session->log->debug("answered($asset_spec, $key) returns [$answered]"); + return $answered; + } else { + # Throw an exception, triggering run() to resolve the external reference and re-run + die( { other_instance => $asset_spec } ); + } + } + my $key = shift; + my $answered = exists $values->{$key}; + $session->log->debug("answered($key) returns [$answered]"); + return $answered; +} + =head2 jump Utility sub shared with Safe compartment so that expressions can call individual jump tests. @@ -160,7 +195,9 @@ A gotoExpression is essentially a perl expression that gets evaluated in a Safe To access Section/Question recorded response values, the expression calls L. To access Section/Question recorded response scores, the expression calls L. -Both L and L allow you to resolve values and scores from other completed survey +To determine if a user reached and answered a question, the expression calls L. + +All of these subs allow you to resolve values and scores from other completed survey instances. To trigger a jump, the expression calls L. The first truthy jump succeeds. @@ -226,6 +263,7 @@ sub run { # Share our utility subs with the compartment $compartment->share('&value'); $compartment->share('&score'); + $compartment->share('&answered'); $compartment->share('&jump'); $compartment->share('&avg'); diff --git a/t/Asset/Wobject/Survey/ExpressionEngine.t b/t/Asset/Wobject/Survey/ExpressionEngine.t index 9a65fa079..235b87ef0 100644 --- a/t/Asset/Wobject/Survey/ExpressionEngine.t +++ b/t/Asset/Wobject/Survey/ExpressionEngine.t @@ -22,7 +22,7 @@ my $session = WebGUI::Test->session; #---------------------------------------------------------------------------- # Tests -my $tests = 41; +my $tests = 42; plan tests => $tests + 1; #---------------------------------------------------------------------------- @@ -75,6 +75,7 @@ SKIP: { q{jump { min(3,5,2) == 2 } target}, # List::Util min q{jump { sum(value(n),1,1,1) == 8 } target}, # List::Util sum, etc.. q{jump { score(n1) == 1 && score(n2) == 2 } target}, # score() works + q{jump { answered(n) && !answered(X) } target}, # answered() works ); my @should_fail = ( @@ -111,7 +112,6 @@ SKIP: { is( $e->run( $session, q{jump {1} target}, { values => \%values, validTargets => { target => 1 } } ), 'target', '..whereas now it is ok' ); - # Create a test user $user = WebGUI::User->new( $session, 'new' ); WebGUI::Test->usersToDelete($user); diff --git a/t/Asset/Wobject/Survey/ResponseJSON.t b/t/Asset/Wobject/Survey/ResponseJSON.t index b740f6b3c..cc22ce536 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 = 82; +my $tests = 83; plan tests => $tests + 1; #---------------------------------------------------------------------------- @@ -432,6 +432,10 @@ $rJSON->nextResponse(2); # pretend we just finished s0q2 $rJSON->processGotoExpression('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'); +is($rJSON->nextResponse, 3, '..and again when answered() used'); + $rJSON->responses({}); $rJSON->questionsAnswered(-1 * $rJSON->questionsAnswered);