diff --git a/lib/WebGUI/Upgrade.pm b/lib/WebGUI/Upgrade.pm index a61ce2a38..5339da94e 100644 --- a/lib/WebGUI/Upgrade.pm +++ b/lib/WebGUI/Upgrade.pm @@ -1,3 +1,75 @@ +=head1 LEGAL + + ------------------------------------------------------------------- + WebGUI is Copyright 2001-2009 Plain Black Corporation. + ------------------------------------------------------------------- + Please read the legal notices (docs/legal.txt) and the license + (docs/license.txt) that came with this distribution before using + this software. + ------------------------------------------------------------------- + http://www.plainblack.com info@plainblack.com + ------------------------------------------------------------------- + +=head1 NAME + +WebGUI::Upgrade - Perform upgrades on WebGUI sites + +=head1 SYNOPSIS + + use WebGUI::Upgrade; + my $upgrade = WebGUI::Upgrade->new; + $upgrade->upgradeSites; + +=head1 DESCRIPTION + +This package calculates upgrade paths and performs upgrades for WebGUI sites. + +=head1 Differences from WebGUI 7's upgrade system + +In WebGUI 7 and prior, a single upgrade for each version was created +as F. This script would be +run with a command line parameter of --configFile=F. +This script contained all of the code to set up a session and do +any other work that was needed. + +To cut down on the amount of boilerplate code and allow for more +flexible upgrades, this has been changed. Multiple upgrade files +are placed in the directory F, and are +processed in alphabetical order, with the file extension determining +how to process the file. + +=head1 Supported File Types + +The file extension determines the class that will be used to process them. The class is determined by appending it to C. + +=head2 Perl Scripts - F<.pl> + +Perl scripts are processed by L, which +runs them after setting the environment variables C +and C. Usually, these scripts should use +the module L to load a number of subs to +greatly simplify how they are written. + +=head2 SQL Scripts - F<.sql> + +SQL scripts are processed by L, which +runs them with the F command line client. + +=head2 WebGUI Packages - F<.wgpkg> + +WebGUI packages are processed by L, +which imports them into the WebGUI site. + +=head2 Text and POD Documents - F<.txt>/F<.pod> + +Text and POD documents are processed by L +and L respectively. The files will be +shown to the user running the upgrade, and will wait for user +confirmation before continuing. This will only be done once per +upgrade process. + +=cut + package WebGUI::Upgrade; use 5.010; use Moose; @@ -12,39 +84,108 @@ use POSIX qw(strftime); use Cwd (); use namespace::autoclean; +=head1 ATTRIBUTES + +These attributes can be set when creating a WebGUI::Upgrade instance: + +=cut + +=head2 quiet + +Whether information about the upgrade progress will be output. Defaults to false. + +=cut + has quiet => ( is => 'rw', default => undef, ); + +=head2 mysql + +The path to the mysql command line client. Defaults to 'mysql'. + +=cut + has mysql => ( is => 'rw', default => 'mysql', ); + +=head2 mysqldump + +The path to the mysqldump command line client. Defaults to 'mysqldump'. + +=cut + has mysqldump => ( is => 'rw', default => 'mysqldump', ); + +=head2 clearCache + +If true, the cache will be cleared for each site before running +any upgrade scripts. Defaults to true. + +=cut + has clearCache => ( is => 'rw', default => 1, ); -has createBackups => ( - is => 'rw', - default => 1, -); -has useMaintenanceMode => ( - is => 'rw', - default => 1, -); + +=head2 backupPath + +The path where backups will be stored. Defaults to 'backups' inside the temp directory. + +=cut + has backupPath => ( is => 'rw', default => File::Spec->catdir(File::Spec->tmpdir, 'backups'), ); + +=head2 createBackups + +If true, backups will be created before each version upgrade for +each site. The backup files will be named +C<{config file}_{version}_{timestamp}.sql>. + +=cut + +has createBackups => ( + is => 'rw', + default => 1, +); + +=head2 useMaintenanceMode + +If set, sites will be put into maintenance mode before any upgrades +are run on them. Defaults to true. + +=cut + +has useMaintenanceMode => ( + is => 'rw', + default => 1, +); + +# this is used to store if a given upgrade file has been run yet. +# Some upgrade files should only be processed once per upgrade. has _files_run => ( is => 'rw', default => sub { { } }, ); +=head1 METHODS + +=head2 upgradeSites + +Upgrades all available sites to match the current WebGUI codebase. + +=cut + sub upgradeSites { my $self = shift; require Carp; @@ -65,11 +206,27 @@ sub upgradeSites { return 1; } +=head2 getCodeVersion + +Returns the current version of the codebase. + +=cut + sub getCodeVersion { require WebGUI; return WebGUI->VERSION; } +=head2 upgradeSite ( $config ) + +Upgrades the given config file to the current codebase. + +=head3 $config + +The path to a WebGUI config file or a WebGUI::Config instance + +=cut + sub upgradeSite { my $self = shift; my ($configFile) = @_; @@ -92,11 +249,21 @@ sub upgradeSite { } } +=head1 calcUpgradePath ( $fromVerson , $toVersion ) + +Class method to calculate the upgrade path between two versions. +Tries to find the best path between the versions by looking in +F for directories that make a path between the versions. +Returns either a list of directories to use, or throws an error if +no path can be found. + +=cut + sub calcUpgradePath { my $class = shift; my ($fromVersionStr, $toVersionStr) = @_; - my $fromVersion = $class->numericVersion($fromVersionStr); - my $toVersion = $class->numericVersion($toVersionStr); + my $fromVersion = $class->_numericVersion($fromVersionStr); + my $toVersion = $class->_numericVersion($toVersionStr); my %upgrades; opendir my $dh, WebGUI::Paths->upgrades @@ -107,7 +274,7 @@ sub calcUpgradePath { next unless -d File::Spec->catdir(WebGUI::Paths->upgrades, $dir); if ($dir =~ /^((\d+\.\d+\.\d+)-(\d+\.\d+\.\d+))$/) { - $upgrades{ $class->numericVersion($2) }{ $class->numericVersion($3) } = $1; + $upgrades{ $class->_numericVersion($2) }{ $class->_numericVersion($3) } = $1; } } closedir $dh; @@ -139,6 +306,12 @@ sub calcUpgradePath { return map { $_->[1] } @steps; } +=head2 runUpgradeStep ( $config , $step ) + +Runs the given upgrade step against the WebGUI config file. + +=cut + sub runUpgradeStep { my $self = shift; my ($configFile, $step) = @_; @@ -158,6 +331,16 @@ sub runUpgradeStep { $self->markVersionUpgrade($configFile, $version); } +=head2 runUpgradeFile ( $config , $version , $filename ) + +Runs the given upgrade file against a WebGUI config file. + +=head3 $version + +The destination version for the step this upgrade file is part of. + +=cut + sub runUpgradeFile { my $self = shift; my ($configFile, $version, $filename) = @_; @@ -169,12 +352,11 @@ sub runUpgradeFile { version => $version, file => $filename, upgrade => $self, - configFile => $configFile, ); if ($has_run && $upgrade_file->once) { return; } - $upgrade_file->run; + $upgrade_file->run($configFile); } catch { when (/^No upgrade package/) { @@ -187,6 +369,14 @@ sub runUpgradeFile { return; } +=head2 classForFile ( $file ) + +Class method to find the class to use to run the upgrade file. +Given a filename, it will either load and return a class name to +use, or throw an error if no appropriate class is available. + +=cut + sub classForFile { my $class = shift; my $file = shift; @@ -201,6 +391,12 @@ sub classForFile { die "No upgrade package for extension: $extension"; } +=head2 markVersionUpgrade ( $config , $version ) + +Marks that a given version upgrade has been completed for a config file. + +=cut + sub markVersionUpgrade { my $self = shift; my $configFile = shift; @@ -217,6 +413,12 @@ sub markVersionUpgrade { } } +=head2 createBackup ( $config ) + +Creates a database backup file for a given config file. + +=cut + sub createBackup { my $self = shift; my $config = shift; @@ -241,6 +443,12 @@ sub createBackup { and die "$!"; } +=head2 reportHistory ( $config ) + +Class method to return the upgrade history for a given config file. + +=cut + sub reportHistory { my $class = shift; my $config = shift; @@ -253,6 +461,12 @@ sub reportHistory { $sth->finish; } +=head2 getCurrentVersion ( $config ) + +Class method that returns the current version of a WebGUI database. + +=cut + sub getCurrentVersion { my $class = shift; my $configFile = shift; @@ -262,12 +476,18 @@ sub getCurrentVersion { $sth->execute; my ($version) = map { $_->[0] } sort { $b->[1] <=> $a->[1] } - map { [ $_->[0], $class->numericVersion($_->[0]) ] } + map { [ $_->[0], $class->_numericVersion($_->[0]) ] } @{ $sth->fetchall_arrayref( [0] ) }; $sth->finish; return $version; } +=head2 dbhForConfig ( $config ) + +Class method that creates a new WebGUI::SQL object given a config file. + +=cut + sub dbhForConfig { my $class = shift; my $config = shift; @@ -277,6 +497,14 @@ sub dbhForConfig { return WebGUI::SQL->connect($config); } +=head2 mysqlCommandLine ( $config ) + +Class method to return a list of options to pass to the mysql or +mysqldump command line client to connect to the given config file's +database. + +=cut + sub mysqlCommandLine { my $class = shift; my $config = shift; @@ -313,7 +541,9 @@ sub mysqlCommandLine { return @command_line; } -sub numericVersion { +# converts a period separated version number into a form that can +# be compared numerically. +sub _numericVersion { my $class = shift; my $version = shift; my @parts = split /\./, $version; diff --git a/lib/WebGUI/Upgrade/File.pm b/lib/WebGUI/Upgrade/File.pm index 5da104bb2..2b9b8c12a 100644 --- a/lib/WebGUI/Upgrade/File.pm +++ b/lib/WebGUI/Upgrade/File.pm @@ -1,16 +1,100 @@ +=head1 LEGAL + + ------------------------------------------------------------------- + WebGUI is Copyright 2001-2009 Plain Black Corporation. + ------------------------------------------------------------------- + Please read the legal notices (docs/legal.txt) and the license + (docs/license.txt) that came with this distribution before using + this software. + ------------------------------------------------------------------- + http://www.plainblack.com info@plainblack.com + ------------------------------------------------------------------- + +=head1 NAME + +WebGUI::Upgrade::File - Role for upgrade file classes + +=head1 SYNOPSIS + + package WebGUI::Upgrade::File::ext; + with 'WebGUI::Upgrade::File'; + + sub run { + my $self = shift; + print "Running " . $self->file . "\n"; + } + +=head1 DESCRIPTION + +To be consumed by classes for running upgrade scripts. + +=cut + package WebGUI::Upgrade::File; +use 5.010; use Moose::Role; +=head1 REQUIRED METHODS + +Classes consuming this role must implement the following methods: + +=head2 run + +This method much be implemented and should run the actual upgrade file on the config file. + +=cut + requires 'run'; -has file => ( is => 'ro' ); -has configFile => ( is => 'ro' ); -has version => ( is => 'ro' ); -has upgrade => ( - is => 'ro', - handles => [ 'quiet' ], +=head1 ATTRIBUTES + +This role includes the following attributes. + +=cut + +=head2 file + +The upgrade file to run. + +=cut + +has file => ( + is => 'ro', + required => 1, ); +=head2 version + +The version the upgrade is for. + +=cut + +has version => ( + is => 'ro', + required => 1, +); + +=head2 upgrade + +The WebGUI::Upgrade object to use for this upgrade. + +=cut + +has upgrade => ( + is => 'ro', + required => 1, + handles => [ 'quiet' ], +); + +=head1 METHODS + +=head2 once + +A method to be overridden that controls if the upgrade file should +be run more than once per server. + +=cut + sub once { 0 } 1; diff --git a/lib/WebGUI/Upgrade/File/pl.pm b/lib/WebGUI/Upgrade/File/pl.pm index f4b9230db..afb704cd7 100644 --- a/lib/WebGUI/Upgrade/File/pl.pm +++ b/lib/WebGUI/Upgrade/File/pl.pm @@ -1,3 +1,21 @@ +=head1 LEGAL + + ------------------------------------------------------------------- + WebGUI is Copyright 2001-2009 Plain Black Corporation. + ------------------------------------------------------------------- + Please read the legal notices (docs/legal.txt) and the license + (docs/license.txt) that came with this distribution before using + this software. + ------------------------------------------------------------------- + http://www.plainblack.com info@plainblack.com + ------------------------------------------------------------------- + +=head1 NAME + +WebGUI::Upgrade::File::pl - Upgrade class for Perl scripts + +=cut + package WebGUI::Upgrade::File::pl; use Moose; use Class::MOP::Class; @@ -7,8 +25,9 @@ with 'WebGUI::Upgrade::File'; sub run { my $self = shift; + my $configFile = shift; - local $ENV{WEBGUI_CONFIG} = $self->configFile; + local $ENV{WEBGUI_CONFIG} = $configFile; local $ENV{WEBGUI_UPGRADE_VERSION} = $self->version; local $ENV{WEBGUI_UPGRADE_QUIET} = $self->quiet; return _runScript($self->file); diff --git a/lib/WebGUI/Upgrade/File/pod.pm b/lib/WebGUI/Upgrade/File/pod.pm index 3ace8ccd9..3861688b0 100644 --- a/lib/WebGUI/Upgrade/File/pod.pm +++ b/lib/WebGUI/Upgrade/File/pod.pm @@ -1,13 +1,40 @@ +=head1 LEGAL + + ------------------------------------------------------------------- + WebGUI is Copyright 2001-2009 Plain Black Corporation. + ------------------------------------------------------------------- + Please read the legal notices (docs/legal.txt) and the license + (docs/license.txt) that came with this distribution before using + this software. + ------------------------------------------------------------------- + http://www.plainblack.com info@plainblack.com + ------------------------------------------------------------------- + +=head1 NAME + +WebGUI::Upgrade::File::pod - Upgrade class for POD documents + +=cut + package WebGUI::Upgrade::File::pod; use Moose; +use POSIX qw(_exit); with 'WebGUI::Upgrade::File'; sub once { 1 } sub run { my $self = shift; + my $configFile = shift; if ( ! $self->quiet ) { - system { $^X } $^X, '-MPod::Perldoc', '-ePod::Perldoc->run', $self->file; + my $pid = fork; + if (! $pid) { + require Pod::Perldoc; + @ARGV = ($self->file); + Pod::Perldoc->run; + _exit; + } + waitpid $pid, 0; } return 1; diff --git a/lib/WebGUI/Upgrade/File/sql.pm b/lib/WebGUI/Upgrade/File/sql.pm index 1a495263b..856f9a2ff 100644 --- a/lib/WebGUI/Upgrade/File/sql.pm +++ b/lib/WebGUI/Upgrade/File/sql.pm @@ -1,13 +1,32 @@ +=head1 LEGAL + + ------------------------------------------------------------------- + WebGUI is Copyright 2001-2009 Plain Black Corporation. + ------------------------------------------------------------------- + Please read the legal notices (docs/legal.txt) and the license + (docs/license.txt) that came with this distribution before using + this software. + ------------------------------------------------------------------- + http://www.plainblack.com info@plainblack.com + ------------------------------------------------------------------- + +=head1 NAME + +WebGUI::Upgrade::File::sql - Upgrade class for SQL scripts + +=cut + package WebGUI::Upgrade::File::sql; use Moose; with 'WebGUI::Upgrade::File'; sub run { my $self = shift; + my $configFile = shift; my @command_line = ( $self->upgrade->mysql, - $self->upgrade->mysqlCommandLine($self->configFile), + $self->upgrade->mysqlCommandLine($configFile), '--batch', '--execute=source ' . $self->file, ); diff --git a/lib/WebGUI/Upgrade/File/txt.pm b/lib/WebGUI/Upgrade/File/txt.pm index 95e1ef8c5..7792fc471 100644 --- a/lib/WebGUI/Upgrade/File/txt.pm +++ b/lib/WebGUI/Upgrade/File/txt.pm @@ -1,3 +1,21 @@ +=head1 LEGAL + + ------------------------------------------------------------------- + WebGUI is Copyright 2001-2009 Plain Black Corporation. + ------------------------------------------------------------------- + Please read the legal notices (docs/legal.txt) and the license + (docs/license.txt) that came with this distribution before using + this software. + ------------------------------------------------------------------- + http://www.plainblack.com info@plainblack.com + ------------------------------------------------------------------- + +=head1 NAME + +WebGUI::Upgrade::File::txt - Upgrade class for text documents + +=cut + package WebGUI::Upgrade::File::txt; use Moose; with 'WebGUI::Upgrade::File'; @@ -6,13 +24,14 @@ sub once { 1 } sub run { my $self = shift; + my $configFile = shift; if ( ! $self->quiet ) { open my $fh, '<', $self->file; while ( my $line = <$fh> ) { print $line; } close $fh; - if (-t STDIN) { + if (-t) { print "\nPress ENTER to continue... "; my $nothing = <>; } diff --git a/lib/WebGUI/Upgrade/File/wgpkg.pm b/lib/WebGUI/Upgrade/File/wgpkg.pm index d58143be9..309c1cba4 100644 --- a/lib/WebGUI/Upgrade/File/wgpkg.pm +++ b/lib/WebGUI/Upgrade/File/wgpkg.pm @@ -1,3 +1,21 @@ +=head1 LEGAL + + ------------------------------------------------------------------- + WebGUI is Copyright 2001-2009 Plain Black Corporation. + ------------------------------------------------------------------- + Please read the legal notices (docs/legal.txt) and the license + (docs/license.txt) that came with this distribution before using + this software. + ------------------------------------------------------------------- + http://www.plainblack.com info@plainblack.com + ------------------------------------------------------------------- + +=head1 NAME + +WebGUI::Upgrade::File::wgpkg - Upgrade class for WebGUI packages + +=cut + package WebGUI::Upgrade::File::wgpkg; use Moose; with 'WebGUI::Upgrade::File'; diff --git a/lib/WebGUI/Upgrade/Script.pm b/lib/WebGUI/Upgrade/Script.pm index 80d58180e..cae2a485d 100644 --- a/lib/WebGUI/Upgrade/Script.pm +++ b/lib/WebGUI/Upgrade/Script.pm @@ -39,8 +39,10 @@ sub import { my @cleanups; sub _build_exports { - my $configFile = $ENV{WEBGUI_CONFIG} || die 'WEBGUI_CONFIG environment variable must be specified'; - my $version = $ENV{WEBGUI_UPGRADE_VERSION} || die 'WEBGUI_UPGRADE_VERSION must be set'; + my $configFile = $ENV{WEBGUI_CONFIG} + or die 'WEBGUI_CONFIG environment variable must be specified'; + my $version = $ENV{WEBGUI_UPGRADE_VERSION} + or die 'WEBGUI_UPGRADE_VERSION must be set'; my $quiet = $ENV{WEBGUI_UPGRADE_QUIET}; my $upgrade_file = $caller_upgrade_file; (my $vol, my $dir, my $shortname) = File::Spec->splitpath( $upgrade_file ); @@ -216,35 +218,58 @@ END { __END__ +=head1 LEGAL + + ------------------------------------------------------------------- + WebGUI is Copyright 2001-2009 Plain Black Corporation. + ------------------------------------------------------------------- + Please read the legal notices (docs/legal.txt) and the license + (docs/license.txt) that came with this distribution before using + this software. + ------------------------------------------------------------------- + http://www.plainblack.com info@plainblack.com + ------------------------------------------------------------------- + =head1 NAME -WebGUI::Upgrade::Script - Functions for WebGUI upgrade scripts +WebGUI::Upgrade::Script - Utility package for WebGUI upgrade scripts =head1 SYNOPSIS use WebGUI::Upgrade::Script; - report "Performing upgrade..."; + + print "Adding new snippet.\n"; + import_node->addChild({ className => 'WebGUI::Asset::Snippet', title => 'New Snippet'}); config->set('config/item', 'new value'); done; =head1 DESCRIPTION -This module exports a number of functions to simplify upgrade scripts. The -WEBGUI_CONFIG, WEBGUI_UPGRADE_VERSION, and WEBGUI_UPGRADE_QUIET variables -will be used to set up the subs. +This is a package to be used in upgrade scripts to provide a number +of functions and automatic cleanup to make writing upgrade scripts +faster and simpler. -In addition to the upgrade subs, it has a number of methods available to -code that is wrapping an upgrade script. +Cing this module will also enable strictures, warnings, and +all of Perl 5.10's syntax enhancements in the caller. -Some cleanup needs to be done after running an upgrade script. This will -be done on program exit by default, but can also be managed manually with -the methods. +=head1 ENVIRONMENT + +This package will use the following environment variables to determine +its operation. These variables are automatically set by +L if run through the main upgrade system. + +=head2 WEBGUI_CONFIG + +The WebGUI config file to operate against. + +=head2 WEBGUI_UPGRADE_VERSION + +The version being upgraded to. =head1 EXPORTED SUBROUTINES -=head2 quiet - -Returns the value of the quiet flag. +These subroutines are all exported by default using L. +They cannot be called directly. =head2 report ( $message ) @@ -285,7 +310,7 @@ paths. =head2 collateral -Returns a Path::Class::Dir object for the upgrade script's collateral +Returns a L object for the upgrade script's collateral path. The collateral path is the same as the name of the upgrade script with the extension stripped off.