oqapi/webgui
2
0
Fork 0
Code Issues Pull requests Projects Releases Packages Wiki Activity Actions

Refactored next/last response/section related accessors and mutators

Browse source 
(and tests).

Added more documentation.
This commit is contained in:
Patrick Donelan 2009-02-06 01:55:33 +00:00
parent 669e986189
commit 90d314d2f1
2 changed files with 154 additions and 108 deletions
Download patch file Download diff file Expand all files Collapse all files

218
lib/WebGUI/Asset/Wobject/Survey/ResponseJSON.pm
View file

@ -18,13 +18,38 @@ Package WebGUI::Asset::Wobject::Survey::ResponseJSON
=head1 DESCRIPTION =head1 DESCRIPTION
Helper class for WebGUI::Asset::Wobject::Survey. It manages data Helper class for WebGUI::Asset::Wobject::Survey. "Reponse" in the context of
from the user, sets the order of questions and answers in the survey, this Wobject refers to a Survey response (not a single Question response).
based on branches, and gotos, and also handles expiring the survey ie, this class represents the complete state of a user's response to a Survey instance.
due to time limits.
Instances of this class contain a response property that can be serialized
as JSON to the database to allow for storage and retrieval of the complete state
of a survey response.
Survey instances that allow users to record multiple responses will persist multiple
instances of this class to the database (one per distinct user response).
Data stored in this object includes the order in which questions and answers are
presented to the user (surveyOrder), a snapshot of all completed questions
from the user (responses), the most recently answered question (lastResponse), the
number of questions answered (questionsAnswered) and the Survey start time (startTime).
This package is not intended to be used by any other Asset in WebGUI. This package is not intended to be used by any other Asset in WebGUI.
=head2 surveyOrder
Many methods in this class operate on the surveyOrder property.
This data strucutre is a deep set of arrays, similar in structure to
L<WebGUI::Asset::Wobject::Survey::SurveyJSON/Address Parameter>.
In general, the surveyOrder data structure looks like:
[ $sectionIndex, $questionIndex, [ $answerIndex1, $answerIndex2, ....]
There is one array element for every section and address in the survey. If there are
no questions, or no addresses, those array elements will not be present.
=cut =cut
use strict; use strict;
@ -41,7 +66,7 @@ Object constructor.
=head3 $survey =head3 $survey
A WebGUI::Asset::Wobject::Survey::SurveyJSON object that represents the current A L<WebGUI::Asset::Wobject::Survey::SurveyJSON> object that represents the current
survey. survey.
=head3 $json =head3 $json
@ -64,6 +89,8 @@ sub new {
# First define core members.. # First define core members..
_survey => $survey, _survey => $survey,
_session => $survey->session, _session => $survey->session,
# Store all properties that are (de)serialized to/from JSON in a private variable
_response => { _response => {
# Response hash defaults.. # Response hash defaults..
@ -85,10 +112,13 @@ sub new {
=head2 createSurveyOrder =head2 createSurveyOrder
Computes the order of Sections, Questions and Aswers for this Survey. The order is represented as Computers and stores the order of Sections, Questions and Aswers for this Survey.
an array of addresses (see L<"Address Parameter">), and is stored in the surveyOrder property. The order is represented as an array of addresses
(see L<WebGUI::Asset::Wobject::Survey::SurveyJSON/Address Parameter>),
and is stored in the surveyOrder property. See also the L<"surveyOrder"> accessor).
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 survey order leaves a record or what the user was presented with. The surveyOrder property is useful for keeping a record of what the user was presented with.
=cut =cut
@ -136,12 +166,12 @@ sub createSurveyOrder {
=head2 session =head2 session
Accessor method for the local WebGUI::Session reference Accessor method for the WebGUI::Session reference
=cut =cut
sub session { sub session {
my $self = shift; my $self = shift;
return $self->{_session}; return $self->{_session};
} }
@ -149,7 +179,7 @@ sub session {
=head2 freeze =head2 freeze
Serializes the object to JSON, after deleting the log and survey objects stored in it. Serializes the internal perl hash representing the Response to a JSON string
=cut =cut
@ -160,12 +190,10 @@ sub freeze {
#------------------------------------------------------------------- #-------------------------------------------------------------------
#Has the survey timed out?
=head2 hasTimedOut ( $limit ) =head2 hasTimedOut ( $limit )
Checks to see whether this survey has timed out, based on the internally stored starting Checks to see whether this survey has timed out, based on the internally stored starting
time, and $limit. time, and the suppied $limit value.
=head3 $limit =head3 $limit
@ -174,100 +202,90 @@ How long the user has to take the survey, in minutes.
=cut =cut
sub hasTimedOut{ sub hasTimedOut{
my $self=shift; my $self = shift;
my $limit = shift; my ($limit) = validate_pos(@_, {type => SCALAR});
return 1 if($self->startTime() + ($limit * 60) < time() and $limit > 0); return $limit > 0 && $self->startTime + $limit * 60 < time;
return 0;
} }
#------------------------------------------------------------------- #-------------------------------------------------------------------
#the index of the last surveyOrder entry shown
=head2 lastResponse ([ $responseIndex ]) =head2 lastResponse ([ $responseIndex ])
Mutator for the index of the last surveyOrder entry shown. With no arguments, Mutator. The lastResponse property represents the index of the most recent surveyOrder entry shown.
returns the lastResponse index.
=head3 $responseIndex This method returns (and optionally sets) the value of lastResponse.
If defined, sets the lastResponse to $responseIndex. =head3 $responseIndex (optional)
If defined, lastResponse is set to $responseIndex.
=cut =cut
sub lastResponse { sub lastResponse {
my $self = shift; my $self = shift;
my $res = shift; my ($responseIndex) = validate_pos(@_, {type => SCALAR, optional => 1});
if ( defined $res ) {
$self->response->{lastResponse} = $res; if ( defined $responseIndex ) {
} $self->response->{lastResponse} = $responseIndex;
else {
return $self->response->{lastResponse};
} }
return $self->response->{lastResponse};
} }
#------------------------------------------------------------------- #-------------------------------------------------------------------
=head2 questionsAnswered ([ $questionsAnswered ]) =head2 questionsAnswered ([ $questionsAnswered ])
Mutator for the number of questions answered. With no arguments, Mutator for the number of questions answered.
does a set. Returns (and optionally sets) the value of questionsAnswered.
=head3 $questionsAnswered. =head3 $questionsAnswered (optional)
If defined, increments the number of questions by $questionsAnswered If defined, increments the number of questions by $questionsAnswered
=cut =cut
sub questionsAnswered { sub questionsAnswered {
my $self = shift; my $self = shift;
my $answered = shift; my ($questionsAnswered) = validate_pos(@_, {type => SCALAR, optional => 1});
if ( defined $answered ) {
$self->response->{questionsAnswered} += $answered; if ( defined $questionsAnswered ) {
} $self->response->{questionsAnswered} += $questionsAnswered;
else {
return $self->response->{questionsAnswered};
} }
return $self->response->{questionsAnswered};
} }
#------------------------------------------------------------------- #-------------------------------------------------------------------
=head2 startTime ([ $newStartTime ]) =head2 startTime ([ $startTime ])
Mutator for the time the user began the survey. With no arguments, Mutator for the time the user began the survey.
returns the startTime. Returns (and optionally sets) the value of startTime.
=head3 $newStarttime =head3 $startTime (optional)
If defined, sets the starting time to $newStartTime. If defined, sets the starting time to $startTime.
=cut =cut
sub startTime { sub startTime {
my $self = shift; my $self = shift;
my $newTime = shift; my ($startTime) = validate_pos(@_, {type => SCALAR, optional => 1});
if ( defined $newTime ) {
$self->response->{startTime} = $newTime; if ( defined $startTime ) {
} $self->response->{startTime} = $startTime;
else {
return $self->response->{startTime};
} }
return $self->response->{startTime};
} }
#------------------------------------------------------------------- #-------------------------------------------------------------------
#array of addresses in which the survey should be presented
=head2 surveyOrder =head2 surveyOrder
Accessor for the survey order data structure. It is a deep set of arrays, similar in Accessor for surveyOrder (see L<"surveyOrder">).
structure to a WebGUI::Asset::Wobject::Survey::SurveyJSON address. N.B. Use L<"createSurveyOrder"> to modify surveyOrder.
[ $sectionIndex, $questionIndex, [ $answerIndex1, $answerIndex2, ....]
There is one array element for every section and address in the survey.
If there are no questions, or no addresses, those array elements will not be present.
=cut =cut
@ -278,47 +296,75 @@ sub surveyOrder {
#------------------------------------------------------------------- #-------------------------------------------------------------------
=head2 nextSectionId =head2 nextResponse
Relative to the surveyOrder and the lastResponse index, get the index of the Returns the index of the next item that should be shown to the user,
next section. Note, based on the number of questions in an section, this can that is, the index of the next item in the L<"surveyOrder"> array,
be the same as the current section index. e.g. L<"lastResponse"> + 1.
=cut =cut
sub nextSectionId { sub nextResponse {
my $self = shift;
return $self->lastResponse + 1;
}
#-------------------------------------------------------------------
=head2 nextResponseSectionIndex
Returns the Section index of the next item that should be
shown to the user, that is, the next item in the L<"surveyOrder"> array
relative to L<"lastResponse">.
We go to the effort of calling this property "nextResponseSectionIndex"
rather than just "nextSectionIndex" to emphasize that this property is
distinct from the "next" section index in the Survey. For example, in
a Section with multiple Questions, the value of nextResponseSectionIndex
will be the same value (the current section index) for all Questions
except the last Question.
=cut
sub nextResponseSectionIndex {
my $self = shift; my $self = shift;
return undef if $self->surveyEnd(); return undef if $self->surveyEnd();
return $self->surveyOrder->[ $self->lastResponse + 1 ]->[0]; return $self->surveyOrder->[ $self->nextResponse ]->[0];
} }
#------------------------------------------------------------------- #-------------------------------------------------------------------
=head2 nextSection =head2 nextResponseSection
Relative to the surveyOrder and the lastResponse index, gets the next section. Returns the Section corresponding to the next item that should be
Note, based on the number of questions in a section, this can be the same as shown to the user, that is, the next item in the L<"surveyOrder"> array
the current section. relative to L<"lastResponse">.
As with L<"nextResponseSectionIndex">, we go to the effort of calling this property "nextResponseSection"
rather than just "nextSection" to emphasize that this property is
distinct from the "next" section in the Survey.
=cut =cut
sub nextSection { sub nextResponseSection {
my $self = shift; my $self = shift;
return {} if $self->surveyEnd(); return {} if $self->surveyEnd();
return $self->survey->section( [ $self->surveyOrder->[ $self->lastResponse + 1 ]->[0] ] ); return $self->survey->section( [ $self->nextResponseSectionIndex ] );
} }
#------------------------------------------------------------------- #-------------------------------------------------------------------
=head2 currentSection =head2 lastResponseSectionIndex
Relative to the surveyOrder and the lastResponse index, get the current section. Returns the Section index of the last item that was shown to the user,
based on the L<"surveyOrder"> array and L<"lastResponse">.
=cut =cut
sub currentSection { sub lastResponseSectionIndex {
my $self = shift; my $self = shift;
return $self->survey->section( [ $self->surveyOrder->[ $self->lastResponse ]->[0] ] ); return $self->surveyOrder->[ $self->lastResponse ]->[0];
} }
#------------------------------------------------------------------- #-------------------------------------------------------------------
@ -343,7 +389,7 @@ A hash ref of form param data. Each element will look like:
"__aid__comment" => "answer comment", "__aid__comment" => "answer comment",
} }
where __qid__ is a question id, as described in L<nextQuestions>, and __aid__ is an where __qid__ is a question id, as described in L<"nextQuestions">, and __aid__ is an
answer id, also described there. answer id, also described there.
=head3 terminal processing =head3 terminal processing
@ -404,7 +450,7 @@ sub recordResponses {
my $goto; my $goto;
my $gotoExpression; my $gotoExpression;
my $section = $self->nextSection();#which gets the current section for the just submitted questions. IE, current response pointer has not moved forward for these questions my $section = $self->nextResponseSection();#which gets the current section for the just submitted questions. IE, current response pointer has not moved forward for these questions
if ( $section->{terminal} ) { if ( $section->{terminal} ) {
$sterminal = 1; $sterminal = 1;
@ -413,7 +459,7 @@ sub recordResponses {
#There were no questions in the section just displayed, so increment the lastResponse by one #There were no questions in the section just displayed, so increment the lastResponse by one
if ( ref $questions ne 'ARRAY' ) { if ( ref $questions ne 'ARRAY' ) {
$self->lastResponse( $self->lastResponse + 1 ); $self->lastResponse( $self->nextResponse );
return [ $sterminal, $terminalUrl ]; return [ $sterminal, $terminalUrl ];
} }
@ -468,7 +514,7 @@ sub recordResponses {
$terminal = 0; $terminal = 0;
} }
if($sterminal and $self->nextSection != $self->currentSection){ if($sterminal and $self->nextResponseSectionIndex != $self->lastResponseSectionIndex){
$terminal = 1; $terminal = 1;
} }
@ -691,7 +737,7 @@ sub getPreviousAnswer {
Returns an array ref of the next questions in the survey. The number of questions Returns an array ref of the next questions in the survey. The number of questions
returned is set by the questionsPerPage property of the next section, as determined returned is set by the questionsPerPage property of the next section, as determined
by nextSectionId rather than logical section ordering. by nextResponseSectionIndex rather than logical section ordering.
If no questions are available, then it returns an empty array ref. If no questions are available, then it returns an empty array ref.
@ -713,12 +759,12 @@ sub nextQuestions {
return [] if $self->surveyEnd; return [] if $self->surveyEnd;
my $nextSectionId = $self->nextSectionId; my $nextResponseSectionIndex = $self->nextResponseSectionIndex;
my $qPerPage = $self->survey->section( [ $self->nextSectionId ] )->{questionsPerPage}; my $qPerPage = $self->survey->section( [ $self->nextResponseSectionIndex ] )->{questionsPerPage};
#load Previous answer text #load Previous answer text
my $section = $self->nextSection(); my $section = $self->nextResponseSection();
$section->{'text'} =~ s/\[\[([^\%]*?)\]\]/$self->getPreviousAnswer($1)/eg; $section->{'text'} =~ s/\[\[([^\%]*?)\]\]/$self->getPreviousAnswer($1)/eg;
my $questions; my $questions;
@ -727,7 +773,7 @@ sub nextQuestions {
next next
if ( !exists $$qAddy[1] ); #skip this if it doesn't have a question (for sections with no questions) if ( !exists $$qAddy[1] ); #skip this if it doesn't have a question (for sections with no questions)
if ( $$qAddy[0] != $nextSectionId ) { if ( $$qAddy[0] != $nextResponseSectionIndex ) {
last; last;
} }
my %question = %{ $self->survey->question( [ $$qAddy[0], $$qAddy[1] ] ) }; my %question = %{ $self->survey->question( [ $$qAddy[0], $$qAddy[1] ] ) };

44
t/Asset/Wobject/Survey/ResponseJSON.t
View file

@ -166,51 +166,51 @@ ok( $rJSON->surveyEnd(), 'surveyEnd, with 9 elements, 20 >= end of survey');
#################################################### ####################################################
# #
# nextSectionId, nextSection, currentSection # nextResponseSectionIndex, nextResponseSection, lastResponseSectionIndex
# #
#################################################### ####################################################
$rJSON->lastResponse(0); $rJSON->lastResponse(0);
is($rJSON->nextSectionId(), 0, 'nextSectionId, lastResponse=0, nextSectionId=0'); is($rJSON->nextResponseSectionIndex, 0, 'nextResponseSectionIndex, lastResponse=0, nextResponseSectionIndex=0');
cmp_deeply( cmp_deeply(
$rJSON->nextSection, $rJSON->nextResponseSection,
$rJSON->survey->section([0]), $rJSON->survey->section([0]),
'lastResponse=0, nextSection = section 0' 'lastResponse=0, nextResponseSection = section 0'
); );
cmp_deeply( is(
$rJSON->currentSection, $rJSON->lastResponseSectionIndex,
$rJSON->survey->section([0]), 0,
'lastResponse=0, currentSection = section 0' 'lastResponse=0, lastResponseSectionIndex = 0'
); );
$rJSON->lastResponse(2); $rJSON->lastResponse(2);
is($rJSON->nextSectionId(), 1, 'nextSectionId, lastResponse=2, nextSectionId=1'); is($rJSON->nextResponseSectionIndex(), 1, 'nextResponseSectionIndex, lastResponse=2, nextResponseSectionIndex=1');
cmp_deeply( cmp_deeply(
$rJSON->nextSection, $rJSON->nextResponseSection,
$rJSON->survey->section([1]), $rJSON->survey->section([1]),
'lastResponse=2, nextSection = section 1' 'lastResponse=2, nextResponseSection = section 1'
); );
cmp_deeply( is(
$rJSON->currentSection, $rJSON->lastResponseSectionIndex,
$rJSON->survey->section([0]), 0,
'lastResponse=2, currentSection = section 0' 'lastResponse=2, lastResponseSectionIndex = 0'
); );
$rJSON->lastResponse(6); $rJSON->lastResponse(6);
is($rJSON->nextSectionId(), 3, 'nextSectionId, lastResponse=6, nextSectionId=3'); is($rJSON->nextResponseSectionIndex(), 3, 'nextResponseSectionIndex, lastResponse=6, nextResponseSectionIndex=3');
cmp_deeply( cmp_deeply(
$rJSON->nextSection, $rJSON->nextResponseSection,
$rJSON->survey->section([3]), $rJSON->survey->section([3]),
'lastResponse=0, nextSection = section 3' 'lastResponse=0, nextResponseSection = section 3'
); );
cmp_deeply( cmp_deeply(
$rJSON->currentSection, $rJSON->lastResponseSectionIndex,
$rJSON->survey->section([3]), 3,
'lastResponse=6, currentSection = section 3' 'lastResponse=6, lastResponseSectionIndex = 3'
); );
$rJSON->lastResponse(20); $rJSON->lastResponse(20);
is($rJSON->nextSectionId(), undef, 'nextSectionId, lastResponse > surveyEnd, nextSectionId=undef'); is($rJSON->nextResponseSectionIndex(), undef, 'nextResponseSectionIndex, lastResponse > surveyEnd, nextResponseSectionIndex=undef');
#################################################### ####################################################
# #