testing for all upgrade script subs

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;
+use WebGUI::Upgrade::File::pl qw(:script);
-local *run;
 # 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;
 

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 );
     }
-
+    return $package;
-    $versionTag->commit;
-    $session->var->end;
-    $session->close;
-
-    return 1;
 }
 
 1;

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;
-local *WebGUI::Paths::siteConfigs = sub { $configFile };
+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') } ;
+{
-
+    no warnings 'redefine';
-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('Upgrade', 'backtrack') } ;
-
+}
-*WebGUI::Paths::upgrades = sub { collateral('upgrades', 'valid') } ;
+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;
-my ($stdout, $stderr) = capture {
+my $stderr;
-    $res = $upgrade->upgradeSites;
-};
 
+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->mock(testUpgrade => sub {
-    $upgrade->runUpgradeFile($configFile, '8.3.0', collateral('upgrades', 'output.pl'));
+    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 {
+$stdout = capture { $upgrade->testUpgrade('output.pl', 1) };
-    $upgrade->runUpgradeFile($configFile, '8.3.0', collateral('upgrades', 'output.pl'), 1);
-};
-
 ok $stdout !~ 'Simple Output', 'quiet flag silences report command';
 ok $stdout !~ 'Done', 'quiet flag silences done command';
 
-capture {
+ok !try { $upgrade->testUpgrade('die.pl'); 1 }, 'Error on failing upgrade';
-    try {
+ok !try { $upgrade->testUpgrade('strict-failure.pl'); 1 }, 'strict enabled in upgrades';
-        $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';
-    };
-};
 
 my $session = WebGUI::Test->session;
 
 my $dbh = $upgrade->dbhForConfig(WebGUI::Test->config);
-my ($totalAssets) = $dbh->selectrow_array('SELECT COUNT(*) FROM asset');
+our $totalAssets = $dbh->selectrow_array('SELECT COUNT(*) FROM asset');
-($stdout, $stderr) = capture {
+$upgrade->testUpgrade('dbh.pl');
-    $upgrade->runUpgradeFile($configFile, '8.3.0', collateral('upgrades', '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');
+$upgrade->testUpgrade('versiontag.pl');
-my ($hasSession) = $dbh->selectrow_array('SELECT COUNT(*) FROM userSession WHERE sessionId = ?', {}, $stdout);
+$upgrade->testUpgrade('collateral.pl');
-ok !$hasSession, 'session properly closed';
+$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;
-