Switch to using dclone from Clone::clone due to bugs under

perl 5.10
This commit is contained in:
Colin Kuskie 2008-12-05 04:21:43 +00:00
parent ace2c81fca
commit 8ea45fe456
2 changed files with 13 additions and 11 deletions

View file

@ -29,7 +29,8 @@ Asset in WebGUI.
use strict;
use JSON;
use Clone qw/clone/;
#use Clone qw/clone/;
use Storable qw/dclone/;
=head2 new ( $json, $log )
@ -238,13 +239,13 @@ question in a section. Returns that answer.
sub getObject {
my ( $self, $address ) = @_;
if ( @$address == 1 ) {
return clone $self->{sections}->[ $address->[0] ];
return dclone $self->{sections}->[ $address->[0] ];
}
elsif ( @$address == 2 ) {
return clone $self->{sections}->[ $address->[0] ]->{questions}->[ $address->[1] ];
return dclone $self->{sections}->[ $address->[0] ]->{questions}->[ $address->[1] ];
}
else {
return clone $self->{sections}->[ $address->[0] ]->{questions}->[ $address->[1] ]->{answers}->[ $address->[2] ];
return dclone $self->{sections}->[ $address->[0] ]->{questions}->[ $address->[1] ]->{answers}->[ $address->[2] ];
}
}
@ -575,13 +576,13 @@ Nothing happens. It is not allowed to duplicate answers.
sub copy {
my ( $self, $address ) = @_;
if ( @$address == 1 ) {
my $newSection = clone $self->section($address);
my $newSection = dclone $self->section($address);
push( @{ $self->sections }, $newSection );
$address->[0] = $#{ $self->sections };
return $address;
}
elsif ( @$address == 2 ) {
my $newQuestion = clone $self->question($address);
my $newQuestion = dclone $self->question($address);
push( @{ $self->questions($address) }, $newQuestion );
$address->[1] = $#{ $self->questions($address) };
return $address;

View file

@ -13,7 +13,8 @@ use Data::Dumper;
use WebGUI::Test; # Must use this before any other WebGUI modules
use WebGUI::Session;
use JSON;
use Clone qw/clone/;
#use Clone qw/clone/;
use Storable qw/dclone/;
#----------------------------------------------------------------------------
# Init
@ -21,7 +22,7 @@ my $session = WebGUI::Test->session;
#----------------------------------------------------------------------------
# Tests
my $tests = 95;
my $tests = 96;
plan tests => $tests + 1 + 3;
#----------------------------------------------------------------------------
@ -2062,13 +2063,13 @@ sub buildSectionSkeleton {
my $sections = [];
my ($bareSection, $bareQuestion, $bareAnswer) = getBareSkeletons();
foreach my $questionSpec ( @{ $spec } ) {
my $section = clone $bareSection;
my $section = dclone $bareSection;
push @{ $sections }, $section;
foreach my $answers ( @{$questionSpec} ) {
my $question = clone $bareQuestion;
my $question = dclone $bareQuestion;
push @{ $section->{questions} }, $question;
while ($answers-- > 0) {
my $answer = clone $bareAnswer;
my $answer = dclone $bareAnswer;
push @{ $question->{answers} }, $answer;
}
}