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

all features implemented and basic upgrades working

Browse source
This commit is contained in:
Graham Knop 2010-05-17 04:57:09 -05:00
parent 1a79d607af
commit a68e6c38ca
8 changed files with 139 additions and 147 deletions
Download patch file Download diff file Expand all files Collapse all files

29
lib/WebGUI/Upgrade.pm
View file

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

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

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

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

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

23
sbin/upgrade.pl
View file

@ -38,7 +38,11 @@ if ($help) {
);
}
elsif ($history) {
print "print site history\n";
for my $config (WebGUI::Paths->siteConfigs) {
print "$config:\n";
WebGUI::Upgrade->reportHistory($config);
print "\n";
}
exit;
}
elsif ( ! $doit ) {
@ -77,13 +81,11 @@ if ( $^O ne 'MSWin32' && $> != 0 && !$override ) {
## Globals
$| = 1;
my $upgrade = WebGUI::Upgrade->new(
quiet => $quiet,
clearCache => !$skipDelete,
createBackups => !$skipBackup,
useMaintenanceMode => !$skipMaintenance,
clearCache => ! $skipDelete,
createBackups => ! $skipBackup,
useMaintenanceMode => ! $skipMaintenance,
$mysql ? (
mysql => $mysql,
) : (),
@ -99,16 +101,9 @@ $upgrade->upgradeSites;
print <<STOP;
UPGRADES COMPLETE
Upgrades complete.
Please restart your web server and test your sites.
WARNING: If you saw any errors in the output during the upgrade, restore
your install and databases from backup immediately. Do not continue using
your site EVEN IF IT SEEMS TO WORK.
NOTE: If you have not already done so, please consult
docs/gotcha.txt for possible upgrade complications.
STOP
__END__

4
var/upgrades/7.9.8-8.0.0/addMaintenancePageToConfig.pl
View file

@ -5,9 +5,9 @@ use Cwd qw(realpath);
use File::Spec::Functions;
use WebGUI::Paths;
report "\tMoving preload files ";
report "\tMoving preload files ... ";
my $webgui_root = realpath( catdir( dirname( $INC{'WebGUI/Upgrade/Script.pm'} ), updir x 3 ) );
my $webgui_root = realpath( catdir( dirname( $INC{'WebGUI/Upgrade/Script.pm'} ), (updir) x 3 ) );
config->set('maintenancePage', catfile( $webgui_root, 'www', 'maintenance.html' );

13
var/upgrades/7.9.8-8.0.0/migrateToNewCache.pl
View file

@ -1,7 +1,7 @@
use WebGUI::Upgrade::Script;
use Module::Find;
report "\tMigrating to new cache ";
report "\tMigrating to new cache ... ";
rm_lib
findallmod('WebGUI::Cache'),
@ -22,14 +22,15 @@ config->delete('fileCacheRoot');
config->deleteFromArray('workflowActivities/None', 'WebGUI::Workflow::Activity::CleanDatabaseCache');
config->deleteFromArray('workflowActivities/None', 'WebGUI::Workflow::Activity::CleanFileCache');
sql 'DROP TABLE cache';
sql 'DROP TABLE IF EXISTS cache';
sql 'DELETE FROM WorkflowActivity WHERE className in (?,?)',
'WebGUI::Workflow::Activity::CleanDatabaseCache',
'WebGUI::Workflow::Activity::CleanFileCache',
'WebGUI::Workflow::Activity::CleanDatabaseCache',
'WebGUI::Workflow::Activity::CleanFileCache',
;
sql 'DELETE FROM WorkflowActivityData WHERE activityId IN (?,?)',
'pbwfactivity0000000002',
'pbwfactivity0000000022',
'pbwfactivity0000000002',
'pbwfactivity0000000022',
;
done;

4
var/upgrades/7.9.8-8.0.0/moveFileLocations.pl
View file

@ -5,9 +5,9 @@ use Cwd qw(realpath);
use File::Spec::Functions;
use WebGUI::Paths;
report "\tMoving preload files ";
report "\tMoving preload files ... ";
my $webgui_root = realpath( catdir( dirname( $INC{'WebGUI/Upgrade/Script.pm'} ), updir x 3 ) );
my $webgui_root = realpath( catdir( dirname( $INC{'WebGUI/Upgrade/Script.pm'} ), (updir) x 3 ) );
unlink catfile($webgui_root, 'lib', 'default.ttf');

3
var/upgrades/7.9.8-8.0.0/moveMaintenance.pl
View file

@ -1,11 +1,12 @@
use WebGUI::Upgrade::Script;
use File::Spec::Functions;
use File::Basename;
use Cwd qw(realpath);
my $webgui_root = realpath( catdir( dirname( $INC{'WebGUI/Upgrade/Script.pm'} ), (updir) x 3 ) );
report "\tMoving maintenance file ";
report "\tMoving maintenance file ... ";
unlink catfile($webgui_root, 'docs', 'maintenance.html');