From adf3dbbe0497a2ecb1553dcbab8977bc1bf076a2 Mon Sep 17 00:00:00 2001
From: Graham Knop <haarg@haarg.org>
Date: Mon, 10 May 2010 16:58:56 -0500
Subject: [PATCH] more upgrades progress

---
 lib/WebGUI/Session.pm                         |  6 ++
 lib/WebGUI/Upgrade.pm                         | 18 ++++--
 lib/WebGUI/Upgrade/Script.pm                  | 58 +++++++++++++++----
 t/Upgrade.t                                   | 20 ++++---
 t/supporting_collateral/Upgrade/collateral.pl |  1 +
 t/supporting_collateral/Upgrade/config.pl     |  1 +
 t/supporting_collateral/Upgrade/dbh.pl        |  1 +
 t/supporting_collateral/Upgrade/die.pl        |  1 +
 .../Upgrade/impossible/.exists                |  0
 t/supporting_collateral/Upgrade/output.pl     |  1 +
 t/supporting_collateral/Upgrade/package.pl    |  1 +
 t/supporting_collateral/Upgrade/rmlib.pl      |  1 +
 t/supporting_collateral/Upgrade/session.pl    |  1 +
 .../Upgrade/strict-failure.pl                 |  1 +
 .../{8.0.0-8.4.0 => 8.0.0-8.4.3}/00_simple.pl |  1 +
 .../Upgrade/versiontag-implicit.pl            |  1 +
 t/supporting_collateral/Upgrade/versiontag.pl |  1 +
 17 files changed, 90 insertions(+), 24 deletions(-)
 create mode 100644 t/supporting_collateral/Upgrade/impossible/.exists
 rename t/supporting_collateral/Upgrade/valid/{8.0.0-8.4.0 => 8.0.0-8.4.3}/00_simple.pl (56%)

diff --git a/lib/WebGUI/Session.pm b/lib/WebGUI/Session.pm
index ffe0b4002..a06705e0f 100644
--- a/lib/WebGUI/Session.pm
+++ b/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};
 }
 
 #-------------------------------------------------------------------
diff --git a/lib/WebGUI/Upgrade.pm b/lib/WebGUI/Upgrade.pm
index 15b43830c..e24b997e4 100644
--- a/lib/WebGUI/Upgrade.pm
+++ b/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 =~ /^\./;
diff --git a/lib/WebGUI/Upgrade/Script.pm b/lib/WebGUI/Upgrade/Script.pm
index 081771545..95e4b64de 100644
--- a/lib/WebGUI/Upgrade/Script.pm
+++ b/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.
diff --git a/t/Upgrade.t b/t/Upgrade.t
index 194f95b2b..d204a096f 100644
--- a/t/Upgrade.t
+++ b/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');
diff --git a/t/supporting_collateral/Upgrade/collateral.pl b/t/supporting_collateral/Upgrade/collateral.pl
index 2552acf96..64fe4cbc8 100644
--- a/t/supporting_collateral/Upgrade/collateral.pl
+++ b/t/supporting_collateral/Upgrade/collateral.pl
@@ -1,3 +1,4 @@
+use WebGUI::Upgrade::Script;
 my $c = collateral;
 
 ::isa_ok $c, 'Path::Class::Dir';
diff --git a/t/supporting_collateral/Upgrade/config.pl b/t/supporting_collateral/Upgrade/config.pl
index 846e7fb9f..386d01a1e 100644
--- a/t/supporting_collateral/Upgrade/config.pl
+++ b/t/supporting_collateral/Upgrade/config.pl
@@ -1,2 +1,3 @@
+use WebGUI::Upgrade::Script;
 ::is config->getFilename, $::configFile, 'config function works correctly';
 
diff --git a/t/supporting_collateral/Upgrade/dbh.pl b/t/supporting_collateral/Upgrade/dbh.pl
index 34a54c466..845c83d28 100644
--- a/t/supporting_collateral/Upgrade/dbh.pl
+++ b/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';
 
