From 020c882fb61c6b5c8cbac7a80a13209c384b872c Mon Sep 17 00:00:00 2001 From: Colin Kuskie Date: Sat, 29 Nov 2008 17:29:00 +0000 Subject: [PATCH] Test abusing references in getObject. More insertObject testing. More POD. --- lib/WebGUI/Asset/Wobject/Survey/SurveyJSON.pm | 99 +++++++++++++ t/Asset/Wobject/Survey/SurveyJSON.t | 137 +++++++++++++++++- 2 files changed, 231 insertions(+), 5 deletions(-) diff --git a/lib/WebGUI/Asset/Wobject/Survey/SurveyJSON.pm b/lib/WebGUI/Asset/Wobject/Survey/SurveyJSON.pm index cf8e06aeb..68552be9e 100644 --- a/lib/WebGUI/Asset/Wobject/Survey/SurveyJSON.pm +++ b/lib/WebGUI/Asset/Wobject/Survey/SurveyJSON.pm @@ -163,6 +163,41 @@ sub getDragDropList { return \@data; } ## end sub getDragDropList +=head2 getObject ( $address ) + +Retrieve objects from the sections data structure by address. + +=head3 $address + +An array ref. The number of elements array set what is fetched. + +=over 4 + +=item empty + +If the array ref is empty, nothing is done. + +=item 1 element + +If there's just 1 element, returns the section with that index. + +=item 2 elements + +If there are 2 elements, then the first element is an index into +section array, and the second element is an index into the questions +in that section. Returns that question. + +=back + +=item 3 elements + +Three elements are enough to reference an answer, inside of a particular +question in a section. Returns that answer. + +=back + +=cut + sub getObject { my ( $self, $address ) = @_; if ( @$address == 1 ) { @@ -255,6 +290,52 @@ sub getAnswerEditVars { return \%var; } +=head2 update ( $address, $object ) + +Update new "objects" into the current data structure, or add new ones. It does not +return anything significant. + +=head3 $address + +An array ref. The number of elements array set what is updated. + +=over 4 + +=item empty + +If the array ref is empty, nothing is done. + +=item 1 element + +If there's just 1 element, then that element is used as an index into +the array of sections, and information from $object is used to replace +the properties of that section. If the select section does not exist, such +as by using an out of bounds array index, then a new section is appended +to the list of sections. + +=item 2 elements + +If there are 2 elements, then the first element is an index into +section array, and the second element is an index into the questions +in that section. + +=back + +=item 3 elements + +Three elements are enough to reference an answer, inside of a particular +question in a section. $object is spliced in right after that answer. + +=head3 $object + +A perl data structure. Note, that it is not checked for homegeneity, +so it is possible to add a "question" object into the list of section +objects. + +=back + +=cut + sub update { my ( $self, $address, $ref ) = @_; my $object; @@ -415,6 +496,12 @@ sub remove { } } +=head2 newSection + +Returns a reference to a new, empty section. + +=cut + sub newSection { my %members = ( 'text', '', @@ -430,6 +517,12 @@ sub newSection { return \%members; } +=head2 newQuestion + +Returns a reference to a new, empty question. + +=cut + sub newQuestion { my %members = ( 'text', '', @@ -454,6 +547,12 @@ sub newQuestion { return \%members; } ## end sub newQuestion +=head2 newAnswer + +Returns a reference to a new, empty answer. + +=cut + sub newAnswer { my %members = ( 'text', '', 'verbatim', 0, 'textCols', 10, 'textRows', 5, 'goto', '', 'recordedAnswer', '', 'isCorrect', 1, diff --git a/t/Asset/Wobject/Survey/SurveyJSON.t b/t/Asset/Wobject/Survey/SurveyJSON.t index ca9ad0254..2540a0400 100644 --- a/t/Asset/Wobject/Survey/SurveyJSON.t +++ b/t/Asset/Wobject/Survey/SurveyJSON.t @@ -20,7 +20,7 @@ my $session = WebGUI::Test->session; #---------------------------------------------------------------------------- # Tests -my $tests = 26; +my $tests = 28; plan tests => $tests + 1 + 3; #---------------------------------------------------------------------------- @@ -271,7 +271,7 @@ cmp_deeply( questions => [], }, ], - 'section: Set the title for the default section' + 'insertObject: Set the title for the default section' ); { @@ -291,7 +291,7 @@ cmp_deeply( questions => [], }, ], - 'section: Insert a new section after the default section' + 'insertObject: Insert a new section after the default section' ); { @@ -315,7 +315,7 @@ cmp_deeply( questions => [], }, ], - 'section: Insert another new section after the default section' + 'insertObject: Insert another new section after the default section' ); { @@ -344,9 +344,136 @@ cmp_deeply( questions => [], }, ], - 'section: Insert a question into the first section' + 'insertObject: Insert a question into the first section' ); +{ + my $question = $surveyJSON->newQuestion; + $question->{text} = 'Question 0-1'; + $surveyJSON->insertObject($question, [0,0]); + my $question1 = $surveyJSON->newQuestion; + $question1->{text} = 'Question 0-2'; + $surveyJSON->insertObject($question1, [0,1]); + my $question2 = $surveyJSON->newQuestion; + $question2->{text} = 'Question 0+-0'; + $surveyJSON->insertObject($question2, [1,0]); + my $answer1 = $surveyJSON->newAnswer; + $answer1->{text} = 'Answer 0-1-0'; + $surveyJSON->insertObject($answer1, [0,1,0]); + my $answer2 = $surveyJSON->newAnswer; + $answer2->{text} = 'Answer 0-1-1'; + $surveyJSON->insertObject($answer2, [0,1,0]); + my $answer3 = $surveyJSON->newAnswer; + $answer3->{text} = 'Answer 0-1-2'; + $surveyJSON->insertObject($answer3, [0,1,1]); +} +cmp_deeply( + summarizeSectionSkeleton($surveyJSON), + [ + { + title => 'Section 0', + questions => [ + { + text => 'Question 0-0', + answers => [], + }, + { + text => 'Question 0-1', + answers => [ + { + text => 'Answer 0-1-0', + }, + { + text => 'Answer 0-1-1', + }, + { + text => 'Answer 0-1-2', + }, + ], + }, + { + text => 'Question 0-2', + answers => [], + }, + ], + }, + { + title => 'Section 0+', + questions => [ + { + text => 'Question 0+-0', + answers => [], + }, + ], + }, + { + title => 'Section 1', + questions => [], + }, + ], + 'insertObject: Adding questions and answers' +); + +#################################################### +# +# getObject, update +# +#################################################### + +my $section1 = $surveyJSON->getObject([2]); +##Now, there was a little naming problem created when inserting +##sections out of order. Let's fix it and show the danger of +##using references. + +$section1->{title} = 'Section 2'; +cmp_deeply( + summarizeSectionSkeleton($surveyJSON), + [ + { + title => 'Section 0', + questions => [ + { + text => 'Question 0-0', + answers => [], + }, + { + text => 'Question 0-1', + answers => [ + { + text => 'Answer 0-1-0', + }, + { + text => 'Answer 0-1-1', + }, + { + text => 'Answer 0-1-2', + }, + ], + }, + { + text => 'Question 0-2', + answers => [], + }, + ], + }, + { + title => 'Section 0+', + questions => [ + { + text => 'Question 0+-0', + answers => [], + }, + ], + }, + { + title => 'Section 2', + questions => [], + }, + ], + 'getObject: Returns live, dangerous references' +); + + #################################################### # # TODO