testing for all upgrade script subs

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;
 

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;

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';
+
+

t/supporting_collateral/Upgrade/collateral/collateral.txt

@@ -0,0 +1 @@
+collateral file

t/supporting_collateral/Upgrade/config.pl

@@ -0,0 +1,2 @@
+::is config->getFilename, $::configFile, 'config function works correctly';
+

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';
+

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';
+
+

t/supporting_collateral/Upgrade/rmlib.pl

@@ -0,0 +1,2 @@
+rm_lib 'WebGUI::Upgrade::Test::Module';
+

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;
+

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;
+

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';
+
+

t/supporting_collateral/upgrades/config.pl

@@ -1,2 +0,0 @@
-print config->getFilename;
-

t/supporting_collateral/upgrades/dbh.pl

@@ -1,3 +0,0 @@
-my ($totalAssets) = dbh->selectrow_array('SELECT COUNT(*) FROM asset');
-print $totalAssets;
-

t/supporting_collateral/upgrades/session.pl

@@ -1,2 +0,0 @@
-print session->getId;
-