more upgrades progress

lib/WebGUI/Session.pm

@@ -172,6 +172,12 @@ sub close {
 	foreach my $key (qw/_asset _datetime _icon _slave _db _form _http _id _output _privilege _scratch _setting _stow _style _url _user _var _cache _errorHandler _response _request/) {
 		delete $self->{$key};
 	}
+    $self->{closed} = 1;
+}
+
+sub closed {
+    my $self = shift;
+    return $self->{closed};
 }
 
 #-------------------------------------------------------------------

lib/WebGUI/Upgrade.pm

@@ -1,13 +1,12 @@
 package WebGUI::Upgrade;
-
 use strict;
 use warnings;
+
 use WebGUI::Paths;
-use WebGUI;
-use Try::Tiny;
 use WebGUI::Pluggable;
-use DBI;
 use WebGUI::Config;
+use Try::Tiny;
+use DBI;
 
 sub upgradeSites {
     my $class = shift;
@@ -27,11 +26,17 @@ sub upgradeSites {
     return 1;
 }
 
+sub getCodeVersion {
+    require WebGUI;
+    return WebGUI->VERSION;
+}
+
 sub upgradeSite {
     my $class = shift;
     my ($configFile, $quiet) = @_;
     my $fromVersion = $class->getCurrentVersion($configFile);
-    my @steps = $class->calcUpgradePath($fromVersion, $WebGUI::VERSION);
+    my $toVersion = $class->getCodeVersion;
+    my @steps = $class->calcUpgradePath($fromVersion, $toVersion);
     for my $step ( @steps ) {
         $class->runUpgradeStep($configFile, $step, $quiet);
     }
@@ -44,7 +49,8 @@ sub calcUpgradePath {
     my $toVersion = $class->numericVersion($toVersionStr);
 
     my %upgrades;
-    opendir my $dh, WebGUI::Paths->upgrades;
+    opendir my $dh, WebGUI::Paths->upgrades
+        or die "Upgrades directory doesn't exist.\n";
     while ( my $dir = readdir $dh ) {
         next
             if $dir =~ /^\./;

lib/WebGUI/Upgrade/Script.pm

@@ -13,6 +13,7 @@ my $exporter = Sub::Exporter::build_exporter({
     },
 });
 
+my $caller_upgrade_file;
 sub import {
     my ($class, @args) = @_;
     my $extra = shift @args if ref $args[0] eq 'HASH';
@@ -22,6 +23,8 @@ sub import {
         $extra->{into_level}++;
     }
 
+    $caller_upgrade_file = (caller 0)[1];
+
     feature->import(':5.10');
     strict->import;
     warnings->import;
@@ -32,7 +35,7 @@ sub import {
 my @cleanups;
 
 sub _build_exports {
-    my $configFile = $ENV{WEBGUI_CONFIG};
+    my $configFile = $ENV{WEBGUI_CONFIG} || die 'WEBGUI_CONFIG environment variable must be specified';
     my $version    = $ENV{WEBGUI_UPGRADE_VERSION};
     my $quiet      = $ENV{WEBGUI_UPGRADE_QUIET};
 
@@ -41,6 +44,7 @@ sub _build_exports {
     my $dbh;
     my $collateral;
     my $versionTag;
+    my $upgrade_file = File::Spec->rel2abs( $caller_upgrade_file );
 
     my $subs;
 
@@ -66,7 +70,7 @@ sub _build_exports {
         quiet => sub () {
             return $quiet;
         },
-        report => sub {
+        report => sub (@) {
             print @_
                 unless $quiet;
         },
@@ -100,7 +104,7 @@ sub _build_exports {
             $dbh = WebGUI::Upgrade->dbhForConfig($subs->{config}->());
             return $dbh;
         },
-        version_tag => sub {
+        version_tag => sub (;$) {
             my $name = shift;
             $check_cleanup->();
             require WebGUI::VersionTag;
@@ -108,12 +112,13 @@ sub _build_exports {
                 if ($name) {
                     $versionTag->commit;
                 }
-                elsif ( ! $versionTag->isCommitted ) {
+                elsif ( ! $versionTag->get('isCommitted') ) {
                     return $versionTag;
                 }
             }
             if (! $name) {
-                (undef, undef, my $shortname) = File::Spec->splitpath((caller(0))[1]);
+                no warnings 'uninitialized';
+                (undef, undef, my $shortname) = File::Spec->splitpath($upgrade_file);
                 $shortname =~ s/\.[^.]*$//;
                 $name = $shortname;
             }
@@ -121,7 +126,7 @@ sub _build_exports {
             $versionTag->set({name => "Upgrade to $version - $name"});
             return $versionTag;
         },
-        rm_lib => sub {
+        rm_lib => sub (@) {
             my @modules = @_;
             for my $module (@modules) {
                 $module =~ s{::}{/}g;
@@ -135,19 +140,40 @@ sub _build_exports {
         collateral => sub () {
             return $collateral
                 if $collateral;
-            (my $vol, my $dir, my $shortname) = File::Spec->splitpath(
-                File::Spec->rel2abs( (caller(0))[1] )
-            );
+            (my $vol, my $dir, my $shortname) = File::Spec->splitpath( $upgrade_file );
             $shortname =~ s/\.[^.]*$//;
             my $path = File::Spec->catpath($vol, File::Spec->catdir($dir, $shortname), '');
             $collateral = Path::Class::Dir->new($path);
             return $collateral;
         },
-        import_package => sub {
+        import_package => sub (@) {
             my $fullPath = $subs->{collateral}->()->file(@_);
             require WebGUI::Upgrade::File::wgpkg;
             WebGUI::Upgrade::File::wgpkg->import_package($subs->{session}->(), $fullPath);
         },
+        root_asset => sub () {
+            require WebGUI::Asset;
+            return WebGUI::Asset->getRoot($subs->{session}->());
+        },
+        import_node => sub () {
+            require WebGUI::Asset;
+            return WebGUI::Asset->getImportNode($subs->{session}->());
+        },
+        asset => sub ($) {
+            require WebGUI::Asset;
+            my $session = $subs->session->();
+            my $assetId = shift;
+            my $asset;
+            if ($session->id->valid($assetId)) {
+                try {
+                    $asset = WebGUI::Asset->newById($session, $assetId);
+                };
+            }
+            if ( ! $asset ) {
+                $asset = WebGUI::Asset->newByUrl($session, $assetId);
+            }
+            return $asset;
+        },
     };
     return $subs;
 }
@@ -252,6 +278,18 @@ script with the extension stripped off.
 
 Imports the specified package from the upgrade script's collateral path.
 
+=head2 root_asset
+
+Returns the site's root asset.
+
+=head2 import_node
+
+Returns the site's import node.
+
+=head2 asset ( $assetId_or_URL )
+
+Returns an asset based on an asset ID or URL.
+
 =head1 METHODS
 
 These methods are primarily of interest to someone wrapping an upgrade script.

t/Upgrade.t

@@ -14,11 +14,6 @@ use Test::MockObject::Extends;
 use File::Temp;
 use File::Path qw(make_path);
 
-BEGIN {
-    $INC{'WebGUI.pm'} = 1;
-    $WebGUI::VERSION = '8.4.3';
-}
-
 use WebGUI::Paths;
 use WebGUI::Upgrade;
 use WebGUI::Session::Id;
@@ -37,6 +32,13 @@ our $configFile = WebGUI::Test->config->getFilename;
 
 my $upgrade = Test::MockObject::Extends->new('WebGUI::Upgrade');
 $upgrade->set_always('getCurrentVersion', '8.0.0');
+$upgrade->set_always('getCodeVersion', '8.4.3');
+
+{
+    no warnings 'redefine';
+    *WebGUI::Paths::upgrades = sub { collateral('Upgrade', 'non-existant') } ;
+}
+ok ! try { $upgrade->calcUpgradePath('8.0.0', '8.4.3'); 1 }, "calcUpgradePath dies when upgrades path doesn't exist";
 
 {
     no warnings 'redefine';
@@ -65,9 +67,11 @@ capture {
 };
 
 $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';
+SKIP: {
+    $upgrade->called_pos_ok(2, 'runUpgradeFile') || skip 'upgrade not run', 1;
+    my $upgradeFile = $upgrade->call_args_pos(2, 4);
+    ok $upgradeFile =~ /\b00_simple\.pl$/, 'correct upgrade file run';
+}
 
 $upgrade->clear;
 $upgrade->unmock('runUpgradeFile');

t/supporting_collateral/Upgrade/collateral.pl

@@ -1,3 +1,4 @@
+use WebGUI::Upgrade::Script;
 my $c = collateral;
 
 ::isa_ok $c, 'Path::Class::Dir';

t/supporting_collateral/Upgrade/config.pl

@@ -1,2 +1,3 @@
+use WebGUI::Upgrade::Script;
 ::is config->getFilename, $::configFile, 'config function works correctly';
 

t/supporting_collateral/Upgrade/dbh.pl

@@ -1,3 +1,4 @@
+use WebGUI::Upgrade::Script;
 my $totalAssets = dbh->selectrow_array('SELECT COUNT(*) FROM asset');
 ::is $totalAssets, $::totalAssets, 'dbh function working correctly';
 

t/supporting_collateral/Upgrade/die.pl

@@ -1,2 +1,3 @@
+use WebGUI::Upgrade::Script;
 die "Upgrade failure\n";
 

t/supporting_collateral/Upgrade/output.pl

@@ -1,3 +1,4 @@
+use WebGUI::Upgrade::Script;
 report 'Simple Output';
 
 done;

t/supporting_collateral/Upgrade/package.pl

@@ -1,3 +1,4 @@
+use WebGUI::Upgrade::Script;
 ::addToCleanup(version_tag);
 
 import_package('test-template.wgpkg');

t/supporting_collateral/Upgrade/rmlib.pl

@@ -1,2 +1,3 @@
+use WebGUI::Upgrade::Script;
 rm_lib 'WebGUI::Upgrade::Test::Module';
 

t/supporting_collateral/Upgrade/session.pl

@@ -1,3 +1,4 @@
+use WebGUI::Upgrade::Script;
 my $s = session;
 ::isa_ok $s, 'WebGUI::Session';
 ::is $s, session, 'session properly cached';

t/supporting_collateral/Upgrade/strict-failure.pl

@@ -1,2 +1,3 @@
+use WebGUI::Upgrade::Script;
 $variable = "value";
 

t/supporting_collateral/Upgrade/valid/8.0.0-8.4.3/00_simple.pl

@@ -1,3 +1,4 @@
+use WebGUI::Upgrade::Script;
 report "Simple Upgrade Step";
 done;
 

t/supporting_collateral/Upgrade/versiontag-implicit.pl

@@ -1,3 +1,4 @@
+use WebGUI::Upgrade::Script;
 use WebGUI::Asset;
 use WebGUI::Asset::Snippet;
 WebGUI::Asset->getRoot(session)->addChild({

t/supporting_collateral/Upgrade/versiontag.pl

@@ -1,3 +1,4 @@
+use WebGUI::Upgrade::Script;
 my $vt = version_tag;
 ::addToCleanup($vt);