From cf92cb5a4fb258f2b7dbb70f300ba0dc5df5afa2 Mon Sep 17 00:00:00 2001
From: Graham Knop <haarg@haarg.org>
Date: Tue, 11 May 2010 20:03:01 -0500
Subject: [PATCH] more upgrade progress

---
 lib/WebGUI/Upgrade/File/pl.pm | 44 ++++++++++++++++++++---------------
 lib/WebGUI/Upgrade/Script.pm  |  4 ++--
 t/Upgrade.t                   |  7 +++---
 3 files changed, 31 insertions(+), 24 deletions(-)

diff --git a/lib/WebGUI/Upgrade/File/pl.pm b/lib/WebGUI/Upgrade/File/pl.pm
index 3de9c9f61..23811a4be 100644
--- a/lib/WebGUI/Upgrade/File/pl.pm
+++ b/lib/WebGUI/Upgrade/File/pl.pm
@@ -8,37 +8,43 @@ use Path::Class::Dir ();
 use Try::Tiny;
 use namespace::clean;
 
+my $namespace = 0;
+my $namespacePrefix = __PACKAGE__ . '::__ANON__::';
 sub _runScript {
     my $file = shift;
     my @res;
     my $err;
     {
+        local $@;
         local *_;
         my $guard = WebGUI::Upgrade::Script->cleanup_guard;
-        # place this in a specific separate package to prevent namespace
-        # pollution and to allow us to clean it up afterward
-        package
-            WebGUI::Upgrade::File::pl::script;
-        # maintain context
-        if (wantarray) {
-            @res = do $file;
-        }
-        elsif (defined wantarray) {
-            $res[0] = do $file;
-        }
-        else {
-            do $file;
-        }
-        # save error as soon as possible
-        $err = $@;
+        my $wanted = wantarray;
+        eval sprintf(<<'END_CODE', $namespacePrefix . $namespace);
+            # place this in a specific separate package to prevent namespace
+            # pollution and to allow us to clean it up afterward
+            package %s;
+            # maintain context
+            if ($wanted) {
+                @res = do $file;
+            }
+            elsif (defined $wanted) {
+                $res[0] = do $file;
+            }
+            else {
+                do $file;
+            }
+            # save error as soon as possible
+            $err = $@;
+END_CODE
     }
     {
         # delete entire namespace that script was run in
         no strict 'refs';
-        delete ${'WebGUI::Upgrade::File::pl::'}{'script::'};
+        delete ${ $namespacePrefix }{ $namespace . '::' };
     }
-    die $@
-        if $@;
+    $namespace++;
+    die $err
+        if $err;
     return (wantarray ? @res : $res[0]);
 }
 
diff --git a/lib/WebGUI/Upgrade/Script.pm b/lib/WebGUI/Upgrade/Script.pm
index 95e4b64de..9cdaadf5e 100644
--- a/lib/WebGUI/Upgrade/Script.pm
+++ b/lib/WebGUI/Upgrade/Script.pm
@@ -23,7 +23,7 @@ sub import {
         $extra->{into_level}++;
     }
 
-    $caller_upgrade_file = (caller 0)[1];
+    $caller_upgrade_file = File::Spec->rel2abs( (caller 0)[1] );
 
     feature->import(':5.10');
     strict->import;
@@ -44,7 +44,7 @@ sub _build_exports {
     my $dbh;
     my $collateral;
     my $versionTag;
-    my $upgrade_file = File::Spec->rel2abs( $caller_upgrade_file );
+    my $upgrade_file = $caller_upgrade_file;
 
     my $subs;
 
diff --git a/t/Upgrade.t b/t/Upgrade.t
index d204a096f..30b99fc76 100644
--- a/t/Upgrade.t
+++ b/t/Upgrade.t
@@ -67,9 +67,10 @@ capture {
 };
 
 $upgrade->called_pos_ok(1, 'getCurrentVersion');
+$upgrade->called_pos_ok(2, 'getCodeVersion');
 SKIP: {
-    $upgrade->called_pos_ok(2, 'runUpgradeFile') || skip 'upgrade not run', 1;
-    my $upgradeFile = $upgrade->call_args_pos(2, 4);
+    $upgrade->called_pos_ok(3, 'runUpgradeFile') || skip 'upgrade not run', 1;
+    my $upgradeFile = $upgrade->call_args_pos(3, 4);
     ok $upgradeFile =~ /\b00_simple\.pl$/, 'correct upgrade file run';
 }
 
@@ -108,7 +109,7 @@ $upgrade->testUpgrade('config.pl');
 {
     my $sId = $upgrade->testUpgrade('session.pl');
 
-    ok +WebGUI::Session::Id::valid({}, $sId), 'valid session id generated';
+    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';
 }