Test abusing references in getObject.

More insertObject testing.
More POD.

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,

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