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

Tests for createSurveyOrder and shuffle.

Browse source 
POD for several methods.
This commit is contained in:
Colin Kuskie 2008-12-12 00:03:16 +00:00
parent 1c1f01d473
commit c60393e44a
2 changed files with 114 additions and 3 deletions
Download patch file Download diff file Expand all files Collapse all files

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

@ -121,6 +121,12 @@ sub createSurveyOrder {
$self->{surveyOrder} = $order;
} ## end sub createSurveyOrder
=head2 shuffle ( @array )
Returns the contents of @array in a random order.
=cut
sub shuffle {
my @a = splice @_;
for my $i ( 0 .. $#a ) {
@ -130,6 +136,12 @@ sub shuffle {
return @a;
}
=head2 freeze
Serializes the object to JSON, after deleting the log and survey objects stored in it.
=cut
sub freeze {
my $self = shift;
my %temp = %{$self};
@ -440,16 +452,42 @@ sub returnResponseForReporting {
#the actual responses to the survey. A response is for a question and is accessed by the exact same address as a survey member.
#Questions only contain the comment and an array of answer Responses.
#Answers only contain, entered text, entered verbatim, their index in the Survey Question Answer array, and the assetId to the uploaded file.
=head2 responses
Returns a reference to the actual responses to the survey. A response is for a question and
is accessed by the exact same address as a survey member. Questions only contain the comment
and an array of answer Responses. Answers only contain, entered text, entered verbatim,
their index in the Survey Question Answer array, and the assetId to the uploaded file.
Note, this is an unsafe reference.
=cut
sub responses {
my $self = shift;
return $self->{responses};
}
=head2 responses
Returns a referece to the SurveyJSON object that this object was created with.
Note, this is an unsafe reference.
=cut
sub survey {
my $self = shift;
return $self->{survey};
}
=head2 log
Logs an error to the webgui log file, using the session logger.
=cut
sub log {
my ( $self, $message ) = @_;
if ( defined $self->{log} ) {

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

@ -8,6 +8,7 @@ use FindBin;
use lib "$FindBin::Bin/../../../lib";
use Test::More;
use Test::Deep;
use Test::MockObject::Extends;
use Data::Dumper;
use WebGUI::Test; # Must use this before any other WebGUI modules
use WebGUI::Session;
@ -19,7 +20,7 @@ my $session = WebGUI::Test->session;
#----------------------------------------------------------------------------
# Tests
my $tests = 13;
my $tests = 18;
plan tests => $tests + 1;
#----------------------------------------------------------------------------
@ -78,6 +79,79 @@ ok( $rJSON->hasTimedOut(1), 'hasTimedOut, timed out');
ok( ! $rJSON->hasTimedOut(0), 'hasTimedOut, bad limit');
ok( ! $rJSON->hasTimedOut(4*60), 'hasTimedOut, limit check');
####################################################
#
# createSurveyOrder
#
####################################################
$rJSON = WebGUI::Asset::Wobject::Survey::ResponseJSON->new(q!{}!, $session->log, buildSurveyJSON($session));
$rJSON->createSurveyOrder();
cmp_deeply(
$rJSON->surveyOrder,
[
[ 0, 0, [0] ],
[ 0, 1, [0] ],
[ 0, 2, [0, 1] ],
[ 1, 0, [0, 1] ],
[ 1, 1, [0, 1] ],
[ 2 ],
[ 3, 0, [0, 1] ],
[ 3, 1, [0, 1, 2, 3, 4, 5, 6] ],
[ 3, 2, [0] ],
],
'createSurveyOrder, enumerated all sections, questions and answers'
);
####################################################
#
# shuffle
#
####################################################
{
my @dataToRandomize = 0..49;
my @randomizedData = WebGUI::Asset::Wobject::Survey::ResponseJSON::shuffle(@dataToRandomize);
cmp_bag(\@dataToRandomize, \@randomizedData, 'shuffle: No data lost during shuffling');
}
####################################################
#
# createSurveyOrder, part 2
#
####################################################
{
no strict "refs";
no warnings;
my $rJSON = WebGUI::Asset::Wobject::Survey::ResponseJSON->new(q!{}!, $session->log, buildSurveyJSON($session));
$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} = 1;
$rJSON->createSurveyOrder();
is($shuffleCalled, 1, 'createSurveyOrder called shuffle on a section');
$shuffleCalled = 0;
$rJSON->survey->section([0])->{randomizeQuestions} = 0;
$rJSON->survey->question([0,0])->{randomizeAnswers} = 1;
$rJSON->createSurveyOrder();
is($shuffleCalled, 1, 'createSurveyOrder called shuffle on a question');
##Restore the subroutine to the original
*$shuffleName = &$shuffleRef;
}
}
####################################################
@ -89,8 +163,7 @@ ok( ! $rJSON->hasTimedOut(4*60), 'hasTimedOut, limit check');
sub buildSurveyJSON {
my $session = shift;
my $sjson = WebGUI::Asset::Wobject::Survey::SurveyJSON->new(undef, $session->log);
##Build 4 sections
$sjson->newObject([]);
##Build 4 sections. Remembering that one is created by default when you make an empty SurveyJSON object
$sjson->newObject([]);
$sjson->newObject([]);
$sjson->newObject([]);