diff --git a/lib/WebGUI/Asset/Wobject/Survey.pm b/lib/WebGUI/Asset/Wobject/Survey.pm index bd42b4896..e9fa15a5c 100644 --- a/lib/WebGUI/Asset/Wobject/Survey.pm +++ b/lib/WebGUI/Asset/Wobject/Survey.pm @@ -1584,26 +1584,40 @@ sub surveyEnd { my $self = shift; my %opts = validate(@_, { timeout => 0, restart => 0, exitUrl => 0 }); - # See if we should restart the Survey instead of completing it - if ( $opts{restart} || ( $opts{timeout} && $self->get('doAfterTimeLimit') eq 'restartSurvey' ) ){ - $self->responseJSON->resetResponse(); - $self->persistResponseJSON; - delete $self->{responseId}; - return $self->www_loadQuestions('1'); - } - # If an in-progress response exists, mark it as complete if ( my $responseId = $self->responseId ) { + # Decide if we should flag any special actions such as restart or timeout + my $restart = $opts{restart}; + my $timeoutRestart = $opts{timeout} && $self->get('doAfterTimeLimit') eq 'restartSurvey'; + my $timeout = $opts{timeout}; + + # First thing to do is to end the current response (and flag why it happened) + my $completeCode + = $timeoutRestart ? 4 + : $timeout ? 3 + : $restart ? 2 + : 1 + ; + $self->session->log->debug("Completing survey response $responseId with completeCode: $completeCode"); + $self->session->db->setRow( 'Survey_response', 'Survey_responseId', { Survey_responseId => $responseId, endDate => scalar time, - isComplete => 1, + isComplete => $completeCode, } ); - # Trigger workflow + # When restarting, we just need to uncache everything response-related + if ( $restart || $timeoutRestart ) { + $self->session->log->debug("Detaching from response $responseId as part of restart"); + delete $self->{_responseJSON}; + delete $self->{responseId}; + return $self->www_loadQuestions(1); + } + + # Trigger workflow for everything else if ( my $workflowId = $self->get('onSurveyEndWorkflowId') ) { $self->session->log->debug("Triggering onSurveyEndWorkflowId workflow: $workflowId"); WebGUI::Workflow::Instance->create( @@ -1806,7 +1820,6 @@ sub responseId { my $user = WebGUI::User->new($self->session, $userId); if (!defined $self->{responseId}) { - my $ip = $self->session->env->getIp; my $id = $userId || $self->session->user->userId; my $anonId = $self->session->form->process('userid'); @@ -1840,7 +1853,6 @@ sub responseId { [ $id, $ip, $self->getId() ] ); } - if ( !$responseId ) { my $maxResponsesPerUser = $self->get('maxResponsesPerUser'); my $haveTaken; @@ -1857,7 +1869,6 @@ sub responseId { "select count(*) from Survey_response where $string = ? and assetId = ?", [ $id, $self->getId() ] ); } - if ( $maxResponsesPerUser == 0 || $haveTaken < $maxResponsesPerUser ) { $responseId = $self->session->db->setRow( 'Survey_response', diff --git a/lib/WebGUI/Asset/Wobject/Survey/ResponseJSON.pm b/lib/WebGUI/Asset/Wobject/Survey/ResponseJSON.pm index cac14a5cd..2da56f4d3 100644 --- a/lib/WebGUI/Asset/Wobject/Survey/ResponseJSON.pm +++ b/lib/WebGUI/Asset/Wobject/Survey/ResponseJSON.pm @@ -76,17 +76,23 @@ sub new { # Create skeleton object.. my $self = { - # First define core members.. _survey => $survey, _session => $survey->session, + _response => { + # Response hash defaults.. + responses => {}, + lastResponse => -1, + questionsAnswered => 0, + startTime => time(), + surveyOrder => undef, + tags => {}, + + # And then jsonData overrides + %{$jsonData}, + } }; bless $self, $class; - - # Initialise response data - $self->resetResponse($jsonData); - - return $self; } #---------------------------------------------------------------------------- @@ -1363,37 +1369,6 @@ sub returnResponseForReporting { #------------------------------------------------------------------- -=head2 resetResponse ( [$data] ) - -Resets all response data (e.g. for when you want to restart a survey) - -=head3 data (optional) - -Extra data to apply over the defaults - -=cut - -sub resetResponse { - my $self = shift; - my $data = shift || {}; - - $self->{_response} = { - - # Response hash defaults.. - responses => {}, - lastResponse => -1, - questionsAnswered => 0, - startTime => time(), - surveyOrder => undef, - tags => {}, - - # And then allow overrides - %{$data}, - }; -} - -#------------------------------------------------------------------- - =head2 response Accessor for the Perl hash containing Response data diff --git a/t/Asset/Wobject/Survey.t b/t/Asset/Wobject/Survey.t index 220a35899..d6794edd2 100644 --- a/t/Asset/Wobject/Survey.t +++ b/t/Asset/Wobject/Survey.t @@ -18,7 +18,7 @@ my $session = WebGUI::Test->session; #---------------------------------------------------------------------------- # Tests -my $tests = 24; +my $tests = 25; plan tests => $tests + 1; #---------------------------------------------------------------------------- @@ -116,9 +116,10 @@ cmp_deeply( 'submitQuestions does the right thing' ); -# Test out Restart +# Test Restart $s->surveyEnd( { restart => 1 } ); cmp_deeply($s->responseJSON->responses, {}, 'restart removes the in-progress response'); +ok($responseId ne $s->responseId, '..and uses a new responseId'); # Test out exitUrl with an explicit use JSON; diff --git a/t/Asset/Wobject/Survey/SurveyJSON.t b/t/Asset/Wobject/Survey/SurveyJSON.t index 9a1edb6c0..2ddb60a80 100644 --- a/t/Asset/Wobject/Survey/SurveyJSON.t +++ b/t/Asset/Wobject/Survey/SurveyJSON.t @@ -14,7 +14,6 @@ use WebGUI::Test; # Must use this before any other WebGUI modules use WebGUI::Session; use JSON; use Clone qw/clone/; -#use Storable qw/dclone/; #---------------------------------------------------------------------------- # Init