diff --git a/lib/WebGUI/Upgrade/File/pl.pm b/lib/WebGUI/Upgrade/File/pl.pm index 497d61e04..d8936e862 100644 --- a/lib/WebGUI/Upgrade/File/pl.pm +++ b/lib/WebGUI/Upgrade/File/pl.pm @@ -3,21 +3,40 @@ use 5.010; use strict; use warnings; -use WebGUI::Upgrade; +use WebGUI::Upgrade (); +use WebGUI::Upgrade::File::wgpkg (); use POSIX (); +use Path::Class::Dir (); +use Exporter qw(import); sub _runCode { eval sprintf <<'END_CODE', $_[0], $_[1]; +package WebGUI::Upgrade::File::pl::script; use strict; use warnings; local @_; local $_; -local *_runCode; -local *run; +use WebGUI::Upgrade::File::pl qw(:script); # line 1 "%s" %s +; +use namespace::clean; END_CODE } +our @EXPORT_OK = qw( + report + done + config + session + dbh + version_tag + rm_lib + collateral + import_package +); +our %EXPORT_TAGS = ( + script => \@EXPORT_OK, +); my $configFile; my $quiet; @@ -26,15 +45,24 @@ my $file; my $session; my $config; my $dbh; +my $collateral; my $versionTag; sub run { my $class = shift; ($configFile, $version, $file, $quiet) = @_; - ($session, $config, $dbh, $versionTag) = undef; + ($session, $config, $dbh, $versionTag, $collateral) = undef; open my $fh, '<', $file; my $contents = do { local $/; <$fh> }; close $fh; - _runCode($file, $contents); + + my @res; + if (wantarray) { + @res = _runCode($file, $contents); + } + else { + $res[0] = _runCode($file, $contents); + } + my $error = $@; if ($session) { require WebGUI::VersionTag; @@ -46,7 +74,7 @@ sub run { } die $error if $error; - return 1; + return (wantarray ? @res : $res[0]); } sub report { @@ -114,5 +142,21 @@ sub rm_lib { } } +sub collateral () { + if (! $collateral) { + (my $vol, my $dir, my $shortname) = File::Spec->splitpath($file); + $shortname =~ s/\.[^.]*$//; + my $path = File::Spec->catpath($vol, File::Spec->catdir($dir, $shortname), ''); + $collateral = Path::Class::Dir->new($path); + } + return $collateral; +} + +sub import_package { + my $fullPath = collateral->file(@_); + require WebGUI::Upgrade::File::wgpkg; + WebGUI::Upgrade::File::wgpkg->import_package(session, $fullPath); +} + 1; diff --git a/lib/WebGUI/Upgrade/File/wgpkg.pm b/lib/WebGUI/Upgrade/File/wgpkg.pm index 7730d7df3..07a22df5a 100644 --- a/lib/WebGUI/Upgrade/File/wgpkg.pm +++ b/lib/WebGUI/Upgrade/File/wgpkg.pm @@ -16,16 +16,30 @@ sub run { my $session = WebGUI::Session->open($configFile); $session->user({userId => 3}); - # Make a storage location for the package - my $storage = WebGUI::Storage->createTemp( $session ); - $storage->addFileFromFilesystem( $file ); - (undef, undef, my $shortname) = File::Spec->splitpath($file); $shortname =~ s/\.[^.]*$//; my $versionTag = WebGUI::VersionTag->getWorking($session); $versionTag->set({name => "Upgrade to $version - $shortname"}); + my $package = $class->import_package($session, $file); + +warn $versionTag->getId; + $versionTag->commit; + $session->var->end; + $session->close; + + return $package; +} + +sub import_package { + my $class = shift; + my ($session, $file) = @_; + # Make a storage location for the package + + my $storage = WebGUI::Storage->createTemp( $session ); + $storage->addFileFromFilesystem( $file ); + # Import the package into the import node my $package = eval { WebGUI::Asset->getImportNode($session)->importPackage( $storage ); @@ -43,7 +57,7 @@ sub run { # Turn off the package flag, and set the default flag for templates added my $assetIds = $package->getLineage( ['self','descendants'] ); for my $assetId ( @{ $assetIds } ) { - my $asset = WebGUI::Asset->newByDynamicClass( $session, $assetId ); + my $asset = WebGUI::Asset->newById( $session, $assetId ); if ( !$asset ) { print "Couldn't instantiate asset with ID '$assetId'. Please check package '$file' for corruption.\n"; next; @@ -54,12 +68,7 @@ sub run { } $asset->update( $properties ); } - - $versionTag->commit; - $session->var->end; - $session->close; - - return 1; + return $package; } 1; diff --git a/t/Upgrade.t b/t/Upgrade.t index 9030ffe69..4a0770163 100644 --- a/t/Upgrade.t +++ b/t/Upgrade.t @@ -6,11 +6,13 @@ use FindBin; use strict; use lib "$FindBin::Bin/lib"; -use WebGUI::Test import => [qw(collateral)]; +use WebGUI::Test import => [qw(collateral addToCleanup)]; use Test::More; use Test::MockObject; use Test::MockObject::Extends; +use File::Temp; +use File::Path qw(make_path); BEGIN { $INC{'WebGUI.pm'} = 1; @@ -20,100 +22,135 @@ BEGIN { use WebGUI::Paths; use WebGUI::Upgrade; use WebGUI::Session::Id; +use WebGUI::VersionTag; use Try::Tiny; use Capture::Tiny qw(capture); -use mro; -my $configFile = WebGUI::Test->config->getFilename; -local *WebGUI::Paths::siteConfigs = sub { $configFile }; +local *WebGUI::Paths::siteConfigs; +local *WebGUI::Paths::upgrades; + +our $configFile = WebGUI::Test->config->getFilename; +{ + no warnings 'redefine'; + *WebGUI::Paths::siteConfigs = sub { $configFile }; +} my $upgrade = Test::MockObject::Extends->new('WebGUI::Upgrade'); $upgrade->set_always('getCurrentVersion', '8.0.0'); -local *WebGUI::Paths::upgrades = sub { collateral('upgrades', 'impossible') } ; - +{ + no warnings 'redefine'; + *WebGUI::Paths::upgrades = sub { collateral('Upgrade', 'impossible') } ; +} ok ! try { $upgrade->calcUpgradePath('8.0.0', '8.4.3'); 1 }, 'calcUpgradePath dies when unable to find a path'; -*WebGUI::Paths::upgrades = sub { collateral('upgrades', 'backtrack') } ; - -is_deeply [$upgrade->calcUpgradePath('8.0.0', '8.4.3')], [qw(8.0.0-8.1.0 8.1.0-8.2.0 8.2.0-8.3.0 8.3.0-8.4.3)], 'calcUpgradePath finds correct path with backtracking'; - -*WebGUI::Paths::upgrades = sub { collateral('upgrades', 'valid') } ; +{ + no warnings 'redefine'; + *WebGUI::Paths::upgrades = sub { collateral('Upgrade', 'backtrack') } ; +} +is_deeply + [ $upgrade->calcUpgradePath('8.0.0', '8.4.3') ], + [qw( 8.0.0-8.1.0 8.1.0-8.2.0 8.2.0-8.3.0 8.3.0-8.4.3 )], + 'calcUpgradePath finds correct path with backtracking'; +{ + no warnings 'redefine'; + *WebGUI::Paths::upgrades = sub { collateral('Upgrade', 'valid') } ; +} $upgrade->set_true('runUpgradeFile'); -my $res; -my ($stdout, $stderr) = capture { - $res = $upgrade->upgradeSites; -}; +my $stdout; +my $stderr; +my $res; +capture { $res = $upgrade->upgradeSites }; ok $res, 'upgradeSites runs'; $upgrade->called_pos_ok(1, 'getCurrentVersion'); $upgrade->called_pos_ok(2, 'runUpgradeFile'); my $upgradeFile = $upgrade->call_args_pos(2, 4); ok $upgradeFile =~ /\b00_simple\.pl$/, 'correct upgrade file run'; -$upgrade->clear; +$upgrade->clear; $upgrade->unmock('runUpgradeFile'); -($stdout, $stderr) = capture { - $upgrade->runUpgradeFile($configFile, '8.3.0', collateral('upgrades', 'output.pl')); -}; +$upgrade->mock(testUpgrade => sub { + my $self = shift; + my $file = shift; + $self->runUpgradeFile($configFile, '8.3.0', collateral('Upgrade', $file), @_); +}); +$stdout = capture { $upgrade->testUpgrade('output.pl') }; ok $stdout =~ 'Simple Output', 'report command functions correctly'; ok $stdout =~ 'Done', 'done command functions correctly'; -($stdout, $stderr) = capture { - $upgrade->runUpgradeFile($configFile, '8.3.0', collateral('upgrades', 'output.pl'), 1); -}; - +$stdout = capture { $upgrade->testUpgrade('output.pl', 1) }; ok $stdout !~ 'Simple Output', 'quiet flag silences report command'; ok $stdout !~ 'Done', 'quiet flag silences done command'; -capture { - try { - $upgrade->runUpgradeFile($configFile, '8.3.0', collateral('upgrades', 'die.pl')); - fail 'Error on failing upgrade'; - } - catch { - pass 'Error on failing upgrade'; - }; -}; - -capture { - try { - $upgrade->runUpgradeFile($configFile, '8.3.0', collateral('upgrades', 'strict-failure.pl')); - fail 'strict enabled in upgrades'; - } - catch { - pass 'strict enabled in upgrades'; - }; -}; +ok !try { $upgrade->testUpgrade('die.pl'); 1 }, 'Error on failing upgrade'; +ok !try { $upgrade->testUpgrade('strict-failure.pl'); 1 }, 'strict enabled in upgrades'; my $session = WebGUI::Test->session; my $dbh = $upgrade->dbhForConfig(WebGUI::Test->config); -my ($totalAssets) = $dbh->selectrow_array('SELECT COUNT(*) FROM asset'); -($stdout, $stderr) = capture { - $upgrade->runUpgradeFile($configFile, '8.3.0', collateral('upgrades', 'dbh.pl')); -}; +our $totalAssets = $dbh->selectrow_array('SELECT COUNT(*) FROM asset'); +$upgrade->testUpgrade('dbh.pl'); -is $stdout, $totalAssets, 'dbh function working correctly'; +$upgrade->testUpgrade('config.pl'); -($stdout, $stderr) = capture { - $upgrade->runUpgradeFile($configFile, '8.3.0', collateral('upgrades', 'config.pl')); -}; +{ + my $sId = $upgrade->testUpgrade('session.pl'); -is $stdout, $configFile, 'config function working correctly'; + ok +WebGUI::Session::Id::valid({}, $sId), 'valid session id generated'; + my $hasSession = $dbh->selectrow_array('SELECT COUNT(*) FROM userSession WHERE sessionId = ?', {}, $sId); + ok !$hasSession, 'session properly closed'; +} -($stdout, $stderr) = capture { - $upgrade->runUpgradeFile($configFile, '8.3.0', collateral('upgrades', 'session.pl')); -}; +{ + my $vt = $upgrade->testUpgrade('versiontag-implicit.pl'); + ok $vt->get('isCommitted'), 'implicit version tag committed'; + is $vt->get('name'), 'Upgrade to 8.3.0 - versiontag-implicit', 'implicit version tag named correctly'; +} -ok(WebGUI::Session::Id::valid({}, $stdout), 'valid session id generated'); -my ($hasSession) = $dbh->selectrow_array('SELECT COUNT(*) FROM userSession WHERE sessionId = ?', {}, $stdout); -ok !$hasSession, 'session properly closed'; +$upgrade->testUpgrade('versiontag.pl'); +$upgrade->testUpgrade('collateral.pl'); +$upgrade->testUpgrade('package.pl'); + +{ + my $temp = File::Temp->newdir; + local @INC = @INC; + my @modules; + for (1..2) { + my $lib_dir = File::Spec->catdir($temp, 'lib' . $_); + unshift @INC, $lib_dir; + my $mod_dir = File::Spec->catdir($lib_dir, 'WebGUI', 'Upgrade', 'Test'); + my $module = File::Spec->catfile($mod_dir, 'Module.pm'); + push @modules, $module; + make_path($mod_dir); + open my $fh, '>', $module; + print {$fh} <<'END_PM'; +package WebGUI::Upgrade::Test::Module; + +1; +END_PM + close $fh; + } + + $upgrade->testUpgrade('rmlib.pl'); + + ok !(grep { -e } @modules), 'all libraries removed correctly'; +} + +{ + my $package = $upgrade->testUpgrade('test-template.wgpkg'); + isa_ok $package, 'WebGUI::Asset::Template'; + my $vtId = $package->get('tagId'); + warn $vtId; + my $vt = WebGUI::VersionTag->new($session, $vtId); + addToCleanup($vt); + is $vt->get('name'), 'Upgrade to 8.3.0 - test-snippet', 'package import names version tag correctly'; +} done_testing; diff --git a/t/lib/WebGUI/Test.pm b/t/lib/WebGUI/Test.pm index 72787c63a..e2c7115f3 100644 --- a/t/lib/WebGUI/Test.pm +++ b/t/lib/WebGUI/Test.pm @@ -704,6 +704,8 @@ Example call: my @cleanups; while (@_) { my $class = shift; + next + if !defined $class; my $construct; if ( ref $class ) { my $object = $class; diff --git a/t/supporting_collateral/upgrades/backtrack/8.0.0-8.1.0/.exists b/t/supporting_collateral/Upgrade/backtrack/8.0.0-8.1.0/.exists similarity index 100% rename from t/supporting_collateral/upgrades/backtrack/8.0.0-8.1.0/.exists rename to t/supporting_collateral/Upgrade/backtrack/8.0.0-8.1.0/.exists diff --git a/t/supporting_collateral/upgrades/backtrack/8.1.0-8.2.0/.exists b/t/supporting_collateral/Upgrade/backtrack/8.1.0-8.2.0/.exists similarity index 100% rename from t/supporting_collateral/upgrades/backtrack/8.1.0-8.2.0/.exists rename to t/supporting_collateral/Upgrade/backtrack/8.1.0-8.2.0/.exists diff --git a/t/supporting_collateral/upgrades/backtrack/8.1.0-8.3.0/.exists b/t/supporting_collateral/Upgrade/backtrack/8.1.0-8.3.0/.exists similarity index 100% rename from t/supporting_collateral/upgrades/backtrack/8.1.0-8.3.0/.exists rename to t/supporting_collateral/Upgrade/backtrack/8.1.0-8.3.0/.exists diff --git a/t/supporting_collateral/upgrades/backtrack/8.2.0-8.2.1/.exists b/t/supporting_collateral/Upgrade/backtrack/8.2.0-8.2.1/.exists similarity index 100% rename from t/supporting_collateral/upgrades/backtrack/8.2.0-8.2.1/.exists rename to t/supporting_collateral/Upgrade/backtrack/8.2.0-8.2.1/.exists diff --git a/t/supporting_collateral/upgrades/backtrack/8.2.0-8.3.0/.exists b/t/supporting_collateral/Upgrade/backtrack/8.2.0-8.3.0/.exists similarity index 100% rename from t/supporting_collateral/upgrades/backtrack/8.2.0-8.3.0/.exists rename to t/supporting_collateral/Upgrade/backtrack/8.2.0-8.3.0/.exists diff --git a/t/supporting_collateral/upgrades/backtrack/8.3.0-8.4.3/.exists b/t/supporting_collateral/Upgrade/backtrack/8.3.0-8.4.3/.exists similarity index 100% rename from t/supporting_collateral/upgrades/backtrack/8.3.0-8.4.3/.exists rename to t/supporting_collateral/Upgrade/backtrack/8.3.0-8.4.3/.exists diff --git a/t/supporting_collateral/Upgrade/collateral.pl b/t/supporting_collateral/Upgrade/collateral.pl new file mode 100644 index 000000000..2552acf96 --- /dev/null +++ b/t/supporting_collateral/Upgrade/collateral.pl @@ -0,0 +1,7 @@ +my $c = collateral; + +::isa_ok $c, 'Path::Class::Dir'; + +::ok -e $c->file('collateral.txt'), 'correct collateral path used'; + + diff --git a/t/supporting_collateral/Upgrade/collateral/collateral.txt b/t/supporting_collateral/Upgrade/collateral/collateral.txt new file mode 100644 index 000000000..2f26b312b --- /dev/null +++ b/t/supporting_collateral/Upgrade/collateral/collateral.txt @@ -0,0 +1 @@ +collateral file diff --git a/t/supporting_collateral/Upgrade/config.pl b/t/supporting_collateral/Upgrade/config.pl new file mode 100644 index 000000000..846e7fb9f --- /dev/null +++ b/t/supporting_collateral/Upgrade/config.pl @@ -0,0 +1,2 @@ +::is config->getFilename, $::configFile, 'config function works correctly'; + diff --git a/t/supporting_collateral/Upgrade/dbh.pl b/t/supporting_collateral/Upgrade/dbh.pl new file mode 100644 index 000000000..34a54c466 --- /dev/null +++ b/t/supporting_collateral/Upgrade/dbh.pl @@ -0,0 +1,3 @@ +my $totalAssets = dbh->selectrow_array('SELECT COUNT(*) FROM asset'); +::is $totalAssets, $::totalAssets, 'dbh function working correctly'; + diff --git a/t/supporting_collateral/upgrades/die.pl b/t/supporting_collateral/Upgrade/die.pl similarity index 100% rename from t/supporting_collateral/upgrades/die.pl rename to t/supporting_collateral/Upgrade/die.pl diff --git a/t/supporting_collateral/upgrades/output.pl b/t/supporting_collateral/Upgrade/output.pl similarity index 100% rename from t/supporting_collateral/upgrades/output.pl rename to t/supporting_collateral/Upgrade/output.pl diff --git a/t/supporting_collateral/Upgrade/package.pl b/t/supporting_collateral/Upgrade/package.pl new file mode 100644 index 000000000..17124ab62 --- /dev/null +++ b/t/supporting_collateral/Upgrade/package.pl @@ -0,0 +1,11 @@ +::addToCleanup(version_tag); + +import_package('test-template.wgpkg'); + +my $assets = version_tag->getAssets; + +::is scalar @$assets, 1, 'imported one asset with package'; + +::isa_ok $assets->[0], 'WebGUI::Asset::Template'; + + diff --git a/t/supporting_collateral/Upgrade/package/test-template.wgpkg b/t/supporting_collateral/Upgrade/package/test-template.wgpkg new file mode 100644 index 000000000..4e2f8a442 Binary files /dev/null and b/t/supporting_collateral/Upgrade/package/test-template.wgpkg differ diff --git a/t/supporting_collateral/Upgrade/rmlib.pl b/t/supporting_collateral/Upgrade/rmlib.pl new file mode 100644 index 000000000..0d7b55a78 --- /dev/null +++ b/t/supporting_collateral/Upgrade/rmlib.pl @@ -0,0 +1,2 @@ +rm_lib 'WebGUI::Upgrade::Test::Module'; + diff --git a/t/supporting_collateral/Upgrade/session.pl b/t/supporting_collateral/Upgrade/session.pl new file mode 100644 index 000000000..b62b121d5 --- /dev/null +++ b/t/supporting_collateral/Upgrade/session.pl @@ -0,0 +1,7 @@ +my $s = session; +::isa_ok $s, 'WebGUI::Session'; +::is $s, session, 'session properly cached'; +::is $s->user->getId, 3, 'admin user set for session'; + +$s->getId; + diff --git a/t/supporting_collateral/upgrades/strict-failure.pl b/t/supporting_collateral/Upgrade/strict-failure.pl similarity index 100% rename from t/supporting_collateral/upgrades/strict-failure.pl rename to t/supporting_collateral/Upgrade/strict-failure.pl diff --git a/t/supporting_collateral/Upgrade/test-template.wgpkg b/t/supporting_collateral/Upgrade/test-template.wgpkg new file mode 100644 index 000000000..4e2f8a442 Binary files /dev/null and b/t/supporting_collateral/Upgrade/test-template.wgpkg differ diff --git a/t/supporting_collateral/upgrades/valid/8.0.0-8.4.0/00_simple.pl b/t/supporting_collateral/Upgrade/valid/8.0.0-8.4.0/00_simple.pl similarity index 100% rename from t/supporting_collateral/upgrades/valid/8.0.0-8.4.0/00_simple.pl rename to t/supporting_collateral/Upgrade/valid/8.0.0-8.4.0/00_simple.pl diff --git a/t/supporting_collateral/Upgrade/versiontag-implicit.pl b/t/supporting_collateral/Upgrade/versiontag-implicit.pl new file mode 100644 index 000000000..9144b2d7d --- /dev/null +++ b/t/supporting_collateral/Upgrade/versiontag-implicit.pl @@ -0,0 +1,12 @@ +use WebGUI::Asset; +use WebGUI::Asset::Snippet; +WebGUI::Asset->getRoot(session)->addChild({ + className => 'WebGUI::Asset::Snippet', + title => 'Test snippet', +}); +my $vt = WebGUI::VersionTag->getWorking(session, 'nocreate'); +if ($vt) { + ::addToCleanup($vt); +} +$vt; + diff --git a/t/supporting_collateral/Upgrade/versiontag.pl b/t/supporting_collateral/Upgrade/versiontag.pl new file mode 100644 index 000000000..48d305ffa --- /dev/null +++ b/t/supporting_collateral/Upgrade/versiontag.pl @@ -0,0 +1,15 @@ +my $vt = version_tag; +::addToCleanup($vt); + +::isa_ok $vt, 'WebGUI::VersionTag'; +::is $vt->get('name'), 'Upgrade to 8.3.0 - versiontag', 'auto-naming with short name works'; + +::is $vt, version_tag, 'second call gives same version tag'; +::ok ! $vt->get('isCommitted'), '... and doesn\'t commit version tag'; + +my $vt2 = version_tag 'Adding This Stuff'; +::addToCleanup($vt); +::ok $vt->get('isCommitted'), 'Request for new version tag commits previous tag'; +::is $vt2->get('name'), 'Upgrade to 8.3.0 - Adding This Stuff', 'explicit name used correctly'; + + diff --git a/t/supporting_collateral/upgrades/config.pl b/t/supporting_collateral/upgrades/config.pl deleted file mode 100644 index 6d0e42507..000000000 --- a/t/supporting_collateral/upgrades/config.pl +++ /dev/null @@ -1,2 +0,0 @@ -print config->getFilename; - diff --git a/t/supporting_collateral/upgrades/dbh.pl b/t/supporting_collateral/upgrades/dbh.pl deleted file mode 100644 index a24226b4f..000000000 --- a/t/supporting_collateral/upgrades/dbh.pl +++ /dev/null @@ -1,3 +0,0 @@ -my ($totalAssets) = dbh->selectrow_array('SELECT COUNT(*) FROM asset'); -print $totalAssets; - diff --git a/t/supporting_collateral/upgrades/session.pl b/t/supporting_collateral/upgrades/session.pl deleted file mode 100644 index a900e4850..000000000 --- a/t/supporting_collateral/upgrades/session.pl +++ /dev/null @@ -1,2 +0,0 @@ -print session->getId; -