Started refactoring the Survey.pm Wobject class
Refactored www_jumpTo and added tests Added Params::Validate Improved docs Made call to SurveyJSON->createSurveyOrder() unnecessary Turned ResponseJSON->nextResponse a mutator
This commit is contained in:
Patrick Donelan
parent
ba6764065b
commit
d882181fd1
5 changed files with 211 additions and 86 deletions
|
|
@ -19,6 +19,8 @@ use WebGUI::Utility;
|
|||
use base 'WebGUI::Asset::Wobject';
|
||||
use WebGUI::Asset::Wobject::Survey::SurveyJSON;
|
||||
use WebGUI::Asset::Wobject::Survey::ResponseJSON;
|
||||
use Params::Validate qw(:all);
|
||||
Params::Validate::validation_options( on_fail => sub { WebGUI::Error::InvalidParam->throw( error => shift ) } );
|
||||
|
||||
#-------------------------------------------------------------------
|
||||
|
||||
|
|
@ -176,16 +178,15 @@ sub definition {
|
|||
},
|
||||
);
|
||||
|
||||
push(
|
||||
@{$definition}, {
|
||||
push @{$definition}, {
|
||||
assetName => $i18n->get('assetName'),
|
||||
icon => 'survey.gif',
|
||||
autoGenerateForms => 1,
|
||||
tableName => 'Survey',
|
||||
className => 'WebGUI::Asset::Wobject::Survey',
|
||||
properties => \%properties
|
||||
}
|
||||
);
|
||||
};
|
||||
|
||||
return $class->SUPER::definition( $session, $definition );
|
||||
}
|
||||
|
||||
|
|
@ -216,7 +217,8 @@ Override importAssetCollateralData so that surveyJSON gets imported from package
|
|||
sub importAssetCollateralData {
|
||||
my ( $self, $data ) = @_;
|
||||
my $surveyJSON = $data->{properties}{surveyJSON};
|
||||
$self->session->db->write( "update Survey set surveyJSON = ? where assetId = ?", [ $surveyJSON, $self->getId ] );
|
||||
$self->session->db->write( 'update Survey set surveyJSON = ? where assetId = ?', [ $surveyJSON, $self->getId ] );
|
||||
return;
|
||||
}
|
||||
|
||||
#-------------------------------------------------------------------
|
||||
|
|
@ -232,7 +234,7 @@ sub duplicate {
|
|||
my $options = shift;
|
||||
my $newAsset = $self->SUPER::duplicate($options);
|
||||
$self->loadSurveyJSON();
|
||||
$self->session->db->write( "update Survey set surveyJSON = ? where assetId = ?",
|
||||
$self->session->db->write( 'update Survey set surveyJSON = ? where assetId = ?',
|
||||
[ $self->survey->freeze, $newAsset->getId ] );
|
||||
return $newAsset;
|
||||
}
|
||||
|
|
@ -241,50 +243,63 @@ sub duplicate {
|
|||
|
||||
=head2 loadSurveyJSON ( )
|
||||
|
||||
Loads the survey collateral into memory so that the survey objects can be created
|
||||
Loads the survey collateral into memory so that the surveyJSON object can be created.
|
||||
After this method returns, calls to L<"survey"> will return a surveyJSON instance.
|
||||
Successive calls to this method have no effect.
|
||||
|
||||
=head3 json (optional)
|
||||
|
||||
A json-encoded string representing a valid SurveyJSON serialization. If provided,
|
||||
will be used to instantiate the SurveyJSON instance rather than querying the database.
|
||||
|
||||
=cut
|
||||
|
||||
sub loadSurveyJSON {
|
||||
my $self = shift;
|
||||
my $jsonHash = shift;
|
||||
if ( defined $self->survey ) { return; } #already loaded
|
||||
my ($json) = validate_pos(@_, { type => SCALAR, optional => 1 });
|
||||
|
||||
$jsonHash = $self->session->db->quickScalar( "select surveyJSON from Survey where assetId = ?", [ $self->getId ] )
|
||||
if ( !defined $jsonHash );
|
||||
# Do nothing if survey is already loaded
|
||||
return if $self->survey;
|
||||
|
||||
$self->{survey} = WebGUI::Asset::Wobject::Survey::SurveyJSON->new( $self->session, $jsonHash );
|
||||
# See if we need to load surveyJSON from the database
|
||||
if ( ! defined $json ) {
|
||||
$json
|
||||
= $self->session->db->quickScalar( 'select surveyJSON from Survey where assetId = ?', [ $self->getId ] );
|
||||
}
|
||||
|
||||
# Instantiate the SurveyJSON instance, and store it
|
||||
return $self->{survey} = WebGUI::Asset::Wobject::Survey::SurveyJSON->new( $self->session, $json );
|
||||
}
|
||||
|
||||
#-------------------------------------------------------------------
|
||||
|
||||
=head2 saveSurveyJSON ( )
|
||||
|
||||
Saves the survey collateral to the DB
|
||||
Serializes the SurveyJSON instance and persists it to the DB
|
||||
|
||||
=cut
|
||||
|
||||
|
||||
sub saveSurveyJSON {
|
||||
my $self = shift;
|
||||
|
||||
my $data = $self->survey->freeze();
|
||||
|
||||
$self->session->db->write( "update Survey set surveyJSON = ? where assetId = ?", [ $data, $self->getId ] );
|
||||
$self->session->db->write( 'update Survey set surveyJSON = ? where assetId = ?', [ $data, $self->getId ] );
|
||||
|
||||
return;
|
||||
}
|
||||
|
||||
#-------------------------------------------------------------------
|
||||
|
||||
=head2 survey ( )
|
||||
|
||||
Helper to access the survey object.
|
||||
Accessor for the SurveyJSON object. See L<"loadSurveyJSON"> and L<"saveSurveyJSON">
|
||||
|
||||
=cut
|
||||
|
||||
sub survey { return shift->{survey}; }
|
||||
sub littleBuddy { return shift->{survey}; }
|
||||
sub allyourbases { return shift->{survey}; }
|
||||
sub helpmehelpme { return shift->{survey}; }
|
||||
sub survey {
|
||||
return shift->{survey};
|
||||
}
|
||||
|
||||
#-------------------------------------------------------------------
|
||||
|
||||
|
|
@ -298,20 +313,20 @@ sub www_editSurvey {
|
|||
my $self = shift;
|
||||
|
||||
return $self->session->privilege->insufficient()
|
||||
unless ( $self->session->user->isInGroup( $self->get('groupToEditSurvey') ) );
|
||||
if !$self->session->user->isInGroup( $self->get('groupToEditSurvey') );
|
||||
|
||||
my %var;
|
||||
my $out = $self->processTemplate( \%var, $self->get("surveyEditTemplateId") );
|
||||
|
||||
return $out;
|
||||
return $self->processTemplate( {}, $self->get('surveyEditTemplateId') );
|
||||
}
|
||||
|
||||
#-------------------------------------------------------------------
|
||||
|
||||
=head2 www_submitObjectEdit ( )
|
||||
|
||||
This is called when an edit is submitted to a survey object. The POST should contain the id and updated params
|
||||
of the object, and also if the object is being deleted or copied.
|
||||
This is called when an edit is submitted to a survey object. The POST should contain the id and updated params
|
||||
of the object, and also if the object is being deleted or copied.
|
||||
|
||||
In general, the id contains a section index, question index, and answer index, separated by dashes.
|
||||
See L<WebGUI::Asset::Wobject::Survey::ResponseJSON/sectionIndex>.
|
||||
|
||||
=cut
|
||||
|
||||
|
|
@ -319,14 +334,16 @@ sub www_submitObjectEdit {
|
|||
my $self = shift;
|
||||
|
||||
return $self->session->privilege->insufficient()
|
||||
unless ( $self->session->user->isInGroup( $self->get('groupToEditSurvey') ) );
|
||||
if !$self->session->user->isInGroup( $self->get('groupToEditSurvey') );
|
||||
|
||||
# my $ref = @{from_json($self->session->form->process("data"))};
|
||||
my $responses = $self->session->form->paramsHashRef();
|
||||
|
||||
# Id is made up of: sectionIndex-questionIndex-answerIndex
|
||||
my @address = split /-/, $responses->{id};
|
||||
|
||||
$self->loadSurveyJSON();
|
||||
|
||||
# See if any special actions were requested..
|
||||
if ( $responses->{delete} ) {
|
||||
return $self->deleteObject( \@address );
|
||||
}
|
||||
|
|
@ -334,60 +351,86 @@ sub www_submitObjectEdit {
|
|||
return $self->copyObject( \@address );
|
||||
}
|
||||
|
||||
# each object checks the ref and then either updates or passes it to the correct child. New objects will have an index of -1.
|
||||
# Each object checks the address and then either updates or passes it to the correct child. New objects will have an index of -1.
|
||||
my $message = $self->survey->update( \@address, $responses );
|
||||
|
||||
# Persist the changes
|
||||
$self->saveSurveyJSON();
|
||||
|
||||
# Return the updated Survey structure
|
||||
return $self->www_loadSurvey( { address => \@address } );
|
||||
} ## end sub www_submitObjectEdit
|
||||
}
|
||||
|
||||
#-------------------------------------------------------------------
|
||||
=head2 Allow survey editors to "jump to" a particular section of question in a
|
||||
=head2 www_jumpTo
|
||||
|
||||
Allow survey editors to jump to a particular section or question in a
|
||||
Survey by tricking Survey into thinking they've completed the survey up to that
|
||||
point. Useful for survey builders.
|
||||
point. This is useful for user-testing large Survey instances where you don't want
|
||||
to waste your time clicking through all of the initial questions to get to the one
|
||||
you want to look at.
|
||||
|
||||
Note that calling this method will delete any existing survey responses for the
|
||||
current user (although only survey builders can call this method so that shouldn't be
|
||||
a problem
|
||||
a problem).
|
||||
|
||||
=cut
|
||||
|
||||
sub www_jumpTo {
|
||||
my $self = shift;
|
||||
|
||||
return $self->session->privilege->insufficient()
|
||||
unless ( $self->session->user->isInGroup( $self->get('groupToEditSurvey') ) );
|
||||
if !$self->session->user->isInGroup( $self->get('groupToEditSurvey') );
|
||||
|
||||
my $data = $self->session->form->paramsHashRef();
|
||||
my $id = $self->session->form->param('id');
|
||||
|
||||
$self->session->log->debug("jumpTo to $data->{id}");
|
||||
# When the Edit Survey screen first loads the first section will have an id of 'undefined'
|
||||
# In this case, treat it the same as '0'
|
||||
$id = $id eq 'undefined' ? 0 : $id;
|
||||
|
||||
$self->session->log->debug("www_jumpTo: $id");
|
||||
|
||||
# Remove existing responses for current user
|
||||
$self->session->db->write( 'delete from Survey_response where assetId = ? and userId = ?',
|
||||
[ $self->getId, $self->session->user->userId() ] );
|
||||
my $responseId = $self->getResponseId();
|
||||
|
||||
$self->loadBothJSON();
|
||||
# Create a new response (and trigger loadBothJSON())
|
||||
$self->getResponseId();
|
||||
|
||||
# iterate over surveyOrder looking for the jumpTo target
|
||||
for my $i ( 0 .. $#{ $self->response->surveyOrder() } ) {
|
||||
my $address = $self->response->surveyOrder()->[$i];
|
||||
# Break the $id down into sIndex and qIndex
|
||||
my ($sIndex, $qIndex) = split /-/, $id;
|
||||
|
||||
my @possibilities = (
|
||||
$self->survey->section($address),
|
||||
$self->survey->question($address),
|
||||
);
|
||||
foreach my $possibilty (@possibilities) {
|
||||
if ( ref $possibilty eq 'HASH' && $possibilty->{id} eq $data->{id} ) {
|
||||
$self->session->log->debug("Found jumpTo target");
|
||||
$self->response->lastResponse( $i - 1 );
|
||||
$self->saveResponseJSON();
|
||||
last;
|
||||
}
|
||||
# Go through items in surveyOrder until we find the item corresponding to $id
|
||||
my $currentIndex = 0;
|
||||
for my $address (@{ $self->response->surveyOrder }) {
|
||||
my ($order_sIndex, $order_qIndex) = @{$address}[0,1];
|
||||
|
||||
# For starters, check that we're on the right Section
|
||||
if ($sIndex ne $order_sIndex) {
|
||||
|
||||
# Bad luck, try the next one..
|
||||
$currentIndex++;
|
||||
next;
|
||||
}
|
||||
}
|
||||
$self->session->log->debug("Unable to find jumpTo target");
|
||||
|
||||
return $self->www_takeSurvey;
|
||||
# For a match, either qIndex must be empty (target is a Section), or
|
||||
# the qIndices must match
|
||||
if (!defined $qIndex || $qIndex eq $order_qIndex) {
|
||||
|
||||
# Set the nextResponse to be the index we're up to
|
||||
$self->session->log->debug("Found id: $id at index: $currentIndex in surveyOrder");
|
||||
$self->response->nextResponse( $currentIndex );
|
||||
$self->saveResponseJSON();
|
||||
return $self->www_takeSurvey;
|
||||
}
|
||||
|
||||
# Keep looking..
|
||||
$currentIndex++;
|
||||
}
|
||||
|
||||
# Search failed, so return the Edit Survey page instead.
|
||||
$self->session->log->debug("Unable to find id: $id");
|
||||
return $self->www_editSurvey;
|
||||
}
|
||||
|
||||
#-------------------------------------------------------------------
|
||||
|
|
@ -1267,15 +1310,24 @@ If the user is anonymous, the IP is used. Or an email'd or linked code can be u
|
|||
|
||||
sub getResponseId {
|
||||
my $self = shift;
|
||||
my %opts = validate(@_, { noCookie => 0 } ); # This is a hack to allow for testing (cookies cause problems)
|
||||
|
||||
return $self->{responseId} if ( defined $self->{responseId} );
|
||||
|
||||
my $ip = $self->session->env->getIp;
|
||||
my $id = $self->session->user->userId();
|
||||
my $anonId
|
||||
= $self->session->form->process("userid")
|
||||
|| $self->session->http->getCookies->{"Survey2AnonId"}
|
||||
|| undef;
|
||||
$self->session->http->setCookie( "Survey2AnonId", $anonId ) if ($anonId);
|
||||
|
||||
my $anonId = $self->session->form->process("userid");
|
||||
|
||||
unless ($opts{noCookie}) {
|
||||
$anonId ||= $self->session->http->getCookies->{"Survey2AnonId"};
|
||||
}
|
||||
|
||||
$anonId ||= undef;
|
||||
|
||||
unless ($opts{noCookie}) {
|
||||
$self->session->http->setCookie( "Survey2AnonId", $anonId ) if ($anonId);
|
||||
}
|
||||
|
||||
my $responseId;
|
||||
|
||||
|
|
@ -1336,8 +1388,9 @@ sub getResponseId {
|
|||
anonId => $anonId
|
||||
}
|
||||
);
|
||||
# $self->session->log->warn("post: $responseId");
|
||||
$self->loadBothJSON($responseId);
|
||||
$self->response->createSurveyOrder();
|
||||
# $self->response->createSurveyOrder();
|
||||
$self->{responseId} = $responseId;
|
||||
$self->saveResponseJSON();
|
||||
|
||||
|
|
|
|||
|
|
@ -140,7 +140,7 @@ sub new {
|
|||
lastResponse => -1,
|
||||
questionsAnswered => 0,
|
||||
startTime => time(),
|
||||
surveyOrder => [],
|
||||
surveyOrder => undef,
|
||||
|
||||
# And then allow jsonData to override defaults and/or add other members
|
||||
%{$jsonData},
|
||||
|
|
@ -152,16 +152,17 @@ sub new {
|
|||
|
||||
#----------------------------------------------------------------------------
|
||||
|
||||
=head2 createSurveyOrder
|
||||
=head2 initSurveyOrder
|
||||
|
||||
Computers and stores the order of Sections, Questions and Aswers for this Survey.
|
||||
See L<"surveyOrder">.
|
||||
Computes and stores the order of Sections, Questions and Aswers for this Survey.
|
||||
See L<"surveyOrder">. You normally don't need to call this, as L<"surveyOrder"> will
|
||||
call it for you the first time it is used.
|
||||
|
||||
Questions and Answers that are set to be randomized are shuffled into a random order.
|
||||
|
||||
=cut
|
||||
|
||||
sub createSurveyOrder {
|
||||
sub initSurveyOrder {
|
||||
my $self = shift;
|
||||
|
||||
# Order Questions in each Section
|
||||
|
|
@ -324,28 +325,43 @@ sub startTime {
|
|||
=head2 surveyOrder
|
||||
|
||||
Accessor for surveyOrder (see L<"surveyOrder">).
|
||||
N.B. Use L<"createSurveyOrder"> to modify surveyOrder.
|
||||
Initialized on first access via L<"initSurveyOrder">.
|
||||
|
||||
=cut
|
||||
|
||||
sub surveyOrder {
|
||||
my $self = shift;
|
||||
|
||||
if (!defined $self->response->{surveyOrder}) {
|
||||
$self->initSurveyOrder();
|
||||
}
|
||||
|
||||
return $self->response->{surveyOrder};
|
||||
}
|
||||
|
||||
#-------------------------------------------------------------------
|
||||
|
||||
=head2 nextResponse
|
||||
=head2 nextResponse ([ $responseIndex ])
|
||||
|
||||
Returns the index of the next item that should be shown to the user,
|
||||
Mutator. The index of the next item that should be shown to the user,
|
||||
that is, the index of the next item in the L<"surveyOrder"> array,
|
||||
e.g. L<"lastResponse"> + 1.
|
||||
|
||||
=head3 $responseIndex (optional)
|
||||
|
||||
If defined, nextResponse is set to $responseIndex.
|
||||
|
||||
=cut
|
||||
|
||||
sub nextResponse {
|
||||
my $self = shift;
|
||||
return $self->lastResponse + 1;
|
||||
my ($responseIndex) = validate_pos(@_, {type => SCALAR, optional => 1});
|
||||
|
||||
if ( defined $responseIndex ) {
|
||||
$self->lastResponse($responseIndex - 1);
|
||||
}
|
||||
|
||||
return $self->lastResponse() + 1
|
||||
}
|
||||
|
||||
#-------------------------------------------------------------------
|
||||
|
|
|
|||
|
|
@ -414,6 +414,7 @@ Adds two variables:
|
|||
=item * id
|
||||
|
||||
the index of the question's position in its parent's section array joined by dashes '-'
|
||||
See L<WebGUI::Asset::Wobject::Survey::ResponseJSON/questionIndex>.
|
||||
|
||||
=item * displayed_id
|
||||
|
||||
|
|
@ -491,6 +492,7 @@ Adds two variables:
|
|||
=item * id
|
||||
|
||||
The index of the answer's position in its parent's question and section arrays joined by dashes '-'
|
||||
See L<WebGUI::Asset::Wobject::Survey::ResponseJSON/answerIndex>.
|
||||
|
||||
=item * displayed_id
|
||||
|
||||
|
|
|
|||
|
|
@ -18,7 +18,7 @@ my $session = WebGUI::Test->session;
|
|||
|
||||
#----------------------------------------------------------------------------
|
||||
# Tests
|
||||
my $tests = 1;
|
||||
my $tests = 10;
|
||||
plan tests => $tests + 1;
|
||||
|
||||
#----------------------------------------------------------------------------
|
||||
|
|
@ -37,6 +37,61 @@ $import_node = WebGUI::Asset->getImportNode($session);
|
|||
$survey = $import_node->addChild( { className => 'WebGUI::Asset::Wobject::Survey', } );
|
||||
isa_ok($survey, 'WebGUI::Asset::Wobject::Survey');
|
||||
|
||||
# Load bare-bones survey, containing a single section (S0)
|
||||
$survey->loadSurveyJSON();
|
||||
$survey->survey->update([0], { variable => 'S0' });
|
||||
|
||||
# Add 2 questions to S0
|
||||
$survey->survey->newObject([0]); # S0Q0
|
||||
$survey->survey->update([0,0], { variable => 'S0Q0' });
|
||||
$survey->survey->newObject([0]); # S0Q1
|
||||
$survey->survey->update([0,1], { variable => 'S0Q1' });
|
||||
|
||||
# Add a new section (S1)
|
||||
$survey->survey->newObject([]); # S1
|
||||
$survey->survey->update([1], { variable => 'S1' });
|
||||
|
||||
# Add 2 questions to S1
|
||||
$survey->survey->newObject([1]); # S1Q0
|
||||
$survey->survey->update([1,0], { variable => 'S1Q0' });
|
||||
$survey->survey->newObject([1]); # S1Q1
|
||||
$survey->survey->update([1,1], { variable => 'S1Q1' });
|
||||
|
||||
# Persist to db
|
||||
$survey->saveSurveyJSON();
|
||||
|
||||
# Now start a response as admin user
|
||||
$session->user( { userId =>3 } );
|
||||
$survey->getResponseId( { noCookie => 1 }); # triggers loadBothJSON()
|
||||
|
||||
#for my $address (@{ $survey->response->surveyOrder }) {
|
||||
# diag (Dumper $address);
|
||||
#}
|
||||
|
||||
# www_jumpTo
|
||||
{
|
||||
# Check a simple www_jumpTo request
|
||||
WebGUI::Test->getPage( $survey, 'www_jumpTo', { formParams => {id => '0'} } );
|
||||
is( $session->http->getStatus, '201', 'Page request ok' ); # why is "201 - created" status used??
|
||||
is($survey->response->nextResponse, 0, 'S0 is the first response');
|
||||
|
||||
tie my %expectedSurveyOrder, 'Tie::IxHash';
|
||||
%expectedSurveyOrder = (
|
||||
'undefined' => 0,
|
||||
'0' => 0,
|
||||
'0-0' => 0,
|
||||
'0-1' => 1,
|
||||
'1' => 2,
|
||||
'1-0' => 2,
|
||||
'1-1' => 3,
|
||||
);
|
||||
while (my ($id, $index) = each %expectedSurveyOrder) {
|
||||
WebGUI::Test->getPage( $survey, 'www_jumpTo', { formParams => {id => $id} } );
|
||||
$survey->loadSurveyJSON();
|
||||
is($survey->response->nextResponse, $index, "jumpTo($id) sets nextResponse to $index");
|
||||
}
|
||||
}
|
||||
|
||||
}
|
||||
|
||||
#----------------------------------------------------------------------------
|
||||
|
|
|
|||
|
|
@ -21,7 +21,7 @@ my $session = WebGUI::Test->session;
|
|||
|
||||
#----------------------------------------------------------------------------
|
||||
# Tests
|
||||
my $tests = 79;
|
||||
my $tests = 78;
|
||||
plan tests => $tests + 1;
|
||||
|
||||
#----------------------------------------------------------------------------
|
||||
|
|
@ -48,7 +48,6 @@ is($responseJSON->lastResponse(), -1, 'new: default lastResponse is -1');
|
|||
is($responseJSON->questionsAnswered, 0, 'new: questionsAnswered is 0 by default');
|
||||
cmp_ok((abs$responseJSON->startTime - $newTime), '<=', 2, 'new: by default startTime set to time');
|
||||
is_deeply( $responseJSON->responses, {}, 'new: by default, responses is an empty hashref');
|
||||
is_deeply( $responseJSON->surveyOrder, [], 'new: by default, responses is an empty arrayref');
|
||||
|
||||
my $now = time();
|
||||
my $rJSON = WebGUI::Asset::Wobject::Survey::ResponseJSON->new(buildSurveyJSON($session), qq!{ "startTime": $now }!);
|
||||
|
|
@ -82,13 +81,13 @@ ok( ! $rJSON->hasTimedOut(4*60), 'hasTimedOut, limit check');
|
|||
|
||||
####################################################
|
||||
#
|
||||
# createSurveyOrder
|
||||
# initSurveyOrder
|
||||
#
|
||||
####################################################
|
||||
|
||||
$rJSON = WebGUI::Asset::Wobject::Survey::ResponseJSON->new(buildSurveyJSON($session), q!{}!);
|
||||
|
||||
$rJSON->createSurveyOrder();
|
||||
#$rJSON->initSurveyOrder();
|
||||
cmp_deeply(
|
||||
$rJSON->surveyOrder,
|
||||
[
|
||||
|
|
@ -102,7 +101,7 @@ cmp_deeply(
|
|||
[ 3, 1, [0, 1, 2, 3, 4, 5, 6] ],
|
||||
[ 3, 2, [0] ],
|
||||
],
|
||||
'createSurveyOrder, enumerated all sections, questions and answers'
|
||||
'initSurveyOrder, enumerated all sections, questions and answers'
|
||||
);
|
||||
|
||||
####################################################
|
||||
|
|
@ -119,7 +118,7 @@ cmp_deeply(
|
|||
|
||||
####################################################
|
||||
#
|
||||
# createSurveyOrder, part 2
|
||||
# initSurveyOrder, part 2
|
||||
#
|
||||
####################################################
|
||||
|
||||
|
|
@ -127,27 +126,27 @@ cmp_deeply(
|
|||
my $rJSON = WebGUI::Asset::Wobject::Survey::ResponseJSON->new(buildSurveyJSON($session), q!{}!);
|
||||
|
||||
$rJSON->survey->section([0])->{randomizeQuestions} = 0;
|
||||
$rJSON->createSurveyOrder();
|
||||
$rJSON->initSurveyOrder();
|
||||
my @question_order = map {$_->[1]} grep {$_->[0] == 0} @{$rJSON->surveyOrder};
|
||||
cmp_deeply(\@question_order, [0,1,2], 'createSurveyOrder did not shuffle questions');
|
||||
cmp_deeply(\@question_order, [0,1,2], 'initSurveyOrder did not shuffle questions');
|
||||
|
||||
$rJSON->survey->section([0])->{randomizeQuestions} = 1;
|
||||
srand(42); # Make shuffle predictable
|
||||
$rJSON->createSurveyOrder();
|
||||
$rJSON->initSurveyOrder();
|
||||
@question_order = map {$_->[1]} grep {$_->[0] == 0} @{$rJSON->surveyOrder};
|
||||
cmp_deeply(\@question_order, [2,0,1], 'createSurveyOrder shuffled questions in first section');
|
||||
cmp_deeply(\@question_order, [2,0,1], 'initSurveyOrder shuffled questions in first section');
|
||||
|
||||
$rJSON->survey->section([0])->{randomizeQuestions} = 0;
|
||||
$rJSON->survey->question([0,0])->{randomizeAnswers} = 0;
|
||||
$rJSON->createSurveyOrder();
|
||||
$rJSON->initSurveyOrder();
|
||||
my @answer_order = map {@{$_->[2]}} grep {$_->[0] == 3 && $_->[1] == 1} @{$rJSON->surveyOrder};
|
||||
cmp_deeply(\@answer_order, [0,1,2,3,4,5,6], 'createSurveyOrder did not shuffle answers');
|
||||
cmp_deeply(\@answer_order, [0,1,2,3,4,5,6], 'initSurveyOrder did not shuffle answers');
|
||||
|
||||
$rJSON->survey->question([3,1])->{randomizeAnswers} = 1;
|
||||
srand(42); # Make shuffle predictable
|
||||
$rJSON->createSurveyOrder();
|
||||
$rJSON->initSurveyOrder();
|
||||
@answer_order = map {@{$_->[2]}} grep {$_->[0] == 3 && $_->[1] == 1} @{$rJSON->surveyOrder};
|
||||
cmp_deeply(\@answer_order, [1,3,4,5,6,0,2], 'createSurveyOrder shuffled answers');
|
||||
cmp_deeply(\@answer_order, [1,3,4,5,6,0,2], 'initSurveyOrder shuffled answers');
|
||||
}
|
||||
|
||||
####################################################
|
||||
|
|
|
|||
Loading…
Add table
Add a link
Reference in a new issue