From a68e6c38ca6550b90fc885fc05ad6a2050a25f57 Mon Sep 17 00:00:00 2001 From: Graham Knop Date: Mon, 17 May 2010 04:57:09 -0500 Subject: [PATCH] all features implemented and basic upgrades working --- lib/WebGUI/Upgrade.pm | 29 ++- lib/WebGUI/Upgrade/File/pl.pm | 14 +- lib/WebGUI/Upgrade/Script.pm | 196 ++++++++---------- sbin/upgrade.pl | 23 +- .../7.9.8-8.0.0/addMaintenancePageToConfig.pl | 4 +- var/upgrades/7.9.8-8.0.0/migrateToNewCache.pl | 13 +- var/upgrades/7.9.8-8.0.0/moveFileLocations.pl | 4 +- var/upgrades/7.9.8-8.0.0/moveMaintenance.pl | 3 +- 8 files changed, 139 insertions(+), 147 deletions(-) diff --git a/lib/WebGUI/Upgrade.pm b/lib/WebGUI/Upgrade.pm index 630b9bb6e..1c5f628f6 100644 --- a/lib/WebGUI/Upgrade.pm +++ b/lib/WebGUI/Upgrade.pm @@ -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; } diff --git a/lib/WebGUI/Upgrade/File/pl.pm b/lib/WebGUI/Upgrade/File/pl.pm index 23811a4be..d6d3b1cdb 100644 --- a/lib/WebGUI/Upgrade/File/pl.pm +++ b/lib/WebGUI/Upgrade/File/pl.pm @@ -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]); diff --git a/lib/WebGUI/Upgrade/Script.pm b/lib/WebGUI/Upgrade/Script.pm index 3a363445e..c60a4a273 100644 --- a/lib/WebGUI/Upgrade/Script.pm +++ b/lib/WebGUI/Upgrade/Script.pm @@ -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 diff --git a/sbin/upgrade.pl b/sbin/upgrade.pl index e6b1df752..153443b55 100755 --- a/sbin/upgrade.pl +++ b/sbin/upgrade.pl @@ -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 <set('maintenancePage', catfile( $webgui_root, 'www', 'maintenance.html' ); diff --git a/var/upgrades/7.9.8-8.0.0/migrateToNewCache.pl b/var/upgrades/7.9.8-8.0.0/migrateToNewCache.pl index b87fff16e..a47634e92 100644 --- a/var/upgrades/7.9.8-8.0.0/migrateToNewCache.pl +++ b/var/upgrades/7.9.8-8.0.0/migrateToNewCache.pl @@ -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; + diff --git a/var/upgrades/7.9.8-8.0.0/moveFileLocations.pl b/var/upgrades/7.9.8-8.0.0/moveFileLocations.pl index 2f0a72764..b39ead701 100644 --- a/var/upgrades/7.9.8-8.0.0/moveFileLocations.pl +++ b/var/upgrades/7.9.8-8.0.0/moveFileLocations.pl @@ -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'); diff --git a/var/upgrades/7.9.8-8.0.0/moveMaintenance.pl b/var/upgrades/7.9.8-8.0.0/moveMaintenance.pl index 1b0df4cdd..d16cbc5d9 100644 --- a/var/upgrades/7.9.8-8.0.0/moveMaintenance.pl +++ b/var/upgrades/7.9.8-8.0.0/moveMaintenance.pl @@ -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');