Clone stopped working in several tests in 5.14.2. Remove it in favor of Storable::dclone.

Clone handles being passed scalar data, but dclone does not.

docs/gotcha.txt

@@ -7,6 +7,12 @@ upgrading from one version to the next, or even between multiple
 versions. Be sure to heed the warnings contained herein as they will
 save you many hours of grief.
 
+7.10.27
+--------------------------------------------------------------------
+    * Due to instability in the Clone module, WebGUI is now using Storable's
+      dclone instead.  Storable is a core Perl module, so you do not need
+      to install anything new.
+
 7.10.25
 --------------------------------------------------------------------
     * Custom WebGUI plugins written using WebGUI::Crud with hand built forms

lib/WebGUI/Asset.pm

@@ -16,7 +16,7 @@ package WebGUI::Asset;
 
 use Carp qw( croak confess );
 use Scalar::Util qw( blessed weaken );
-use Clone qw(clone);
+use Storable qw/dclone/;
 use JSON;
 use HTML::Packer;
 
@@ -2721,7 +2721,7 @@ to set the keywords for this asset.
 sub update {
 	my $self = shift;
 	my $requestedProperties = shift;
-    my $properties = clone($requestedProperties);
+    my $properties = dclone($requestedProperties);
 	$properties->{lastModified} = time();
 	
     # if keywords were specified, then let's set them the right way

lib/WebGUI/Asset/Template.pm

@@ -23,7 +23,7 @@ use WebGUI::Form;
 use WebGUI::Exception;
 use List::MoreUtils qw{ any };
 use Tie::IxHash;
-use Clone qw/clone/;
+use Storable qw/dclone/;
 use HTML::Packer;
 use JSON qw{ to_json from_json };
 use Try::Tiny;
@@ -914,8 +914,8 @@ on this being here.
 
 sub update {
     my $self = shift;
-    my $requestedProperties = shift;
+    my $requestedProperties = shift || {};
-    my $properties = clone($requestedProperties);
+    my $properties = dclone($requestedProperties);
 
     if (exists $properties->{headBlock}) {
         $properties->{extraHeadTags} .= $properties->{headBlock};

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

@@ -45,7 +45,7 @@ use strict;
 use JSON;
 use Params::Validate qw(:all);
 use List::Util qw(shuffle);
-use Clone qw/clone/;
+use Storable qw/dclone/;
 use Safe;
 use WebGUI::Asset::Wobject::Survey::ExpressionEngine;
 Params::Validate::validation_options( on_fail => sub { WebGUI::Error::InvalidParam->throw( error => shift ) } );
@@ -368,7 +368,12 @@ sub surveyOrderIndex {
     if ($variable) {
         return $self->response->{surveyOrderLookup}{$variable};
     } else {
-        return clone $self->response->{surveyOrderLookup};
+        if (ref $self->response->{surveyOrderLookup}) {
+            return dclone $self->response->{surveyOrderLookup};
+        }
+        else {
+            return {};
+        }
     }
 }
 
@@ -1465,7 +1470,10 @@ sub responseReport {
             my $answer = $self->survey->answer( [ $sIndex, $qIndex, $aIndex ] );
 
             # Massage each answer response and push it onto the list
-            if ( my $response = clone $self->responses->{$answerId} ) {
+            if ( my $response = $self->responses->{$answerId} ) {
+                if (ref $response) {
+                    $response = dclone $response;
+                }
                 $response->{isCorrect} = $answer->{isCorrect} ? 1 : 0;
                 $response->{id} = $aIndex;
                 $response->{score} = $answer->{value};    # N.B. answer score is consistently misnamed 'value'

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

@@ -50,7 +50,7 @@ use strict;
 use JSON;
 use Params::Validate qw(:all);
 Params::Validate::validation_options( on_fail => sub { WebGUI::Error::InvalidParam->throw( error => shift ) } );
-use Clone qw/clone/;
+use Storable qw/dclone/;
 use WebGUI::Asset::Wobject::Survey::ExpressionEngine;
 
 # The maximum value of questionsPerPage is currently hardcoded here
@@ -407,13 +407,13 @@ sub getObject {
     return if !$count;
 
     if ( $count == 1 ) {
-        return clone $self->sections->[ sIndex($address) ];
+        return dclone $self->sections->[ sIndex($address) ];
     }
     elsif ( $count == 2 ) {
-        return clone $self->sections->[ sIndex($address) ]->{questions}->[ qIndex($address) ];
+        return dclone $self->sections->[ sIndex($address) ]->{questions}->[ qIndex($address) ];
     }
     else {
-        return clone $self->sections->[ sIndex($address) ]->{questions}->[ qIndex($address) ]->{answers}
+        return dclone $self->sections->[ sIndex($address) ]->{questions}->[ qIndex($address) ]->{answers}
             ->[ aIndex($address) ];
     }
 }
@@ -950,21 +950,21 @@ sub copy {
 
     if ( $count == 1 ) {
         # Clone the indexed section onto the end of the list of sections..
-        push @{ $self->{_sections} }, clone $self->section($address);
+        push @{ $self->{_sections} }, dclone $self->section($address);
 
         # Update $address with the index of the newly created section
         $address->[0] = $self->lastSectionIndex;
     }
     elsif ( $count == 2 ) {
         # Clone the indexed question onto the end of the list of questions..
-        push @{ $self->section($address)->{questions} }, clone $self->question($address);
+        push @{ $self->section($address)->{questions} }, dclone $self->question($address);
 
         # Update $address with the index of the newly created question
         $address->[1] = $self->lastQuestionIndex($address);
     }
     elsif ( $count == 3 ) {
         # Clone the indexed answer onto the end of the list of answers..
-        push @{ $self->question($address)->{answers} }, clone $self->answer($address);
+        push @{ $self->question($address)->{answers} }, dclone $self->answer($address);
 
         # Update $address with the index of the newly created answer
         $address->[2]++;
@@ -1194,7 +1194,10 @@ sub getMultiChoiceBundle {
     my ($type) = validate_pos( @_, { type => SCALAR | UNDEF } );
 
     # Return a cloned copy of the bundle structure
-    return clone $self->{multipleChoiceTypes}->{$type};
+    if ($self->{multipleChoiceTypes}->{$type}) {
+        return dclone $self->{multipleChoiceTypes}->{$type};
+    }
+    return undef;
 }
 
 =head2 addAnswersToQuestion ($address, $answers)

lib/WebGUI/Asset/Wobject/WikiMaster.pm

@@ -24,7 +24,7 @@ use HTML::Parser;
 use URI::Escape;
 use WebGUI::Form;
 use WebGUI::Search;
-use Clone qw/clone/;
+use Storable qw/dclone/;
 
 #-------------------------------------------------------------------
 
@@ -618,7 +618,7 @@ sub getKeywordVariables {
     my $variables = [];
 
     KEYWORD: foreach my $member (@{ $hierarchy }) {
-        my $varBlock             = clone $member;
+        my $varBlock             = dclone $member;
         $varBlock->{level}       = $level;
         $varBlock->{isTopLevel}  = $level == 0;
         $varBlock->{indent_loop} = [ map { { indent => $_ } } 1..$level ];

lib/WebGUI/Cache/CHI.pm

@@ -3,7 +3,7 @@ package WebGUI::Cache::CHI;
 use strict;
 use base 'WebGUI::Cache';
 use File::Temp qw/tempdir/;
-use Clone qw/clone/;
+use Storable qw/dclone/;
 use CHI;
 
 =head1 NAME
@@ -93,7 +93,7 @@ sub new {
     # Create CHI object from config
     my $chi;
     unless ( $chi = $session->stow->get( "CHI" ) ) {
-        my $cacheConf    = clone $session->config->get('cache');
+        my $cacheConf    = dclone $session->config->get('cache');
         $cacheConf->{namespace}     = $namespace;
         $cacheConf->{is_size_aware} = 1;
 

lib/WebGUI/Crud.pm

@@ -20,7 +20,7 @@ use strict;
 use Class::InsideOut qw(readonly private id register);
 use JSON;
 use Tie::IxHash;
-use Clone qw/clone/;
+use Storable qw/dclone/;
 use WebGUI::DateTime;
 use WebGUI::Exception;
 use WebGUI::Utility;
@@ -579,11 +579,16 @@ sub get {
 
 	# return a specific property
 	if (defined $name) {
-		return clone $objectData{id $self}{$name};
+        if (ref $objectData{id $self}{$name}) {
+            return dclone $objectData{id $self}{$name};
+        }
+        else {
+            return $objectData{id $self}{$name};
+        }
 	}
 
 	# return a copy of all properties
-	return clone $objectData{id $self};
+	return dclone $objectData{id $self};
 }
 
 #-------------------------------------------------------------------

lib/WebGUI/Shop/PayDriver.pm

@@ -27,7 +27,7 @@ use WebGUI::Macro;
 use WebGUI::User;
 use WebGUI::Shop::Cart;
 use JSON;
-use Clone qw/clone/;
+use Storable qw/dclone/;
 use Scalar::Util qw/blessed/;
 
 =head1 NAME
@@ -708,7 +708,7 @@ sub update {
         $jsonOptions,
         $self->paymentGatewayId
     ]);
-    my $storedProperties = clone $properties;
+    my $storedProperties = dclone $properties;
     $options{ id $self } = $storedProperties;
 
     return;

sbin/testEnvironment.pl

@@ -133,7 +133,6 @@ checkModule("File::Path",                   "2.07"       );
 checkModule("Module::Find",                 "0.06"       );
 checkModule("Class::C3",                    "0.21"       );
 checkModule("Params::Validate",             "0.91"       );
-checkModule("Clone",                        "0.31"       );
 checkModule('JavaScript::Packer',           '1.002'      );
 checkModule('CSS::Packer',                  '1.000'      );
 checkModule('HTML::Packer',                 "1.000"      );
@@ -162,6 +161,7 @@ checkModule('Kwargs',                                    );
 checkModule('Data::ICal',                   '0.16'       );
 checkModule('common::sense',                '3.2'        );
 checkModule('Geo::Coder::Googlev3',         '0.07'       );
+checkModule('Storable',                     '2.00'       );
 
 failAndExit("Required modules are missing, running no more checks.") if $missingModule;
 

t/Asset/Wobject/Collaboration/templateVariables.t

@@ -89,7 +89,7 @@ ok( !$posts->[0]->{'user.isVisitor'}, 'first post made by visitor');
 ok(  $posts->[0]->{'hideProfileUrl'}, 'hide profile url, and user is visitor');
 ok( !$posts->[0]->{'lastReply.user.isVisitor'}, 'lastReply not made by visitor');
 ok(  $posts->[0]->{'lastReply.hideProfileUrl'}, 'lastReply hide profile url, since user is visitor');
-is(  $posts->[0]->{'lastReply.url'}, $threads[1]->getUrl.'?pn=1#id'.$threads[1]->getId, 'lastReply url has a query fragment prefixed by "id"');
+is(  $posts->[0]->{'lastReply.url'}, $threads[1]->getUrl.'#id'.$threads[1]->getId, 'lastReply url has a query fragment prefixed by "id"');
 is(  $posts->[0]->{'url'}, $threads[1]->getUrl.'#id'.$threads[1]->getId, 'url has a query fragment prefixed by "id"');
 
 

t/Asset/Wobject/Survey/SurveyJSON.t

@@ -13,7 +13,7 @@ use Data::Dumper;
 use WebGUI::Test;    # Must use this before any other WebGUI modules
 use WebGUI::Session;
 use JSON;
-use Clone qw/clone/;
+use Storable qw/dclone/;
 
 #----------------------------------------------------------------------------
 # Init
@@ -2112,13 +2112,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;
             }
         }

t/Asset/Wobject/Survey/Test.t

@@ -13,7 +13,6 @@ use Data::Dumper;
 use WebGUI::Test;    # Must use this before any other WebGUI modules
 use WebGUI::Session;
 use JSON;
-use Clone qw/clone/;
 
 #----------------------------------------------------------------------------
 # Init

t/Asset/Wobject/Survey/package.t

@@ -9,7 +9,7 @@ use lib "$FindBin::Bin/../../../lib";
 use Test::More;
 use Test::Deep;
 use Data::Dumper;
-use Clone qw/clone/;
+use Storable qw/dclone/;
 use WebGUI::Test;    # Must use this before any other WebGUI modules
 use WebGUI::Session;
 WebGUI::Error->Trace(1);    # Turn on tracing of uncaught Exception::Class exceptions
@@ -52,7 +52,7 @@ ok exists $asset_data->{question_types}->{toes}, 'the toes type in a question ty
     explain $asset_data;
 ok !exists $asset_data->{question_types}->{name}, 'name question not in question types';
 
-$asset_data->{question_types}->{fingers} = clone $asset_data->{question_types}->{toes};
+$asset_data->{question_types}->{fingers} = $asset_data->{question_types}->{toes};
 
 $survey->importAssetCollateralData($asset_data);
 

t/Asset/Wobject/WeatherData.t

@@ -19,7 +19,7 @@ use strict;
 use lib "$FindBin::Bin/../../lib";
 use Test::More;
 use Test::Deep;
-use Clone qw/clone/;
+use Storable qw/dclone/;
 
 use WebGUI::Test; # Must use this before any other WebGUI modules
 use WebGUI::Session;
@@ -64,7 +64,7 @@ my $templateMock = Test::MockObject->new({});
 $templateMock->set_isa('WebGUI::Asset::Template');
 $templateMock->set_always('getId', $templateId);
 my $templateVars;
-$templateMock->mock('process', sub { $templateVars = clone $_[1]; } );
+$templateMock->mock('process', sub { $templateVars = dclone $_[1]; } );
 
 my $asset  = $node->addChild( {
     className     => 'WebGUI::Asset::Wobject::WeatherData',

t/Asset/maximum_assets.t

@@ -18,7 +18,7 @@ use WebGUI::Asset;
 
 use Test::More;
 use Test::Deep;
-use Clone qw/clone/;
+use Storable qw/dclone/;
 
 plan tests => 1;
 
@@ -37,7 +37,7 @@ my $templateMock = Test::MockObject->new({});
 $templateMock->set_isa('WebGUI::Asset::Template');
 $templateMock->set_always('getId', $templateId);
 my $templateVars;
-$templateMock->mock('process', sub { $templateVars = clone($_[1]); } );
+$templateMock->mock('process', sub { $templateVars = dclone($_[1]); } );
 $session->setting->set('userFunctionStyleId', $templateId);
 
 ##Have to have a user who can add assets to the root node

t/Asset/processTemplate.t

@@ -18,7 +18,7 @@ use WebGUI::Asset;
 
 use Test::More;
 use Test::Deep;
-use Clone qw/clone/;
+use Storable qw/dclone/;
 
 plan tests => 1;
 
@@ -39,7 +39,7 @@ my $templateMock = Test::MockObject->new({});
 $templateMock->set_isa('WebGUI::Asset::Template');
 $templateMock->set_always('getId', $templateId);
 my $templateVars;
-$templateMock->mock('process', sub { $templateVars = clone($_[1]); } );
+$templateMock->mock('process', sub { $templateVars = dclone($_[1]); } );
 
 {
     WebGUI::Test->mockAssetId($templateId, $templateMock);

t/Group.t

@@ -396,7 +396,7 @@ cmp_ok($expirationDate-time(), '>', 50, 'checking expire offset override on addU
 
 $session->db->dbh->do('DROP TABLE IF EXISTS myUserTable');
 WebGUI::Test->addToCleanup(SQL => 'DROP TABLE IF EXISTS myUserTable');
-$session->db->dbh->do(q!CREATE TABLE myUserTable (userId CHAR(22) binary NOT NULL default '', PRIMARY KEY(userId)) TYPE=InnoDB!);
+$session->db->dbh->do(q!CREATE TABLE myUserTable (userId CHAR(22) binary NOT NULL default '', PRIMARY KEY(userId)) ENGINE=InnoDB!);
 
 my $sth = $session->db->prepare('INSERT INTO myUserTable VALUES(?)');
 foreach my $mob (@mob) {

t/Macro/GroupText.t

@@ -49,7 +49,7 @@ is($output, 'Group Not a Group was not found', 'Non-existant group returns an er
 
 ##Create a small database
 $session->db->dbh->do('DROP TABLE IF EXISTS myUserTable');
-$session->db->dbh->do(q!CREATE TABLE myUserTable (userId CHAR(22) binary NOT NULL default '', PRIMARY KEY(userId)) TYPE=InnoDB!);
+$session->db->dbh->do(q!CREATE TABLE myUserTable (userId CHAR(22) binary NOT NULL default '', PRIMARY KEY(userId)) Engine=InnoDB!);
 WebGUI::Test->addToCleanup(SQL => 'DROP TABLE IF EXISTS myUserTable');
 
 ##Create a bunch of users and put them in the table.

t/Macro/SQL.t

@@ -33,7 +33,7 @@ my $originalMacroAccessValue = $WebGUIdbLink->macroAccessIsAllowed();
 
 $session->db->dbh->do('DROP TABLE IF EXISTS testTable');
 WebGUI::Test->addToCleanup(SQL => 'DROP TABLE testTable');
-$session->db->dbh->do('CREATE TABLE testTable (zero int(8), one int(8), two int(8), three int(8), four int(8), five int(8), six int(8), seven int(8), eight int(8), nine int(8), ten int(8), eleven int(8) ) TYPE=InnoDB');
+$session->db->dbh->do('CREATE TABLE testTable (zero int(8), one int(8), two int(8), three int(8), four int(8), five int(8), six int(8), seven int(8), eight int(8), nine int(8), ten int(8), eleven int(8) ) ENGINE=InnoDB');
 $session->db->dbh->do('INSERT INTO testTable (zero, one, two, three, four, five, six, seven, eight, nine, ten, eleven ) VALUES(0,1,2,3,4,5,6,7,8,9,10,11)');
 $session->db->dbh->do('INSERT INTO testTable (zero, one, two, three, four, five, six, seven, eight, nine, ten, eleven ) VALUES(100,101,102,103,104,105,106,107,108,109,110,111)');
 

t/SQL.t

@@ -173,7 +173,7 @@ SKIP: {
 
 	skip("No InnoDB tables in this MySQL.  Skipping all transaction related tests.",7) if (lc $mysqlVariables{have_innodb} ne 'yes');
     $session->db->dbh->do('DROP TABLE IF EXISTS testTable');
-    $session->db->dbh->do('CREATE TABLE testTable (myIndex int(8) NOT NULL default 0, message CHAR(64), PRIMARY KEY(myIndex)) TYPE=InnoDB');
+    $session->db->dbh->do('CREATE TABLE testTable (myIndex int(8) NOT NULL default 0, message CHAR(64), PRIMARY KEY(myIndex)) Engine=InnoDB');
     addToCleanup( SQL => 'DROP TABLE testTable' );
 
     my $dbh2 = WebGUI::SQL->connect($session,$session->config->get("dsn"), $session->config->get("dbuser"), $session->config->get("dbpass"));

t/Shop/Transaction.t

@@ -23,7 +23,7 @@ use WebGUI::Test; # Must use this before any other WebGUI modules
 use WebGUI::Session;
 use WebGUI::Shop::Transaction;
 use WebGUI::Inbox;
-use Clone qw/clone/;
+use Storable qw/dclone/;
 
 #----------------------------------------------------------------------------
 # Init
@@ -269,7 +269,7 @@ my $templateMock = Test::MockObject->new({});
 $templateMock->set_isa('WebGUI::Asset::Template');
 $templateMock->set_always('getId', $templateId);
 my @templateVars;
-$templateMock->mock('process', sub { push @templateVars, clone $_[1]; } );
+$templateMock->mock('process', sub { push @templateVars, dclone $_[1]; } );
 
 $session->setting->set('shopReceiptEmailTemplateId', $templateId);
 

t/lib/WebGUI/Test.pm

@@ -29,7 +29,7 @@ use base qw(Test::Builder::Module);
 use Test::MockObject;
 use Test::MockObject::Extends;
 use Log::Log4perl;  # load early to ensure proper order of END blocks
-use Clone               qw(clone);
+use Storable            qw(dclone);
 use File::Basename      qw(dirname fileparse);
 use File::Spec::Functions qw(abs2rel rel2abs catdir catfile updir);
 use IO::Handle          ();
@@ -108,7 +108,7 @@ sub import {
 sub _initSession {
     my $session = our $SESSION = $CLASS->newSession(1);
 
-    my $originalSetting = clone $session->setting->get;
+    my $originalSetting = dclone $session->setting->get;
     $CLASS->addToCleanup(sub {
         while (my ($param, $value) = each %{ $originalSetting }) {
             $session->setting->set($param, $value);
@@ -612,7 +612,7 @@ sub originalConfig {
     my ($class, $param) = @_;
     my $safeValue = my $value = $CLASS->session->config->get($param);
     if (ref $value) {
-        $safeValue = clone $value;
+        $safeValue = dclone $value;
     }
     # add cleanup handler if this is the first time we were run
     if (! keys %originalConfig) {