all features implemented and basic upgrades working
This commit is contained in:
Graham Knop
parent
1a79d607af
commit
a68e6c38ca
8 changed files with 139 additions and 147 deletions
|
|
@ -8,6 +8,7 @@ use WebGUI::SQL;
|
|||
use Try::Tiny;
|
||||
use File::Spec;
|
||||
use File::Path qw(make_path);
|
||||
use POSIX qw(strftime);
|
||||
use namespace::autoclean;
|
||||
|
||||
has quiet => (
|
||||
|
|
@ -41,11 +42,14 @@ has backupPath => (
|
|||
|
||||
sub upgradeSites {
|
||||
my $self = shift;
|
||||
require Carp;
|
||||
my @configs = WebGUI::Paths->siteConfigs;
|
||||
my $i = 0;
|
||||
for my $configFile (@configs) {
|
||||
$i++;
|
||||
my $bareFilename = $configFile;
|
||||
$bareFilename =~ s{.*/}{};
|
||||
print "Upgrading $bareFilename:\n";
|
||||
print "Upgrading $bareFilename (site $i/@{[ scalar @configs ]}):\n";
|
||||
try {
|
||||
$self->upgradeSite($configFile);
|
||||
}
|
||||
|
|
@ -71,7 +75,14 @@ sub upgradeSite {
|
|||
my $dbh = $self->dbhForConfig( $configFile );
|
||||
$dbh->do('REPLACE INTO settings (name, value) VALUES (?, ?)', {}, 'upgradeState', 'started');
|
||||
}
|
||||
if (! @steps) {
|
||||
print "No upgrades needed.\n";
|
||||
}
|
||||
my $i = 0;
|
||||
for my $step ( @steps ) {
|
||||
$i++;
|
||||
print "Running upgrades for $step (step $i/@{[ scalar @steps ]}):\n";
|
||||
$self->createBackup($configFile);
|
||||
$self->runUpgradeStep($configFile, $step);
|
||||
}
|
||||
}
|
||||
|
|
@ -128,7 +139,6 @@ sub runUpgradeStep {
|
|||
my ($configFile, $step) = @_;
|
||||
|
||||
my ($version) = $step =~ /-(\d+\.\d+\.\d+)$/;
|
||||
print "Running upgrades for $step.\n";
|
||||
my $upgradesDir = File::Spec->catdir(WebGUI::Paths->upgrades, $step);
|
||||
opendir my($dh), $upgradesDir or die "Can't get upgrades for $step: $!\n";
|
||||
while ( my $upgradeFile = readdir $dh ) {
|
||||
|
|
@ -178,6 +188,9 @@ sub markVersionUpgrade {
|
|||
sub createBackup {
|
||||
my $self = shift;
|
||||
my $config = shift;
|
||||
if (! ref $config) {
|
||||
$config = WebGUI::Config->new($config, 1);
|
||||
}
|
||||
|
||||
make_path($self->backupPath);
|
||||
my $configFile = ( File::Spec->splitpath($config->pathToFile) )[2];
|
||||
|
|
@ -185,8 +198,9 @@ sub createBackup {
|
|||
$self->backupPath,
|
||||
$configFile . '_' . $self->getCurrentVersion($config) . '_' . time . '.sql',
|
||||
);
|
||||
print "Backing up to $resultFile\n";
|
||||
my @command_line = (
|
||||
$self->mysql,
|
||||
$self->mysqldump,
|
||||
$self->mysqlCommandLine($config),
|
||||
'--add-drop-table',
|
||||
'--result-file=' . $resultFile,
|
||||
|
|
@ -195,14 +209,14 @@ sub createBackup {
|
|||
and die "$!";
|
||||
}
|
||||
|
||||
sub siteHistory {
|
||||
sub reportHistory {
|
||||
my $class = shift;
|
||||
my $config = shift;
|
||||
my $dbh = $class->dbhForConfig($config);
|
||||
my $sth = $dbh->prepare('SELECT webguiVersion, dateApplies, versionType FROM webguiVersion ORDER BY dateApplied ASC, webguiVersion ASC');
|
||||
my $sth = $dbh->prepare('SELECT webguiVersion, dateApplied, versionType FROM webguiVersion ORDER BY dateApplied ASC, webguiVersion ASC');
|
||||
$sth->execute;
|
||||
while ( my @data = $sth->fetchrow_array ) {
|
||||
printf "\t%-8s %-15s %-15s\n", $data[0], POSIX::strftime('%D %T', $data[1]), $data[2];
|
||||
printf "\t%-8s %-15s %-15s\n", $data[0], strftime('%D %T', localtime $data[1]), $data[2];
|
||||
}
|
||||
$sth->finish;
|
||||
}
|
||||
|
|
@ -215,7 +229,7 @@ sub getCurrentVersion {
|
|||
my $sth = $dbh->prepare('SELECT webguiVersion FROM webguiVersion');
|
||||
$sth->execute;
|
||||
my ($version) = map { $_->[0] }
|
||||
sort { $a->[1] <=> $b->[1] }
|
||||
sort { $b->[1] <=> $a->[1] }
|
||||
map { [ $_->[0], $class->numericVersion($_->[0]) ] }
|
||||
@{ $sth->fetchall_arrayref( [0] ) };
|
||||
$sth->finish;
|
||||
|
|
@ -260,7 +274,6 @@ sub mysqlCommandLine {
|
|||
'-u' . $username,
|
||||
( $password ? '-p' . $password : () ),
|
||||
'--default-character-set=utf8',
|
||||
'--batch',
|
||||
);
|
||||
return @command_line;
|
||||
}
|
||||
|
|
|
|||
|
|
@ -7,9 +7,9 @@ use WebGUI::Upgrade::Script ();
|
|||
use Path::Class::Dir ();
|
||||
use Try::Tiny;
|
||||
use namespace::clean;
|
||||
use Class::MOP;
|
||||
use Class::MOP::Class;
|
||||
|
||||
my $namespace = 0;
|
||||
my $namespacePrefix = __PACKAGE__ . '::__ANON__::';
|
||||
sub _runScript {
|
||||
my $file = shift;
|
||||
my @res;
|
||||
|
|
@ -17,9 +17,9 @@ sub _runScript {
|
|||
{
|
||||
local $@;
|
||||
local *_;
|
||||
my $guard = WebGUI::Upgrade::Script->cleanup_guard;
|
||||
my $anon_class = Class::MOP::Class->create_anon_class;
|
||||
my $wanted = wantarray;
|
||||
eval sprintf(<<'END_CODE', $namespacePrefix . $namespace);
|
||||
eval sprintf(<<'END_CODE', $anon_class->name);
|
||||
# place this in a specific separate package to prevent namespace
|
||||
# pollution and to allow us to clean it up afterward
|
||||
package %s;
|
||||
|
|
@ -37,12 +37,6 @@ sub _runScript {
|
|||
$err = $@;
|
||||
END_CODE
|
||||
}
|
||||
{
|
||||
# delete entire namespace that script was run in
|
||||
no strict 'refs';
|
||||
delete ${ $namespacePrefix }{ $namespace . '::' };
|
||||
}
|
||||
$namespace++;
|
||||
die $err
|
||||
if $err;
|
||||
return (wantarray ? @res : $res[0]);
|
||||
|
|
|
|||
|
|
@ -6,6 +6,8 @@ use feature ();
|
|||
|
||||
use Sub::Exporter;
|
||||
use WebGUI::Upgrade ();
|
||||
use Scope::Guard;
|
||||
use Scalar::Util qw(weaken);
|
||||
|
||||
my $exporter = Sub::Exporter::build_exporter({
|
||||
groups => {
|
||||
|
|
@ -32,11 +34,11 @@ sub import {
|
|||
$class->$exporter( $extra, @args );
|
||||
}
|
||||
|
||||
my @cleanups;
|
||||
our @cleanups;
|
||||
|
||||
sub _build_exports {
|
||||
my $configFile = $ENV{WEBGUI_CONFIG} || die 'WEBGUI_CONFIG environment variable must be specified';
|
||||
my $version = $ENV{WEBGUI_UPGRADE_VERSION};
|
||||
my $version = $ENV{WEBGUI_UPGRADE_VERSION} || die 'WEBGUI_UPGRADE_VERSION must be set';
|
||||
my $quiet = $ENV{WEBGUI_UPGRADE_QUIET};
|
||||
|
||||
my $session;
|
||||
|
|
@ -46,13 +48,20 @@ sub _build_exports {
|
|||
my $versionTag;
|
||||
my $upgrade_file = $caller_upgrade_file;
|
||||
|
||||
my $subs;
|
||||
my $session_sub;
|
||||
my $config_sub;
|
||||
my $dbh_sub;
|
||||
my $collateral_sub;
|
||||
my $version_tag_sub;
|
||||
|
||||
my $run_cleanup = 0;
|
||||
my $cleanup = sub {
|
||||
return
|
||||
if $run_cleanup++;
|
||||
if ($session) {
|
||||
require WebGUI::VersionTag;
|
||||
if (WebGUI::VersionTag->getWorking($session, 'nocreate')) {
|
||||
$subs->{version_tag}->()->commit;
|
||||
$version_tag_sub->()->commit;
|
||||
}
|
||||
$session->var->end;
|
||||
$session->close;
|
||||
|
|
@ -60,13 +69,74 @@ sub _build_exports {
|
|||
undef $session;
|
||||
undef $versionTag;
|
||||
};
|
||||
my $cleanup_installed = 0;
|
||||
my $check_cleanup = sub {
|
||||
push @cleanups, $cleanup
|
||||
unless $cleanup_installed++;
|
||||
};
|
||||
my $cleanup_guard = Scope::Guard->new( $cleanup );
|
||||
|
||||
$subs = {
|
||||
push @cleanups, $cleanup;
|
||||
weaken $cleanups[-1];
|
||||
|
||||
$config_sub = sub () {
|
||||
return $config
|
||||
if $config;
|
||||
require WebGUI::Config;
|
||||
$config = WebGUI::Config->new($configFile, 1);
|
||||
return $config;
|
||||
},
|
||||
$session_sub = sub () {
|
||||
return $session
|
||||
if $session && ! $session->closed;
|
||||
|
||||
require WebGUI::Session;
|
||||
$session = WebGUI::Session->open($config_sub->());
|
||||
$session->user({userId => 3});
|
||||
return $session;
|
||||
};
|
||||
$dbh_sub = sub () {
|
||||
return $dbh
|
||||
if $dbh;
|
||||
|
||||
$dbh = WebGUI::Upgrade->dbhForConfig($config_sub->());
|
||||
return $dbh;
|
||||
};
|
||||
$version_tag_sub = sub (;$) {
|
||||
my $name = shift;
|
||||
require WebGUI::VersionTag;
|
||||
if ($versionTag) {
|
||||
if ($name) {
|
||||
$versionTag->commit;
|
||||
}
|
||||
elsif ( ! $versionTag->get('isCommitted') ) {
|
||||
return $versionTag;
|
||||
}
|
||||
}
|
||||
if (! $name) {
|
||||
no warnings 'uninitialized';
|
||||
(undef, undef, my $shortname) = File::Spec->splitpath($upgrade_file);
|
||||
$shortname =~ s/\.[^.]*$//;
|
||||
$name = $shortname;
|
||||
}
|
||||
$versionTag = WebGUI::VersionTag->getWorking($session_sub->());
|
||||
$versionTag->set({name => "Upgrade to $version - $name"});
|
||||
return $versionTag;
|
||||
};
|
||||
$collateral_sub = sub () {
|
||||
return $collateral
|
||||
if $collateral;
|
||||
(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;
|
||||
};
|
||||
return {
|
||||
config => $config_sub,
|
||||
session => $session_sub,
|
||||
dbh => $dbh_sub,
|
||||
version_tag => $version_tag_sub,
|
||||
collateral => $collateral_sub,
|
||||
|
||||
_cleanup => sub {
|
||||
undef $cleanup_guard;
|
||||
},
|
||||
quiet => sub () {
|
||||
return $quiet;
|
||||
},
|
||||
|
|
@ -78,60 +148,12 @@ sub _build_exports {
|
|||
print "Done.\n"
|
||||
unless $quiet;
|
||||
},
|
||||
config => sub () {
|
||||
return $config
|
||||
if $config;
|
||||
$check_cleanup->();
|
||||
require WebGUI::Config;
|
||||
$config = WebGUI::Config->new($configFile, 1);
|
||||
return $config;
|
||||
},
|
||||
session => sub () {
|
||||
return $session
|
||||
if $session && ! $session->closed;
|
||||
|
||||
$check_cleanup->();
|
||||
require WebGUI::Session;
|
||||
$session = WebGUI::Session->open($subs->{config}->());
|
||||
$session->user({userId => 3});
|
||||
return $session;
|
||||
},
|
||||
dbh => sub () {
|
||||
return $dbh
|
||||
if $dbh;
|
||||
|
||||
$check_cleanup->();
|
||||
$dbh = WebGUI::Upgrade->dbhForConfig($subs->{config}->());
|
||||
return $dbh;
|
||||
},
|
||||
sql => sub (@) {
|
||||
my $sql = shift;
|
||||
my $dbh = $subs->{dbh}->();
|
||||
my $dbh = $dbh_sub->();
|
||||
my $sth = $dbh->prepare($sql);
|
||||
$sth->execute(@_);
|
||||
},
|
||||
version_tag => sub (;$) {
|
||||
my $name = shift;
|
||||
$check_cleanup->();
|
||||
require WebGUI::VersionTag;
|
||||
if ($versionTag) {
|
||||
if ($name) {
|
||||
$versionTag->commit;
|
||||
}
|
||||
elsif ( ! $versionTag->get('isCommitted') ) {
|
||||
return $versionTag;
|
||||
}
|
||||
}
|
||||
if (! $name) {
|
||||
no warnings 'uninitialized';
|
||||
(undef, undef, my $shortname) = File::Spec->splitpath($upgrade_file);
|
||||
$shortname =~ s/\.[^.]*$//;
|
||||
$name = $shortname;
|
||||
}
|
||||
$versionTag = WebGUI::VersionTag->getWorking($subs->{session}->());
|
||||
$versionTag->set({name => "Upgrade to $version - $name"});
|
||||
return $versionTag;
|
||||
},
|
||||
rm_lib => sub (@) {
|
||||
my @modules = @_;
|
||||
for my $module (@modules) {
|
||||
|
|
@ -143,31 +165,22 @@ sub _build_exports {
|
|||
}
|
||||
}
|
||||
},
|
||||
collateral => sub () {
|
||||
return $collateral
|
||||
if $collateral;
|
||||
(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 (@) {
|
||||
my $fullPath = $subs->{collateral}->()->file(@_);
|
||||
my $fullPath = $collateral_sub->()->file(@_);
|
||||
require WebGUI::Upgrade::File::wgpkg;
|
||||
WebGUI::Upgrade::File::wgpkg->import_package($subs->{session}->(), $fullPath);
|
||||
WebGUI::Upgrade::File::wgpkg->import_package($session_sub->(), $fullPath);
|
||||
},
|
||||
root_asset => sub () {
|
||||
require WebGUI::Asset;
|
||||
return WebGUI::Asset->getRoot($subs->{session}->());
|
||||
return WebGUI::Asset->getRoot($session_sub->());
|
||||
},
|
||||
import_node => sub () {
|
||||
require WebGUI::Asset;
|
||||
return WebGUI::Asset->getImportNode($subs->{session}->());
|
||||
return WebGUI::Asset->getImportNode($session_sub->());
|
||||
},
|
||||
asset => sub ($) {
|
||||
require WebGUI::Asset;
|
||||
my $session = $subs->{session}->();
|
||||
my $session = $session_sub->();
|
||||
my $assetId = shift;
|
||||
my $asset;
|
||||
if ($session->id->valid($assetId)) {
|
||||
|
|
@ -181,31 +194,19 @@ sub _build_exports {
|
|||
return $asset;
|
||||
},
|
||||
clear_cache => sub () {
|
||||
my $session = $subs->{session}->();
|
||||
my $session = $session_sub->();
|
||||
my $cache = $session->cache;
|
||||
$cache->clear;
|
||||
},
|
||||
};
|
||||
return $subs;
|
||||
}
|
||||
|
||||
sub cleanup_guard {
|
||||
my $class = shift;
|
||||
my @previous_cleanups = @cleanups;
|
||||
@cleanups = ();
|
||||
return Scope::Guard->new(sub {
|
||||
$class->cleanup;
|
||||
@cleanups = @previous_cleanups;
|
||||
});
|
||||
}
|
||||
|
||||
sub cleanup {
|
||||
$_->() for @cleanups;
|
||||
@cleanups = ();
|
||||
}
|
||||
|
||||
END {
|
||||
__PACKAGE__->cleanup;
|
||||
for (@cleanups) {
|
||||
next
|
||||
unless $_;
|
||||
$_->();
|
||||
}
|
||||
}
|
||||
|
||||
1;
|
||||
|
|
@ -301,17 +302,4 @@ Returns the site's import node.
|
|||
|
||||
Returns an asset based on an asset ID or URL.
|
||||
|
||||
=head1 METHODS
|
||||
|
||||
These methods are primarily of interest to someone wrapping an upgrade script.
|
||||
|
||||
=head2 cleanup
|
||||
|
||||
Performs all needed cleanup
|
||||
|
||||
=head2 cleanup_guard
|
||||
|
||||
Returns a guard object that when destroyed will run all of the cleanup
|
||||
functions that have been added since it was created.
|
||||
|
||||
=cut
|
||||
|
|
|
|||
Loading…
Add table
Add a link
Reference in a new issue