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 JSON;
use Params::Validate qw(:all);
use List::Util qw(shuffle);
Params::Validate::validation_options( on_fail => sub { WebGUI::Error::InvalidParam->throw( error => shift ) } );
#-------------------------------------------------------------------
@ -101,7 +102,7 @@ sub createSurveyOrder {
# Randomize Questions if required..
my @qOrder;
if ( $self->survey->section( [$sIndex] )->{randomizeQuestions} ) {
@qOrder = shuffle( 0 .. $self->survey->lastQuestionIndex( [$sIndex] ) );
@qOrder = shuffle 0 .. $self->survey->lastQuestionIndex( [$sIndex] );
}
else {
@qOrder = ( 0 .. $self->survey->lastQuestionIndex( [$sIndex] ) );
@ -113,7 +114,7 @@ sub createSurveyOrder {
# Randomize Answers if required..
my @aOrder;
if ( $self->survey->question( [ $sIndex, $q ] )->{randomizeAnswers} ) {
@aOrder = shuffle( 0 .. $self->survey->lastAnswerIndex( [ $sIndex, $q ] ) );
@aOrder = shuffle 0 .. $self->survey->lastAnswerIndex( [ $sIndex, $q ] );
}
else {
@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
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
my $tests = 77;
my $tests = 78;
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!{}!);
$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;
srand(42); # Make shuffle predictable
$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->question([0,0])->{randomizeAnswers} = 1;
$rJSON->survey->question([0,0])->{randomizeAnswers} = 0;
$rJSON->createSurveyOrder();
is($shuffleCalled, 1, 'createSurveyOrder called shuffle on a question');
##Restore the subroutine to the original
*$shuffleName = &$shuffleRef;
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');
$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');
}
####################################################