Update POD for several methods.

Make getObject clone data for safety and update tests.
Make newObject always alter $address for consistency and update tests.

lib/WebGUI/Asset/Wobject/Survey/SurveyJSON.pm

@@ -29,6 +29,7 @@ Asset in WebGUI.
 
 use strict;
 use JSON;
+use Clone qw/clone/;
 
 =head2 new ( $json, $log )
 
@@ -87,7 +88,7 @@ modified to show what was added.
 An array ref.  The number of elements array set what is added, and
 where.
 
-This method modifies $address if it has 1 or more elements.
+This method modifies $address.  It also returns $address.
 
 =over 4
 
@@ -116,18 +117,17 @@ sub newObject {
     my $address = shift;
     if ( @$address == 0 ) {
         push( @{ $self->sections }, $self->newSection() );
-        return [ $#{ $self->sections } ];
+        $address->[0] = $#{ $self->sections };
     }
     elsif ( @$address == 1 ) {
         push( @{ $self->questions($address) }, $self->newQuestion($address) );
         $$address[1] = $#{ $self->questions($address) };
-        return $address;
     }
     elsif ( @$address == 2 ) {
         push( @{ $self->answers($address) }, $self->newAnswer($address) );
         $$address[2] = $#{ $self->answers($address) };
-        return $address;
     }
+    return $address;
 } ## end sub newObject
 
 #address is the array of objects currently selected in the edit screen
@@ -201,13 +201,13 @@ question in a section.  Returns that answer.
 sub getObject {
     my ( $self, $address ) = @_;
     if ( @$address == 1 ) {
-        return $self->{sections}->[ $address->[0] ];
+        return clone $self->{sections}->[ $address->[0] ];
     }
     elsif ( @$address == 2 ) {
-        return $self->{sections}->[ $address->[0] ]->{questions}->[ $address->[1] ];
+        return clone $self->{sections}->[ $address->[0] ]->{questions}->[ $address->[1] ];
     }
     else {
-        return $self->{sections}->[ $address->[0] ]->{questions}->[ $address->[1] ]->{answers}->[ $address->[2] ];
+        return clone $self->{sections}->[ $address->[0] ]->{questions}->[ $address->[1] ]->{answers}->[ $address->[2] ];
     }
 }
 
@@ -330,8 +330,7 @@ question in a section.
 
 A perl data structure.  Note, that it is not checked for type, so it is
 possible to add a "question" object into the list of section objects.
-Only the properties defined in $object will be defined in the data
-structure, so it is not a replacement.
+$object should never be a partial object, but contain all properties.
 
 =back
 
@@ -378,7 +377,7 @@ sub update {
 
 =head2 insertObject ( $object, $address )
 
-Add new "objects" into the current data structure.  It does not
+Used to move existing objects in the current data structure.  It does not
 return anything significant.
 
 =head3 $object
@@ -424,13 +423,13 @@ question in a section.  $object is spliced in right after that answer.
 sub insertObject {
     my ( $self, $object, $address ) = @_;
     if ( @$address == 1 ) {
-        splice( @{ $self->sections($address) }, $$address[0] + 1, 0, $object );  ##always a default section
+        splice( @{ $self->sections($address) }, $$address[0] + 1, 0, $object );
     }
     elsif ( @$address == 2 ) {
-        splice( @{ $self->questions($address) }, $$address[1] + 1, 0, $object ); ##warning, beyond end of array
+        splice( @{ $self->questions($address) }, $$address[1] + 1, 0, $object );
     }
     elsif ( @$address == 3 ) {
-        splice( @{ $self->answers($address) }, $$address[2] + 1, 0, $object );   ##warning, beyond end of array
+        splice( @{ $self->answers($address) }, $$address[2] + 1, 0, $object );
     }
 
 }
@@ -438,7 +437,7 @@ sub insertObject {
 =head2 copy ( $address )
 
 Duplicate the structure pointed to by $address, and add it to the end of the list of
-similar structures
+similar structures.
 
 =head3 $address
 

t/Asset/Sku/ProductCollateral.t

@@ -291,10 +291,23 @@ is( $product5->getCollateral('variantsJSON', 'vid', $newVid)->{check}, 'no leaks
 
 $product5->purge;
 
+my $product6 = $root->addChild({
+        className => "WebGUI::Asset::Sku::Product",
+        title     => "Wide character attempt",
+});
+
+$newVid = $product6->setCollateral('variantsJSON', 'vid', 'new', { wideChar => q!“I hope this has a smart quote in it.”!
+, vid => 'new' });
+
+use Data::Dumper;
+diag Dumper $product6->getCollateral('variantsJSON', 'vid', $newVid);
+
 #----------------------------------------------------------------------------
 # Cleanup
 END {
 
+    WebGUI::VersionTag->getWorking($session)->rollback;
+
 }
 
 1;

t/Asset/Wobject/Survey/SurveyJSON.t

@@ -210,7 +210,7 @@ like( $surveyJSON->freeze, qr/"survey":\{\}/, 'freeze: got back something that l
 
 my $stompedAddress = [];
 is_deeply($surveyJSON->newObject($stompedAddress), [1], 'newObject returns the new data structure index');
-is_deeply($stompedAddress, [], 'newObject does not stomp on the address argument if it is empty');
+is_deeply($stompedAddress, [1], 'newObject stomps on $address');
 
 cmp_deeply(
     $surveyJSON->sections,
@@ -421,9 +421,6 @@ cmp_deeply(
 ####################################################
 
 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.
 
 cmp_deeply(
     $section1,
@@ -434,6 +431,7 @@ cmp_deeply(
     'getObject: Retrieved correct section'
 );
 
+##Try a reference stomp
 $section1->{title} = 'Section 2';
 cmp_deeply(
     summarizeSectionSkeleton($surveyJSON),
@@ -475,25 +473,19 @@ cmp_deeply(
             ],
         },
         {
-            title     => 'Section 2',
+            title     => 'Section 1',
             questions => [],
         },
     ],
-    'getObject: Returns live, dangerous references'
+    'getObject: Returns safe, cloned references'
 );
 
-my $question1 = $surveyJSON->getObject([1, 0]);
-
-cmp_deeply(
-    $question1,
-    superhashof({
-        type => 'question',
-        text => 'Question 0+-0',
-    }),
-    'getObject: Retrieved correct question'
-);
-
-$surveyJSON->update([1], { title => 'Section 1'} );
+##Propertly update a section
+{
+    my $section = $surveyJSON->getObject([1]);
+    $section->{title} = 'Section 1';
+    $surveyJSON->update([1], $section );
+}
 cmp_deeply(
     summarizeSectionSkeleton($surveyJSON),
     [
@@ -534,14 +526,26 @@ cmp_deeply(
             ],
         },
         {
-            title     => 'Section 2',
+            title     => 'Section 1',
             questions => [],
         },
     ],
     'Update: updated a section'
 );
 
-$surveyJSON->update([1, 0], { text  => 'Question 1-0'} );
+my $question1 = $surveyJSON->getObject([1, 0]);
+
+cmp_deeply(
+    $question1,
+    superhashof({
+        type => 'question',
+        text => 'Question 0+-0',
+    }),
+    'getObject: Retrieved correct question'
+);
+
+$question1->{text} = 'Question 1-0';
+$surveyJSON->update([1, 0], $question1 );
 
 cmp_deeply(
     $surveyJSON->getObject([1, 0]),
@@ -549,9 +553,6 @@ cmp_deeply(
         type => 'question',
         text => 'Question 1-0',
         answers => [
-            superhashof ({
-                text    => '',
-            }),
         ],
     }),
     'update: updating a question adds a new, default answer?'
@@ -566,7 +567,7 @@ cmp_deeply(
         answers => [
         ],
     }),
-    'remove: removed that extra, default answer'
+    'remove: No problems with removing nonexistant data'
 );