oqapi/webgui
2
0
Fork 0
Code Issues Pull requests Projects Releases Packages Wiki Activity Actions

more upgrade progress

Browse source
This commit is contained in:
Graham Knop 2010-05-11 20:03:01 -05:00
parent adf3dbbe04
commit cf92cb5a4f
3 changed files with 31 additions and 24 deletions
Download patch file Download diff file Expand all files Collapse all files

44
lib/WebGUI/Upgrade/File/pl.pm
View file

@ -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]);
}

4
lib/WebGUI/Upgrade/Script.pm
View file

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

7
t/Upgrade.t
View file

@ -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';
}