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

Replaced ResponseJSON's implementation of shuffle with List::Util's

Browse source 
shuffle and updated Colin's ninja shuffle tests
This commit is contained in:
Patrick Donelan 2009-02-04 02:05:44 +00:00
parent 477f014177
commit 669e986189
2 changed files with 21 additions and 40 deletions
Download patch file Download diff file Expand all files Collapse all files

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

@ -30,6 +30,7 @@ This package is not intended to be used by any other Asset in WebGUI.
use strict; use strict;
use JSON; use JSON;
use Params::Validate qw(:all); use Params::Validate qw(:all);
use List::Util qw(shuffle);
Params::Validate::validation_options( on_fail => sub { WebGUI::Error::InvalidParam->throw( error => shift ) } ); Params::Validate::validation_options( on_fail => sub { WebGUI::Error::InvalidParam->throw( error => shift ) } );
#------------------------------------------------------------------- #-------------------------------------------------------------------
@ -101,7 +102,7 @@ sub createSurveyOrder {
# Randomize Questions if required.. # Randomize Questions if required..
my @qOrder; my @qOrder;
if ( $self->survey->section( [$sIndex] )->{randomizeQuestions} ) { if ( $self->survey->section( [$sIndex] )->{randomizeQuestions} ) {
@qOrder = shuffle( 0 .. $self->survey->lastQuestionIndex( [$sIndex] ) ); @qOrder = shuffle 0 .. $self->survey->lastQuestionIndex( [$sIndex] );
} }
else { else {
@qOrder = ( 0 .. $self->survey->lastQuestionIndex( [$sIndex] ) ); @qOrder = ( 0 .. $self->survey->lastQuestionIndex( [$sIndex] ) );
@ -113,7 +114,7 @@ sub createSurveyOrder {
# Randomize Answers if required.. # Randomize Answers if required..
my @aOrder; my @aOrder;
if ( $self->survey->question( [ $sIndex, $q ] )->{randomizeAnswers} ) { if ( $self->survey->question( [ $sIndex, $q ] )->{randomizeAnswers} ) {
@aOrder = shuffle( 0 .. $self->survey->lastAnswerIndex( [ $sIndex, $q ] ) ); @aOrder = shuffle 0 .. $self->survey->lastAnswerIndex( [ $sIndex, $q ] );
} }
else { else {
@aOrder = ( 0 .. $self->survey->lastAnswerIndex( [ $sIndex, $q ] ) ); @aOrder = ( 0 .. $self->survey->lastAnswerIndex( [ $sIndex, $q ] ) );
@ -146,23 +147,6 @@ sub session {
#------------------------------------------------------------------- #-------------------------------------------------------------------
=head2 shuffle ( @array )
Returns the contents of @array in a random order.
=cut
sub shuffle {
my @a = splice @_;
for my $i ( 0 .. $#a ) {
my $j = int rand @a;
@a[ $i, $j ] = @a[ $j, $i ];
}
return @a;
}
#-------------------------------------------------------------------
=head2 freeze =head2 freeze
Serializes the object to JSON, after deleting the log and survey objects stored in it. Serializes the object to JSON, after deleting the log and survey objects stored in it.

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

@ -20,7 +20,7 @@ my $session = WebGUI::Test->session;
#---------------------------------------------------------------------------- #----------------------------------------------------------------------------
# Tests # Tests
my $tests = 77; my $tests = 78;
plan tests => $tests + 1; plan tests => $tests + 1;
#---------------------------------------------------------------------------- #----------------------------------------------------------------------------
@ -123,33 +123,30 @@ cmp_deeply(
#################################################### ####################################################
{ {
no strict "refs";
no warnings;
my $rJSON = WebGUI::Asset::Wobject::Survey::ResponseJSON->new(buildSurveyJSON($session), q!{}!); my $rJSON = WebGUI::Asset::Wobject::Survey::ResponseJSON->new(buildSurveyJSON($session), q!{}!);
$rJSON->survey->section([0])->{randomizeQuestions} = 0;
my $shuffleName = "WebGUI::Asset::Wobject::Survey::ResponseJSON::shuffle";
my $shuffleCalled = 0;
my $shuffleRef = \&$shuffleName;
*$shuffleName = sub {
$shuffleCalled = 1;
goto &$shuffleRef;
};
$rJSON->createSurveyOrder();
is($shuffleCalled, 0, 'createSurveyOrder did not call shuffle on a section');
$shuffleCalled = 0; $rJSON->survey->section([0])->{randomizeQuestions} = 0;
$rJSON->createSurveyOrder();
my @question_order = map {$_->[1]} grep {$_->[0] == 0} @{$rJSON->surveyOrder};
cmp_deeply(\@question_order, [0,1,2], 'createSurveyOrder did not shuffle questions');
$rJSON->survey->section([0])->{randomizeQuestions} = 1; $rJSON->survey->section([0])->{randomizeQuestions} = 1;
srand(42); # Make shuffle predictable
$rJSON->createSurveyOrder(); $rJSON->createSurveyOrder();
is($shuffleCalled, 1, 'createSurveyOrder called shuffle on a section'); @question_order = map {$_->[1]} grep {$_->[0] == 0} @{$rJSON->surveyOrder};
cmp_deeply(\@question_order, [2,0,1], 'createSurveyOrder shuffled questions in first section');
$shuffleCalled = 0;
$rJSON->survey->section([0])->{randomizeQuestions} = 0; $rJSON->survey->section([0])->{randomizeQuestions} = 0;
$rJSON->survey->question([0,0])->{randomizeAnswers} = 1; $rJSON->survey->question([0,0])->{randomizeAnswers} = 0;
$rJSON->createSurveyOrder(); $rJSON->createSurveyOrder();
is($shuffleCalled, 1, 'createSurveyOrder called shuffle on a question'); 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');
##Restore the subroutine to the original
*$shuffleName = &$shuffleRef; $rJSON->survey->question([3,1])->{randomizeAnswers} = 1;
srand(42); # Make shuffle predictable
$rJSON->createSurveyOrder();
@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');
} }
#################################################### ####################################################