WebGUI::Upgrade progress. Handles sql scripts and WebGUI packages.
This commit is contained in:
Graham Knop
parent
a46d0fbf32
commit
6411388185
4 changed files with 346 additions and 94 deletions
|
|
@ -4,67 +4,92 @@ use strict;
|
|||
use warnings;
|
||||
use WebGUI::Paths;
|
||||
use WebGUI;
|
||||
|
||||
sub upgradeSite {
|
||||
my $class = shift;
|
||||
my ($configFile) = @_;
|
||||
my $fromVersion = '7.8.1';
|
||||
my $steps = $class->calcUpgradePath($fromVersion);
|
||||
for my $step ( @$steps ) {
|
||||
$class->runUpgradeStep($configFile, $step);
|
||||
}
|
||||
}
|
||||
use Try::Tiny;
|
||||
use WebGUI::Pluggable;
|
||||
use DBI;
|
||||
use WebGUI::Config;
|
||||
|
||||
sub upgradeSites {
|
||||
my $class = shift;
|
||||
my $quiet = shift;
|
||||
my @configs = WebGUI::Paths->siteConfigs;
|
||||
for my $configFile (@configs) {
|
||||
$class->upgradeSite($configFile);
|
||||
my $bareFilename = $configFile;
|
||||
$bareFilename =~ s{.*/}{};
|
||||
print "Upgrading $bareFilename:\n";
|
||||
try {
|
||||
$class->upgradeSite($configFile, $quiet);
|
||||
}
|
||||
catch {
|
||||
print "Error upgrading $bareFilename: $@\n";
|
||||
}
|
||||
}
|
||||
}
|
||||
|
||||
sub upgradeSite {
|
||||
my $class = shift;
|
||||
my ($configFile, $quiet) = @_;
|
||||
my $fromVersion = $class->getCurrentVersion($configFile);
|
||||
my @steps = $class->calcUpgradePath($fromVersion, $WebGUI::Version);
|
||||
for my $step ( @steps ) {
|
||||
$class->runUpgradeStep($configFile, $step, $quiet);
|
||||
}
|
||||
}
|
||||
|
||||
sub calcUpgradePath {
|
||||
my $class = shift;
|
||||
my $fromVersion = $class->decimalize_version(shift);
|
||||
my $toVersion = $class->decimalize_version('7.9.3'); #$WebGUI::VERSION);
|
||||
my ($fromVersionStr, $toVersionStr) = @_;
|
||||
my $fromVersion = $class->numericVersion($fromVersionStr);
|
||||
my $toVersion = $class->numericVersion($toVersionStr);
|
||||
|
||||
my %from;
|
||||
my %upgrades;
|
||||
opendir my $dh, WebGUI::Paths->upgrades;
|
||||
while ( my $dir = readdir $dh ) {
|
||||
next
|
||||
if $dir =~ /^\./;
|
||||
next
|
||||
unless -d File::Spec->catdir(WebGUI::Paths->upgrades, $dir);
|
||||
if ($dir =~ /^(\d+\.\d+\.\d+)-(\d+\.\d+\.\d+)$/) {
|
||||
$from{ $class->decimalize_version($1) }{ $class->decimalize_version($2) } = "$1-$2";
|
||||
if ($dir =~ /^((\d+\.\d+\.\d+)-(\d+\.\d+\.\d+))$/) {
|
||||
$upgrades{ $class->numericVersion($2) }{ $class->numericVersion($3) } = $1;
|
||||
}
|
||||
}
|
||||
closedir $dh;
|
||||
|
||||
my $findSteps;
|
||||
$findSteps = sub {
|
||||
my ($found, $steps) = @_;
|
||||
if ($found eq $toVersion) {
|
||||
return $steps;
|
||||
my @steps;
|
||||
while ( 1 ) {
|
||||
my $atVersion = @steps ? $steps[-1][0] : $fromVersion;
|
||||
last
|
||||
if $atVersion eq $toVersion;
|
||||
|
||||
# find the available steps for the version we are at
|
||||
my $stepsAvail = $upgrades{ $atVersion };
|
||||
if ( $stepsAvail && %{ $stepsAvail } ) {
|
||||
# take the lowest destination version, and remove it so it isn't considered again
|
||||
my ($nextStep) = sort { $a <=> $b } keys %{ $stepsAvail };
|
||||
my $dir = delete $stepsAvail->{$nextStep};
|
||||
# add a step for that
|
||||
push @steps, [$nextStep, $dir];
|
||||
}
|
||||
my $stepsAvail = $from{$found};
|
||||
for my $nextStep ( sort { $a <=> $b } keys %{ $stepsAvail } ) {
|
||||
my $doneSteps = $findSteps->($nextStep, [@$steps, $stepsAvail->{$nextStep}]);
|
||||
return $doneSteps
|
||||
if $doneSteps;
|
||||
# if we don't have any steps available, the last step we tried won't work so remove it
|
||||
elsif ( @steps ) {
|
||||
pop @steps;
|
||||
}
|
||||
return;
|
||||
};
|
||||
my $steps = $findSteps->($fromVersion, []);
|
||||
return $steps;
|
||||
# if there is no way forward and we can't backtrack, bail out
|
||||
else {
|
||||
die "Can't find upgrade path from $fromVersionStr to $toVersionStr.\n";
|
||||
}
|
||||
}
|
||||
return map { $_->[1] } @steps;
|
||||
}
|
||||
|
||||
sub runUpgradeStep {
|
||||
my $class = shift;
|
||||
my ($configFile, $step) = @_;
|
||||
print "Running upgrade $step\n";
|
||||
my ($configFile, $step, $quiet) = @_;
|
||||
|
||||
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;
|
||||
opendir my($dh), $upgradesDir or die "Can't get upgrades for $step: $!\n";
|
||||
while ( my $upgradeFile = readdir $dh ) {
|
||||
next
|
||||
if $upgradeFile =~ /^\./;
|
||||
|
|
@ -74,18 +99,67 @@ sub runUpgradeStep {
|
|||
my ($extension) = $filename =~ /\.([^.]+)$/;
|
||||
next
|
||||
unless $extension;
|
||||
my $sub = __PACKAGE__->can('upgrade_file_' . $extension);
|
||||
if ($sub) {
|
||||
$class->$sub($configFile, $filename);
|
||||
|
||||
my $package = 'WebGUI::Upgrade::File::' . $extension;
|
||||
if ( try { WebGUI::Pluggable::load($package) } && $package->can('run') ) {
|
||||
$package->run($configFile, $version, $filename, $quiet);
|
||||
}
|
||||
else {
|
||||
warn "Don't know how to use $extension upgrade file\n";
|
||||
}
|
||||
}
|
||||
closedir $dh;
|
||||
$class->markVersionUpgrade($configFile, $version);
|
||||
}
|
||||
|
||||
sub decimalize_version {
|
||||
sub markVersionUpgrade {
|
||||
my $class = shift;
|
||||
my $configFile = shift;
|
||||
my $version = shift;
|
||||
|
||||
my $dbh = $class->dbhForConfig($configFile);
|
||||
|
||||
$dbh->do(
|
||||
'INSERT INTO webguiVersion (webguiVersion, versionType, dateApplied) VALUES (?,?,?)', {},
|
||||
$version, 'upgrade', time,
|
||||
);
|
||||
}
|
||||
|
||||
sub getCurrentVersion {
|
||||
my $class = shift;
|
||||
my $configFile = shift;
|
||||
my $config = WebGUI::Config->new($configFile, 1);
|
||||
my $dbh = $class->dbhForConfig($config);
|
||||
|
||||
my $sth = $dbh->prepare('SELECT webguiVersion FROM webguiVersion');
|
||||
$sth->execute;
|
||||
my ($version) = map { $_->[0] }
|
||||
sort { $a->[1] <=> $b->[1] }
|
||||
map { [ $_->[0], $class->numericVersion($_->[0]) ] }
|
||||
@{ $sth->fetchall_arrayref( [0] ) };
|
||||
$sth->finish;
|
||||
return $version;
|
||||
}
|
||||
|
||||
sub dbhForConfig {
|
||||
my $class = shift;
|
||||
my $config = shift;
|
||||
|
||||
my $dsn = $config->get('dsn');
|
||||
my $user = $config->get('dbuser');
|
||||
my $pass = $config->get('dbpass');
|
||||
|
||||
my (undef, $driver) = DBI->parse_dsn($dsn);
|
||||
my $dbh = DBI->connect($dsn, $user, $pass, {
|
||||
RaiseError => 1,
|
||||
AutoCommit => 1,
|
||||
PrintError => 0,
|
||||
$driver eq 'mysql' ? (mysql_enable_utf8 => 1) : (),
|
||||
});
|
||||
return $dbh;
|
||||
}
|
||||
|
||||
sub numericVersion {
|
||||
my $class = shift;
|
||||
my $version = shift;
|
||||
my @parts = split /\./, $version;
|
||||
|
|
@ -96,62 +170,5 @@ sub decimalize_version {
|
|||
return $decVersion;
|
||||
}
|
||||
|
||||
sub upgrade_file_pl {
|
||||
my $class = shift;
|
||||
my ($configFile, $file) = @_;
|
||||
open my $fh, '<', $file;
|
||||
my $contents = do { local $/; <$fh> };
|
||||
close $fh;
|
||||
my $code = sprintf <<'END_CODE', $file, $contents;
|
||||
package WebGUI::Upgrade::Script;
|
||||
use strict;
|
||||
use warnings;
|
||||
# line 1 "%s"
|
||||
%s
|
||||
END_CODE
|
||||
my $pid = fork;
|
||||
if (!$pid) {
|
||||
$WebGUI::Upgrade::Script::configFile = $configFile;
|
||||
$WebGUI::Upgrade::Script::quiet = 0;
|
||||
eval $code;
|
||||
die $@ if $@;
|
||||
exit;
|
||||
}
|
||||
waitpid $pid, 0;
|
||||
}
|
||||
|
||||
sub upgrade_file_sql {
|
||||
my $class = shift;
|
||||
my ($configFile, $file) = @_;
|
||||
warn "running sql script: $file\n";
|
||||
}
|
||||
|
||||
package WebGUI::Upgrade::Script;
|
||||
|
||||
our $configFile;
|
||||
our $config;
|
||||
our $session;
|
||||
our $quiet;
|
||||
|
||||
sub report {
|
||||
print @_ unless $quiet;
|
||||
}
|
||||
|
||||
sub done {
|
||||
print "Done.\n" unless $quiet;
|
||||
}
|
||||
|
||||
sub session () {
|
||||
require WebGUI::Session;
|
||||
$session ||= WebGUI::Session->open(config());
|
||||
return $session;
|
||||
}
|
||||
|
||||
sub config () {
|
||||
require WebGUI::Config;
|
||||
$config ||= WebGUI::Config->new($configFile, 1);
|
||||
return $config;
|
||||
}
|
||||
|
||||
1;
|
||||
|
||||
|
|
|
|||
123
lib/WebGUI/Upgrade/File/pl.pm
Normal file
123
lib/WebGUI/Upgrade/File/pl.pm
Normal file
|
|
@ -0,0 +1,123 @@
|
|||
package WebGUI::Upgrade::File::pl;
|
||||
use 5.010;
|
||||
use strict;
|
||||
use warnings;
|
||||
|
||||
use WebGUI::Upgrade;
|
||||
|
||||
sub _runCode {
|
||||
eval sprintf <<'END_CODE', $_[0], $_[1];
|
||||
use strict;
|
||||
use warnings;
|
||||
local @_;
|
||||
local $_;
|
||||
local *_runCode;
|
||||
local *run;
|
||||
# line 1 "%s"
|
||||
%s
|
||||
END_CODE
|
||||
}
|
||||
|
||||
my $configFile;
|
||||
my $quiet;
|
||||
my $version;
|
||||
my $file;
|
||||
my $session;
|
||||
my $config;
|
||||
my $dbh;
|
||||
my $versionTag;
|
||||
sub run {
|
||||
my $class = shift;
|
||||
($configFile, $version, $file, $quiet) = @_;
|
||||
($session, $config, $dbh, $versionTag) = undef;
|
||||
my $pid = fork;
|
||||
if (! $pid) {
|
||||
open my $fh, '<', $file;
|
||||
my $contents = do { local $/; <$fh> };
|
||||
close $fh;
|
||||
_runCode($file, $contents);
|
||||
if ($session) {
|
||||
require WebGUI::VersionTag;
|
||||
if (WebGUI::VersionTag->getWorking($session, 'nocreate')) {
|
||||
version_tag()->commit;
|
||||
}
|
||||
$session->var->end;
|
||||
$session->close;
|
||||
}
|
||||
die $@
|
||||
if $@;
|
||||
exit;
|
||||
}
|
||||
waitpid $pid, 0;
|
||||
if ($?) {
|
||||
die "Error processing $file\n";
|
||||
}
|
||||
}
|
||||
|
||||
sub report {
|
||||
print @_ unless $quiet;
|
||||
}
|
||||
|
||||
sub done () {
|
||||
print "Done.\n" unless $quiet;
|
||||
}
|
||||
|
||||
sub config () {
|
||||
require WebGUI::Config;
|
||||
$config ||= WebGUI::Config->new($configFile, 1);
|
||||
return $config;
|
||||
}
|
||||
|
||||
sub session () {
|
||||
return $session
|
||||
if $session;
|
||||
|
||||
require WebGUI::Session;
|
||||
$session = WebGUI::Session->open(config);
|
||||
$session->user({user => 3});
|
||||
return $session;
|
||||
}
|
||||
|
||||
sub dbh () {
|
||||
return $dbh
|
||||
if $dbh;
|
||||
|
||||
$dbh = WebGUI::Upgrade->dbhForConfig(config);
|
||||
return $dbh;
|
||||
}
|
||||
|
||||
sub version_tag {
|
||||
my $name = shift;
|
||||
require WebGUI::VersionTag;
|
||||
if ($versionTag) {
|
||||
if ($name) {
|
||||
$versionTag->commit;
|
||||
}
|
||||
else {
|
||||
return $versionTag;
|
||||
}
|
||||
}
|
||||
if (! $name) {
|
||||
(undef, undef, my $shortname) = File::Spec->splitpath($file);
|
||||
$shortname =~ s/\.[^.]*$//;
|
||||
$name = $shortname;
|
||||
}
|
||||
$versionTag = WebGUI::VersionTag->getWorking(session);
|
||||
$versionTag->set({name => "Upgrade to $version - $name"});
|
||||
return $versionTag;
|
||||
}
|
||||
|
||||
sub rm_lib {
|
||||
my @modules = @_;
|
||||
for my $module (@modules) {
|
||||
$module =~ s{::}{/}g;
|
||||
$module .= '.pm';
|
||||
for my $inc (@INC) {
|
||||
my $fullPath = File::Spec->catfile($inc, $module);
|
||||
unlink $fullPath;
|
||||
}
|
||||
}
|
||||
}
|
||||
|
||||
1;
|
||||
|
||||
46
lib/WebGUI/Upgrade/File/sql.pm
Normal file
46
lib/WebGUI/Upgrade/File/sql.pm
Normal file
|
|
@ -0,0 +1,46 @@
|
|||
package WebGUI::Upgrade::File::sql;
|
||||
use strict;
|
||||
use warnings;
|
||||
|
||||
use WebGUI::Config;
|
||||
|
||||
sub run {
|
||||
my ($class, $configFile, $version, $file, $quiet) = @_;
|
||||
|
||||
my $config = WebGUI::Config->new($configFile, 1);
|
||||
my $dsn = $config->get('dsn');
|
||||
my $username = $config->get('dbuser');
|
||||
my $password = $config->get('dbpass');
|
||||
my $database = ( split /[:;]/msx, $dsn )[2];
|
||||
my $hostname = 'localhost';
|
||||
my $port = '3306';
|
||||
while ( $dsn =~ /([^=;:]+)=([^;:]+)/msxg ) {
|
||||
if ( $1 eq 'host' || $1 eq 'hostname' ) {
|
||||
$hostname = $2;
|
||||
}
|
||||
elsif ( $1 eq 'db' || $1 eq 'database' || $1 eq 'dbname' ) {
|
||||
$database = $2;
|
||||
}
|
||||
elsif ( $1 eq 'port' ) {
|
||||
$port = $2;
|
||||
}
|
||||
}
|
||||
|
||||
my @command_line = (
|
||||
'mysql',
|
||||
'-h' . $hostname,
|
||||
'-P' . $port,
|
||||
$database,
|
||||
'-u' . $username,
|
||||
( $password ? '-p' . $password : () ),
|
||||
'--default-character-set=utf8',
|
||||
'--batch',
|
||||
'--execute=source ' . $file,
|
||||
);
|
||||
system { $command_line[0] } @command_line
|
||||
and die "$!";
|
||||
return 1;
|
||||
}
|
||||
|
||||
1;
|
||||
|
||||
66
lib/WebGUI/Upgrade/File/wgpkg.pm
Normal file
66
lib/WebGUI/Upgrade/File/wgpkg.pm
Normal file
|
|
@ -0,0 +1,66 @@
|
|||
package WebGUI::Upgrade::File::wgpkg;
|
||||
use 5.010;
|
||||
use strict;
|
||||
use warnings;
|
||||
|
||||
use WebGUI::Asset;
|
||||
use WebGUI::Session;
|
||||
use WebGUI::Storage;
|
||||
use WebGUI::VersionTag;
|
||||
use File::Spec;
|
||||
|
||||
sub run {
|
||||
my $class = shift;
|
||||
my ($configFile, $version, $file, $quiet) = @_;
|
||||
|
||||
my $session = WebGUI::Session->open($configFile);
|
||||
$session->user({user => 3});
|
||||
|
||||
# Make a storage location for the package
|
||||
my $storage = WebGUI::Storage->createTemp( $session );
|
||||
$storage->addFileFromFilesystem( $file );
|
||||
|
||||
(undef, undef, my $shortname) = File::Spec->splitpath($file);
|
||||
$shortname =~ s/\.[^.]*$//;
|
||||
|
||||
my $versionTag = WebGUI::VersionTag->getWorking($session);
|
||||
$versionTag->set({name => "Upgrade to $version - $shortname"});
|
||||
|
||||
# Import the package into the import node
|
||||
my $package = eval {
|
||||
WebGUI::Asset->getImportNode($session)->importPackage( $storage );
|
||||
};
|
||||
|
||||
$storage->delete;
|
||||
|
||||
if ($package eq 'corrupt') {
|
||||
die "Corrupt package found in $file.\n";
|
||||
}
|
||||
if ($@ || !defined $package) {
|
||||
die "Error during package import on $file: $@\n";
|
||||
}
|
||||
|
||||
# Turn off the package flag, and set the default flag for templates added
|
||||
my $assetIds = $package->getLineage( ['self','descendants'] );
|
||||
for my $assetId ( @{ $assetIds } ) {
|
||||
my $asset = WebGUI::Asset->newByDynamicClass( $session, $assetId );
|
||||
if ( !$asset ) {
|
||||
print "Couldn't instantiate asset with ID '$assetId'. Please check package '$file' for corruption.\n";
|
||||
next;
|
||||
}
|
||||
my $properties = { isPackage => 0 };
|
||||
if ($asset->isa('WebGUI::Asset::Template')) {
|
||||
$properties->{isDefault} = 1;
|
||||
}
|
||||
$asset->update( $properties );
|
||||
}
|
||||
|
||||
$versionTag->commit;
|
||||
$session->var->end;
|
||||
$session->close;
|
||||
|
||||
return 1;
|
||||
}
|
||||
|
||||
1;
|
||||
|
||||
Loading…
Add table
Add a link
Reference in a new issue