Refactored Survey for more happy endings
Refactored www_submitQuestions to use utility submitQuestions sub (for ease of testing) Replaced numeric flags, completedCode etc.. Added restart() and exitUrl() to the Expression Engine Added more Survey instance tests
This commit is contained in:
Patrick Donelan
parent
4332b57ba2
commit
79db642219
6 changed files with 255 additions and 118 deletions
|
|
@ -1415,52 +1415,39 @@ sub www_submitQuestions {
|
|||
|
||||
my $responses = $self->session->form->paramsHashRef();
|
||||
delete $responses->{func};
|
||||
|
||||
return $self->submitQuestions($responses);
|
||||
}
|
||||
|
||||
my @goodResponses = keys %{$responses}; #load everything.
|
||||
#-------------------------------------------------------------------
|
||||
|
||||
my $termInfo = $self->recordResponses( $responses );
|
||||
=head2 submitQuestions
|
||||
|
||||
if ( $termInfo->[0] ) {
|
||||
Handles questions submitted by the survey taker, adding them to their response.
|
||||
|
||||
=cut
|
||||
|
||||
sub submitQuestions {
|
||||
my $self = shift;
|
||||
my $responses = shift;
|
||||
|
||||
my $result = $self->recordResponses( $responses );
|
||||
|
||||
# check for special actions
|
||||
if ( my $url = $result->{terminal} ) {
|
||||
$self->session->log->debug('Terminal, surveyEnd');
|
||||
return $self->surveyEnd( $termInfo->[1] );
|
||||
return $self->surveyEnd( { exitUrl => $url } );
|
||||
} elsif ( exists $result->{exitUrl} ) {
|
||||
$self->session->log->debug('exitUrl triggered, surveyEnd');
|
||||
return $self->surveyEnd( { exitUrl => $result->{exitUrl} });
|
||||
} elsif ( my $restart = $result->{restart} ) {
|
||||
$self->session->log->debug('restart triggered');
|
||||
return $self->surveyEnd( { restart => $restart } );
|
||||
}
|
||||
|
||||
return $self->www_loadQuestions();
|
||||
|
||||
# my $files = 0;
|
||||
#
|
||||
# for my $id(@$orderOf){
|
||||
# if a file upload, write to disk
|
||||
# my $path;
|
||||
# if($id->{'questionType'} eq 'File Upload'){
|
||||
# $files = 1;
|
||||
# my $storage = WebGUI::Storage->create($self->session);
|
||||
# my $filename = $storage->addFileFromFormPost( $id->{'Survey_answerId'} );
|
||||
# $path = $storage->getPath($filename);
|
||||
# }
|
||||
# $self->session->errorHandler->error("Inserting a response ".$id->{'Survey_answerId'}." $responseId, $path, ".$$responses{$id->{'Survey_answerId'}});
|
||||
# $self->session->db->write("insert into Survey_questionResponse
|
||||
# select ?, Survey_sectionId, Survey_questionId, Survey_answerId, ?, ?, ?, now(), ?, ? from Survey_answer where Survey_answerId = ?",
|
||||
# [$self->getId(), $responseId, $$responses{ $id->{'Survey_answerId'} }, '', $path, ++$lastOrder, $id->{'Survey_answerId'}]);
|
||||
# }
|
||||
# if ($files) {
|
||||
# ##special case, need to check for more questions in section, if not, more current up one
|
||||
# my $lastA = $self->getLastAnswerInfo($responseId);
|
||||
# my $questionId = $self->getNextQuestionId( $lastA->{'Survey_questionId'} );
|
||||
# if ( !$questionId ) {
|
||||
# my $currentSection = $self->getCurrentSection($responseId);
|
||||
# $currentSection = $self->getNextSection($currentSection);
|
||||
# if ($currentSection) {
|
||||
# $self->setCurrentSection( $responseId, $currentSection );
|
||||
# }
|
||||
# }
|
||||
# return;
|
||||
# }
|
||||
# return $self->www_loadQuestions($responseId);
|
||||
|
||||
}
|
||||
|
||||
|
||||
#-------------------------------------------------------------------
|
||||
|
||||
=head2 www_goBack
|
||||
|
|
@ -1536,7 +1523,7 @@ sub www_loadQuestions {
|
|||
}
|
||||
if ( $self->responseJSON->hasTimedOut( $self->get('timeLimit') ) ) {
|
||||
$self->session->log->debug('Response hasTimedOut, surveyEnd');
|
||||
return $self->surveyEnd( undef, 2 );
|
||||
return $self->surveyEnd( { timeout => 1 } );
|
||||
}
|
||||
|
||||
if ( $self->responseJSON->surveyEnd() ) {
|
||||
|
|
@ -1568,37 +1555,51 @@ sub www_loadQuestions {
|
|||
|
||||
#-------------------------------------------------------------------
|
||||
|
||||
=head2 surveyEnd ( [ $url ], [ $completeCode ] )
|
||||
=head2 surveyEnd ( [ $options ] )
|
||||
|
||||
Marks the survey completed with either 1 or the $completeCode and then sends the url to the site home or if defined, $url.
|
||||
Marks the survey response as completed and carries out special actions such as restarting or exiting to an exitUrl
|
||||
|
||||
=head3 $url
|
||||
=head3 $options
|
||||
|
||||
An optional url to send the user to upon survey completion.
|
||||
The following options are supported
|
||||
|
||||
=head3 $completeCode
|
||||
=over3
|
||||
|
||||
An optional code (defaults to 1) to say how the user completed the survey.
|
||||
=item timeout
|
||||
|
||||
1 is normal completion.
|
||||
2 is timed out.
|
||||
Indicates that the survey has timed out. The doAfterTimeLimit setting controls whether the
|
||||
survey restarts or exits to the exitUrl.
|
||||
|
||||
=item restart
|
||||
|
||||
The survey should be restarted
|
||||
|
||||
=item exitUrl
|
||||
|
||||
Exit to the supplied url, or if no url is provided exit to the survey's exitUrl.
|
||||
|
||||
=cut
|
||||
|
||||
sub surveyEnd {
|
||||
my $self = shift;
|
||||
my $url = shift;
|
||||
my $completeCode = shift;
|
||||
|
||||
$completeCode = defined $completeCode ? $completeCode : 1;
|
||||
|
||||
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 ) {
|
||||
$self->session->db->setRow(
|
||||
'Survey_response',
|
||||
'Survey_responseId', {
|
||||
Survey_responseId => $responseId,
|
||||
endDate => scalar time, #WebGUI::DateTime->now->toDatabase,
|
||||
isComplete => $completeCode
|
||||
endDate => scalar time,
|
||||
isComplete => 1,
|
||||
}
|
||||
);
|
||||
|
||||
|
|
@ -1614,26 +1615,16 @@ sub surveyEnd {
|
|||
}
|
||||
)->start;
|
||||
}
|
||||
}
|
||||
if ($self->get('doAfterTimeLimit') eq 'restartSurvey' && $completeCode == 2){
|
||||
$self->responseJSON->startTime(scalar time);
|
||||
undef $self->{_responseJSON};
|
||||
undef $self->{responseId};
|
||||
return $self->www_loadQuestions('1');
|
||||
} else {
|
||||
if ( $url !~ /\w/ ) { $url = 0; }
|
||||
if ( $url eq 'undefined' ) { $url = 0; }
|
||||
if ( !$url ) {
|
||||
$url = $self->get('exitURL');
|
||||
if ( !$url ) {
|
||||
$url = q{/};
|
||||
}
|
||||
}
|
||||
}
|
||||
$url = $self->session->url->gateway($url) if($url !~ /^http:/i);
|
||||
#$self->session->http->setRedirect($url);
|
||||
#$self->session->http->setMimeType('application/json');
|
||||
my $json = to_json( { type => 'forward', url => $url } );
|
||||
|
||||
|
||||
# If we get this far, it's time to forward users to an exitUrl
|
||||
my $exitUrl = $opts{exitUrl};
|
||||
undef $exitUrl if $exitUrl !~ /\w/;
|
||||
undef $exitUrl if $exitUrl eq 'undefined';
|
||||
$exitUrl = $exitUrl || $self->get('exitURL') || q{/};
|
||||
$exitUrl = $self->session->url->gateway($exitUrl) if($exitUrl !~ /^https?:/i);
|
||||
my $json = to_json( { type => 'forward', url => $exitUrl } );
|
||||
$self->session->http->setMimeType('application/json');
|
||||
return $json;
|
||||
}
|
||||
|
|
|
|||
|
|
@ -309,6 +309,35 @@ sub jump(&$) {
|
|||
}
|
||||
}
|
||||
|
||||
=head2 exitUrl ( [$url] )
|
||||
|
||||
Same as L<jump> except that instead of a jump, triggers survey exit
|
||||
|
||||
=head3 url (optional)
|
||||
|
||||
Url to exit to. If not given, the Survey instance's exitUrl property will be used.
|
||||
|
||||
=cut
|
||||
|
||||
sub exitUrl {
|
||||
my ( $url ) = @_;
|
||||
|
||||
$session->log->debug("exitUrl($url)");
|
||||
die( { exitUrl => $url } );
|
||||
}
|
||||
|
||||
|
||||
=head2 restart ( $sub )
|
||||
|
||||
Same as L<jump> except that instead of a jump, triggers the Survey to restart
|
||||
|
||||
=cut
|
||||
|
||||
sub restart {
|
||||
$session->log->debug("restart()");
|
||||
die( { restart => 1 } );
|
||||
}
|
||||
|
||||
=head2 avg
|
||||
|
||||
Utility sub shared with Safe compartment to allows expressions to easily compute the average of a list
|
||||
|
|
@ -419,6 +448,8 @@ sub run {
|
|||
$compartment->share('&tagged');
|
||||
$compartment->share('&taggedX');
|
||||
$compartment->share('&jump');
|
||||
$compartment->share('&exitUrl');
|
||||
$compartment->share('&restart');
|
||||
$compartment->share('&avg');
|
||||
|
||||
# Give them all of List::Util too
|
||||
|
|
@ -440,10 +471,16 @@ sub run {
|
|||
}
|
||||
|
||||
# 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 => $jump, tags => $tags };
|
||||
if ( ref $@ && ref $@ eq 'HASH') {
|
||||
if (my $target = $@->{jump}) {
|
||||
return { jump => $target, tags => $tags };
|
||||
}
|
||||
if (exists $@->{exitUrl}) { # url might be undefined
|
||||
return { exitUrl => $@->{exitUrl}, tags => $tags };
|
||||
}
|
||||
if (my $restart = $@->{restart}) {
|
||||
return { restart => $restart, tags => $tags };
|
||||
}
|
||||
}
|
||||
|
||||
# See if an unresolved external reference was encountered
|
||||
|
|
|
|||
|
|
@ -79,24 +79,14 @@ sub new {
|
|||
# First define core members..
|
||||
_survey => $survey,
|
||||
_session => $survey->session,
|
||||
|
||||
# Store all properties that are (de)serialized to/from JSON in a private variable
|
||||
_response => {
|
||||
|
||||
# Response hash defaults..
|
||||
responses => {},
|
||||
lastResponse => -1,
|
||||
questionsAnswered => 0,
|
||||
startTime => time(),
|
||||
surveyOrder => undef,
|
||||
tags => {},
|
||||
|
||||
# And then allow jsonData to override defaults and/or add other members
|
||||
%{$jsonData},
|
||||
},
|
||||
};
|
||||
|
||||
return bless $self, $class;
|
||||
bless $self, $class;
|
||||
|
||||
# Initialise response data
|
||||
$self->resetResponse($jsonData);
|
||||
|
||||
return $self;
|
||||
}
|
||||
|
||||
#----------------------------------------------------------------------------
|
||||
|
|
@ -508,7 +498,7 @@ sub recordResponses {
|
|||
if ( !@questions and !$section->{logical}) {
|
||||
# No questions to process, so increment lastResponse and return
|
||||
$self->lastResponse( $self->nextResponse );
|
||||
return [ $sTerminal, $terminalUrl ];
|
||||
return $sTerminal ? { terminal => $terminalUrl} : {};
|
||||
}
|
||||
|
||||
# Process Questions in Section..
|
||||
|
|
@ -612,13 +602,22 @@ sub recordResponses {
|
|||
|
||||
# Process jumps and jump expressions in precedence order of:
|
||||
# answer goto, answer expression, question goto, question expression, section..
|
||||
$self->processGoto($answerGoto) if defined $answerGoto; ## no critic
|
||||
$self->processExpression($answerExpression) if defined $answerExpression; ## no critic
|
||||
$self->processGoto($questionGoto) if defined $questionGoto; ## no critic
|
||||
$self->processExpression($questionExpression) if defined $questionExpression; ## no critic
|
||||
$self->processGoto($sectionGoto) if defined $sectionGoto; ## no critic
|
||||
$self->processExpression($sectionExpression) if defined $sectionExpression; ## no critic
|
||||
|
||||
|
||||
# The joined logical OR here carries out the short-circuting for us
|
||||
# e.g. processGoto returns 1 on its first match
|
||||
# and processExpression returns hashref on its first match
|
||||
my $action = $self->processGoto($answerGoto) ||
|
||||
$self->processExpression($answerExpression) ||
|
||||
$self->processGoto($questionGoto) ||
|
||||
$self->processExpression($questionExpression) ||
|
||||
$self->processGoto($sectionGoto) ||
|
||||
$self->processExpression($sectionExpression);
|
||||
|
||||
# Special actions (such as exitUrl and restart) happen straight away
|
||||
if ($action && ref $action eq 'HASH') {
|
||||
return $action;
|
||||
}
|
||||
|
||||
# Handle next logic Section..
|
||||
my $section = $self->nextResponseSection();
|
||||
if ( $section and $section->{logical} ) {
|
||||
|
|
@ -634,7 +633,10 @@ sub recordResponses {
|
|||
$terminal = 1;
|
||||
}
|
||||
|
||||
return [ $terminal, $terminalUrl ];
|
||||
if ($terminal) {
|
||||
return { terminal => $terminalUrl };
|
||||
}
|
||||
return {};
|
||||
}
|
||||
|
||||
#-------------------------------------------------------------------
|
||||
|
|
@ -653,7 +655,9 @@ A variable name to match against all section and question variable names.
|
|||
|
||||
sub processGoto {
|
||||
my $self = shift;
|
||||
my ($goto) = validate_pos(@_, {type => SCALAR});
|
||||
my ($goto) = validate_pos(@_, {type => SCALAR|UNDEF});
|
||||
|
||||
return if !$goto;
|
||||
|
||||
if ($goto eq 'NEXT_SECTION') {
|
||||
$self->session->log->debug("NEXT_SECTION jump target encountered");
|
||||
|
|
@ -663,13 +667,13 @@ sub processGoto {
|
|||
while ($self->nextResponseSectionIndex == $lastResponseSectionIndex) {
|
||||
$self->lastResponse( $self->lastResponse + 1);
|
||||
}
|
||||
return;
|
||||
return 1;
|
||||
}
|
||||
|
||||
if ($goto eq 'END_SURVEY') {
|
||||
$self->session->log->debug("END_SURVEY jump target encountered");
|
||||
$self->lastResponse( scalar( @{ $self->surveyOrder} ) - 1 );
|
||||
return;
|
||||
return 1;
|
||||
}
|
||||
|
||||
# Iterate over items in order..
|
||||
|
|
@ -685,7 +689,7 @@ sub processGoto {
|
|||
|
||||
# Fudge lastResponse so that the next response item will be our matching item
|
||||
$self->lastResponse( $itemIndex - 1 );
|
||||
last;
|
||||
return 1;
|
||||
}
|
||||
|
||||
# See if our goto variable matches the question variable..
|
||||
|
|
@ -693,7 +697,7 @@ sub processGoto {
|
|||
|
||||
# Fudge lastResponse so that the next response item will be our matching item
|
||||
$self->lastResponse( $itemIndex - 1 );
|
||||
last;
|
||||
return 1;
|
||||
}
|
||||
|
||||
# Increment the item index counter
|
||||
|
|
@ -720,7 +724,9 @@ The expression. See L<WebGUI::Asset::Wobject::Survey::ExpressionEngine> for mor
|
|||
|
||||
sub processExpression {
|
||||
my $self = shift;
|
||||
my ($expression) = validate_pos(@_, {type => SCALAR});
|
||||
my ($expression) = validate_pos(@_, {type => SCALAR|UNDEF});
|
||||
|
||||
return if !$expression;
|
||||
|
||||
# Prepare the ingredients..
|
||||
my $values = $self->responseValuesByVariableName;
|
||||
|
|
@ -738,11 +744,19 @@ sub processExpression {
|
|||
|
||||
if (my $jump = $result->{jump}) {
|
||||
$self->session->log->debug("Jumping to [$jump]");
|
||||
$self->processGoto($jump);
|
||||
return $self->processGoto($jump);
|
||||
} elsif (exists $result->{exitUrl}) { # may be undefined
|
||||
my $exitUrl = $result->{exitUrl};
|
||||
$self->session->log->debug("exitUrl triggered [$exitUrl]");
|
||||
return { exitUrl => $exitUrl };
|
||||
} elsif (my $restart = $result->{restart}) {
|
||||
$self->session->log->debug("restart triggered");
|
||||
return { restart => $restart };
|
||||
} else {
|
||||
$self->session->log->debug("No hits, falling through");
|
||||
return;
|
||||
}
|
||||
}
|
||||
}
|
||||
return;
|
||||
}
|
||||
|
||||
|
|
@ -1349,6 +1363,37 @@ 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
|
||||
|
|
|
|||
Loading…
Add table
Add a link
Reference in a new issue