From 23f8e48f6d8db632e2e5f6fa33a4f612a5276b43 Mon Sep 17 00:00:00 2001 From: Colin Kuskie Date: Mon, 1 Dec 2008 17:39:34 +0000 Subject: [PATCH] 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 | 27 +++++----- t/Asset/Sku/ProductCollateral.t | 13 +++++ t/Asset/Wobject/Survey/SurveyJSON.t | 49 ++++++++++--------- 3 files changed, 51 insertions(+), 38 deletions(-) diff --git a/lib/WebGUI/Asset/Wobject/Survey/SurveyJSON.pm b/lib/WebGUI/Asset/Wobject/Survey/SurveyJSON.pm index fff767bd3..4d7cceb5c 100644 --- a/lib/WebGUI/Asset/Wobject/Survey/SurveyJSON.pm +++ b/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 diff --git a/t/Asset/Sku/ProductCollateral.t b/t/Asset/Sku/ProductCollateral.t index d9bc039e7..3ffcba690 100644 --- a/t/Asset/Sku/ProductCollateral.t +++ b/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; diff --git a/t/Asset/Wobject/Survey/SurveyJSON.t b/t/Asset/Wobject/Survey/SurveyJSON.t index eb24d484d..3f50d24ba 100644 --- a/t/Asset/Wobject/Survey/SurveyJSON.t +++ b/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' );