diff --git a/docs/gotcha.txt b/docs/gotcha.txt index 93f2b1b18..74a333219 100644 --- a/docs/gotcha.txt +++ b/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 diff --git a/lib/WebGUI/Asset.pm b/lib/WebGUI/Asset.pm index 2cbf233ce..e9c862957 100644 --- a/lib/WebGUI/Asset.pm +++ b/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 diff --git a/lib/WebGUI/Asset/Template.pm b/lib/WebGUI/Asset/Template.pm index c8c108829..3d76629e7 100644 --- a/lib/WebGUI/Asset/Template.pm +++ b/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 $properties = clone($requestedProperties); + my $requestedProperties = shift || {}; + my $properties = dclone($requestedProperties); if (exists $properties->{headBlock}) { $properties->{extraHeadTags} .= $properties->{headBlock}; diff --git a/lib/WebGUI/Asset/Wobject/Survey/ResponseJSON.pm b/lib/WebGUI/Asset/Wobject/Survey/ResponseJSON.pm index 844e9b635..0ade22f93 100644 --- a/lib/WebGUI/Asset/Wobject/Survey/ResponseJSON.pm +++ b/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' diff --git a/lib/WebGUI/Asset/Wobject/Survey/SurveyJSON.pm b/lib/WebGUI/Asset/Wobject/Survey/SurveyJSON.pm index 7d1abca44..142aad5cd 100644 --- a/lib/WebGUI/Asset/Wobject/Survey/SurveyJSON.pm +++ b/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) diff --git a/lib/WebGUI/Asset/Wobject/WikiMaster.pm b/lib/WebGUI/Asset/Wobject/WikiMaster.pm index 736fa50a7..de875b004 100644 --- a/lib/WebGUI/Asset/Wobject/WikiMaster.pm +++ b/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 ]; diff --git a/lib/WebGUI/Cache/CHI.pm b/lib/WebGUI/Cache/CHI.pm index b5aa9c609..4423d4029 100644 --- a/lib/WebGUI/Cache/CHI.pm +++ b/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; diff --git a/lib/WebGUI/Crud.pm b/lib/WebGUI/Crud.pm index 96b6f684c..7afd7faf8 100644 --- a/lib/WebGUI/Crud.pm +++ b/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}; } #------------------------------------------------------------------- diff --git a/lib/WebGUI/Shop/PayDriver.pm b/lib/WebGUI/Shop/PayDriver.pm index e901d5a42..f405c8ed2 100644 --- a/lib/WebGUI/Shop/PayDriver.pm +++ b/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; diff --git a/sbin/testEnvironment.pl b/sbin/testEnvironment.pl index e42c01d94..ce67985df 100755 --- a/sbin/testEnvironment.pl +++ b/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; diff --git a/t/Asset/Wobject/Collaboration/templateVariables.t b/t/Asset/Wobject/Collaboration/templateVariables.t index 7cab1d4e0..5f3640023 100644 --- a/t/Asset/Wobject/Collaboration/templateVariables.t +++ b/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"'); diff --git a/t/Asset/Wobject/Survey/SurveyJSON.t b/t/Asset/Wobject/Survey/SurveyJSON.t index 4830b4c25..ab1d3bf55 100644 --- a/t/Asset/Wobject/Survey/SurveyJSON.t +++ b/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; } } diff --git a/t/Asset/Wobject/Survey/Test.t b/t/Asset/Wobject/Survey/Test.t index 4f7aedb72..321906f35 100644 --- a/t/Asset/Wobject/Survey/Test.t +++ b/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 diff --git a/t/Asset/Wobject/Survey/package.t b/t/Asset/Wobject/Survey/package.t index 8d161d1ec..27a5e8058 100644 --- a/t/Asset/Wobject/Survey/package.t +++ b/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); diff --git a/t/Asset/Wobject/WeatherData.t b/t/Asset/Wobject/WeatherData.t index b875ae473..4329739a6 100644 --- a/t/Asset/Wobject/WeatherData.t +++ b/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', diff --git a/t/Asset/maximum_assets.t b/t/Asset/maximum_assets.t index bc36fd0f9..b75a09853 100644 --- a/t/Asset/maximum_assets.t +++ b/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 diff --git a/t/Asset/processTemplate.t b/t/Asset/processTemplate.t index 00843f083..d17c65e6e 100644 --- a/t/Asset/processTemplate.t +++ b/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); diff --git a/t/Group.t b/t/Group.t index 2226e2fb6..7ab5bdf65 100644 --- a/t/Group.t +++ b/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) { diff --git a/t/Macro/GroupText.t b/t/Macro/GroupText.t index f8c9595f9..29bb0f28b 100644 --- a/t/Macro/GroupText.t +++ b/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. diff --git a/t/Macro/SQL.t b/t/Macro/SQL.t index b6b26b521..e9e93e9af 100644 --- a/t/Macro/SQL.t +++ b/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)'); diff --git a/t/SQL.t b/t/SQL.t index d7049fd93..d989c3330 100644 --- a/t/SQL.t +++ b/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")); diff --git a/t/Shop/Transaction.t b/t/Shop/Transaction.t index df672392c..07e2ca94b 100644 --- a/t/Shop/Transaction.t +++ b/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); diff --git a/t/lib/WebGUI/Test.pm b/t/lib/WebGUI/Test.pm index 9f42e4db5..f98397194 100644 --- a/t/lib/WebGUI/Test.pm +++ b/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) {