diff --git a/t/supporting_collateral/Upgrade/die.pl b/t/supporting_collateral/Upgrade/die.pl
index ce963ef7a..b80fa51c3 100644
--- a/t/supporting_collateral/Upgrade/die.pl
+++ b/t/supporting_collateral/Upgrade/die.pl
@@ -1,2 +1,3 @@
+use WebGUI::Upgrade::Script;
 die "Upgrade failure\n";
 
diff --git a/t/supporting_collateral/Upgrade/impossible/.exists b/t/supporting_collateral/Upgrade/impossible/.exists
new file mode 100644
index 000000000..e69de29bb
diff --git a/t/supporting_collateral/Upgrade/output.pl b/t/supporting_collateral/Upgrade/output.pl
index e995ae381..02363c47a 100644
--- a/t/supporting_collateral/Upgrade/output.pl
+++ b/t/supporting_collateral/Upgrade/output.pl
@@ -1,3 +1,4 @@
+use WebGUI::Upgrade::Script;
 report 'Simple Output';
 
 done;
diff --git a/t/supporting_collateral/Upgrade/package.pl b/t/supporting_collateral/Upgrade/package.pl
index 17124ab62..e5d483fd1 100644
--- a/t/supporting_collateral/Upgrade/package.pl
+++ b/t/supporting_collateral/Upgrade/package.pl
@@ -1,3 +1,4 @@
+use WebGUI::Upgrade::Script;
 ::addToCleanup(version_tag);
 
 import_package('test-template.wgpkg');
diff --git a/t/supporting_collateral/Upgrade/rmlib.pl b/t/supporting_collateral/Upgrade/rmlib.pl
index 0d7b55a78..e01fa9bdb 100644
--- a/t/supporting_collateral/Upgrade/rmlib.pl
+++ b/t/supporting_collateral/Upgrade/rmlib.pl
@@ -1,2 +1,3 @@
+use WebGUI::Upgrade::Script;
 rm_lib 'WebGUI::Upgrade::Test::Module';
 
diff --git a/t/supporting_collateral/Upgrade/session.pl b/t/supporting_collateral/Upgrade/session.pl
index b62b121d5..fc9bf6484 100644
--- a/t/supporting_collateral/Upgrade/session.pl
+++ b/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';
diff --git a/t/supporting_collateral/Upgrade/strict-failure.pl b/t/supporting_collateral/Upgrade/strict-failure.pl
index 0f945936c..7081bb295 100644
--- a/t/supporting_collateral/Upgrade/strict-failure.pl
+++ b/t/supporting_collateral/Upgrade/strict-failure.pl
@@ -1,2 +1,3 @@
+use WebGUI::Upgrade::Script;
 $variable = "value";
 
diff --git a/t/supporting_collateral/Upgrade/valid/8.0.0-8.4.0/00_simple.pl b/t/supporting_collateral/Upgrade/valid/8.0.0-8.4.3/00_simple.pl
similarity index 56%
rename from t/supporting_collateral/Upgrade/valid/8.0.0-8.4.0/00_simple.pl
rename to t/supporting_collateral/Upgrade/valid/8.0.0-8.4.3/00_simple.pl
index dfdfe65fb..8a20e5538 100644
--- a/t/supporting_collateral/Upgrade/valid/8.0.0-8.4.0/00_simple.pl
+++ b/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;
 
diff --git a/t/supporting_collateral/Upgrade/versiontag-implicit.pl b/t/supporting_collateral/Upgrade/versiontag-implicit.pl
index 9144b2d7d..cddcf0cda 100644
--- a/t/supporting_collateral/Upgrade/versiontag-implicit.pl
+++ b/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({
diff --git a/t/supporting_collateral/Upgrade/versiontag.pl b/t/supporting_collateral/Upgrade/versiontag.pl
index 48d305ffa..9277a9757 100644
--- a/t/supporting_collateral/Upgrade/versiontag.pl
+++ b/t/supporting_collateral/Upgrade/versiontag.pl
@@ -1,3 +1,4 @@
+use WebGUI::Upgrade::Script;
 my $vt = version_tag;
 ::addToCleanup($vt);