From 8326c63c1e99015c1d917f1322c4b16e32060f20 Mon Sep 17 00:00:00 2001 From: Graham Knop Date: Tue, 18 May 2010 20:34:52 -0500 Subject: [PATCH] more comments, support for txt and pod upgrade files --- lib/WebGUI/Upgrade.pm | 18 +++- lib/WebGUI/Upgrade/File.pm | 9 ++ lib/WebGUI/Upgrade/File/pl.pm | 40 ++++---- lib/WebGUI/Upgrade/File/pod.pm | 19 ++++ lib/WebGUI/Upgrade/File/sql.pm | 17 ++-- lib/WebGUI/Upgrade/File/txt.pm | 27 +++++ lib/WebGUI/Upgrade/File/wgpkg.pm | 35 +++---- lib/WebGUI/Upgrade/Script.pm | 163 ++++++++++++++++--------------- t/Upgrade.t | 15 +-- 9 files changed, 201 insertions(+), 142 deletions(-) create mode 100644 lib/WebGUI/Upgrade/File.pm create mode 100644 lib/WebGUI/Upgrade/File/pod.pm create mode 100644 lib/WebGUI/Upgrade/File/txt.pm diff --git a/lib/WebGUI/Upgrade.pm b/lib/WebGUI/Upgrade.pm index 1c5f628f6..8efeac6b5 100644 --- a/lib/WebGUI/Upgrade.pm +++ b/lib/WebGUI/Upgrade.pm @@ -9,6 +9,7 @@ use Try::Tiny; use File::Spec; use File::Path qw(make_path); use POSIX qw(strftime); +use Cwd (); use namespace::autoclean; has quiet => ( @@ -39,6 +40,10 @@ has backupPath => ( is => 'rw', default => File::Spec->catdir(File::Spec->tmpdir, 'backups'), ); +has _files_run => ( + is => 'rw', + default => sub { { } }, +); sub upgradeSites { my $self = shift; @@ -155,15 +160,19 @@ sub runUpgradeStep { sub runUpgradeFile { my $self = shift; - my ($configFile, $version, $filename, $quiet) = @_; + my ($configFile, $version, $filename) = @_; + my $has_run = $self->_files_run->{ Cwd::realpath($filename) } ++; my ($extension) = $filename =~ /\.([^.]+)$/; return unless $extension; my $package = 'WebGUI::Upgrade::File::' . $extension; - if ( try { WebGUI::Pluggable::load($package) } && $package->can('run') ) { - return $package->run($configFile, $version, $filename, $self->quiet); + if ( try { WebGUI::Pluggable::load($package) } && $package->DOES('WebGUI::Upgrade::File') ) { + if ($has_run && $package->once) { + return; + } + return $package->run($self, $configFile, $version, $filename); } warn "Don't know how to use $extension upgrade file\n"; return; @@ -248,6 +257,9 @@ sub dbhForConfig { sub mysqlCommandLine { my $class = shift; my $config = shift; + if (! ref $config) { + $config = WebGUI::Config->new($config, 1); + } my $dsn = $config->get('dsn'); my $username = $config->get('dbuser'); diff --git a/lib/WebGUI/Upgrade/File.pm b/lib/WebGUI/Upgrade/File.pm new file mode 100644 index 000000000..e4e6e4936 --- /dev/null +++ b/lib/WebGUI/Upgrade/File.pm @@ -0,0 +1,9 @@ +package WebGUI::Upgrade::File; +use Moose::Role; + +requires 'run'; + +sub once { 0 } + +1; + diff --git a/lib/WebGUI/Upgrade/File/pl.pm b/lib/WebGUI/Upgrade/File/pl.pm index d6d3b1cdb..9248ba04f 100644 --- a/lib/WebGUI/Upgrade/File/pl.pm +++ b/lib/WebGUI/Upgrade/File/pl.pm @@ -1,14 +1,19 @@ package WebGUI::Upgrade::File::pl; -use 5.010; -use strict; -use warnings; - -use WebGUI::Upgrade::Script (); -use Path::Class::Dir (); -use Try::Tiny; -use namespace::clean; -use Class::MOP; +use Moose; use Class::MOP::Class; +use namespace::autoclean -also => qr/^_/; + +with 'WebGUI::Upgrade::File'; + +sub run { + my $class = shift; + my ($upgrade, $configFile, $version, $file) = @_; + + local $ENV{WEBGUI_CONFIG} = $configFile; + local $ENV{WEBGUI_UPGRADE_VERSION} = $version; + local $ENV{WEBGUI_UPGRADE_QUIET} = $upgrade->quiet; + return _runScript($file); +} sub _runScript { my $file = shift; @@ -17,11 +22,11 @@ sub _runScript { { local $@; local *_; + # use an anonymous package for this code. the namespace will + # automatically be deleted when this goes out of scope. my $anon_class = Class::MOP::Class->create_anon_class; my $wanted = wantarray; 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; # maintain context if ($wanted) { @@ -33,7 +38,7 @@ sub _runScript { else { do $file; } - # save error as soon as possible + # save error as soon as possible, before local removes it $err = $@; END_CODE } @@ -42,14 +47,5 @@ END_CODE return (wantarray ? @res : $res[0]); } -sub run { - my $class = shift; - my ($configFile, $version, $file, $quiet) = @_; - - local $ENV{WEBGUI_CONFIG} = $configFile; - local $ENV{WEBGUI_UPGRADE_VERSION} = $version; - local $ENV{WEBGUI_UPGRADE_QUIET} = $quiet; - return _runScript($file); -} - +__PACKAGE__->meta->make_immutable; 1; diff --git a/lib/WebGUI/Upgrade/File/pod.pm b/lib/WebGUI/Upgrade/File/pod.pm new file mode 100644 index 000000000..79341112f --- /dev/null +++ b/lib/WebGUI/Upgrade/File/pod.pm @@ -0,0 +1,19 @@ +package WebGUI::Upgrade::File::pod; +use Moose; +with 'WebGUI::Upgrade::File'; + +sub once { 1 } + +sub run { + my $class = shift; + my ($upgrade, $configFile, $version, $file) = @_; + if ( ! $upgrade->quiet ) { + system { $^X } $^X, '-MPod::Perldoc', '-ePod::Perldoc->run', $file; + } + + return 1; +} + +__PACKAGE__->meta->make_immutable; +1; + diff --git a/lib/WebGUI/Upgrade/File/sql.pm b/lib/WebGUI/Upgrade/File/sql.pm index c207b9856..4f1ca2068 100644 --- a/lib/WebGUI/Upgrade/File/sql.pm +++ b/lib/WebGUI/Upgrade/File/sql.pm @@ -1,17 +1,15 @@ package WebGUI::Upgrade::File::sql; -use strict; -use warnings; - -use WebGUI::Config; -use WebGUI::Upgrade; +use Moose; +with 'WebGUI::Upgrade::File'; sub run { - my ($class, $configFile, $version, $file, $quiet) = @_; + my $class = shift; + my ($upgrade, $configFile, $version, $file) = @_; - my $config = WebGUI::Config->new($configFile, 1); my @command_line = ( - 'mysql', - WebGUI::Upgrade->mysqlCommandLine($config), + $upgrade->mysql, + $upgrade->mysqlCommandLine($configFile), + '--batch', '--execute=source ' . $file, ); @@ -20,5 +18,6 @@ sub run { return 1; } +__PACKAGE__->meta->make_immutable; 1; diff --git a/lib/WebGUI/Upgrade/File/txt.pm b/lib/WebGUI/Upgrade/File/txt.pm new file mode 100644 index 000000000..fcccbb73e --- /dev/null +++ b/lib/WebGUI/Upgrade/File/txt.pm @@ -0,0 +1,27 @@ +package WebGUI::Upgrade::File::txt; +use Moose; +with 'WebGUI::Upgrade::File'; + +sub once { 1 } + +sub run { + my $class = shift; + my ($upgrade, $configFile, $version, $file) = @_; + if ( ! $upgrade->quiet ) { + open my $fh, '<', $file; + while ( my $line = <$fh> ) { + print $line; + } + close $fh; + if (-t STDIN) { + print "\nPress ENTER to continue... "; + my $nothing = <>; + } + } + + return 1; +} + +__PACKAGE__->meta->make_immutable; +1; + diff --git a/lib/WebGUI/Upgrade/File/wgpkg.pm b/lib/WebGUI/Upgrade/File/wgpkg.pm index 9eaf0c884..701c3c727 100644 --- a/lib/WebGUI/Upgrade/File/wgpkg.pm +++ b/lib/WebGUI/Upgrade/File/wgpkg.pm @@ -1,7 +1,6 @@ package WebGUI::Upgrade::File::wgpkg; -use 5.010; -use strict; -use warnings; +use Moose; +with 'WebGUI::Upgrade::File'; use WebGUI::Asset; use WebGUI::Session; @@ -9,10 +8,11 @@ use WebGUI::Storage; use WebGUI::VersionTag; use File::Spec; use Try::Tiny; +use namespace::clean; sub run { my $class = shift; - my ($configFile, $version, $file, $quiet) = @_; + my ($upgrade, $configFile, $version, $file) = @_; my $session = WebGUI::Session->open($configFile); $session->user({userId => 3}); @@ -23,6 +23,9 @@ sub run { $versionTag->set({name => "Upgrade to $version - $shortname"}); my $package = $class->import_package($session, $file); + if (! $upgrade->quiet) { + printf "\tImported '%s'\n", $package->title; + } $versionTag->commit; $session->var->end; @@ -34,8 +37,8 @@ sub run { sub import_package { my $class = shift; my ($session, $file) = @_; - # Make a storage location for the package + # Make a storage location for the package my $storage = WebGUI::Storage->createTemp( $session ); $storage->addFileFromFilesystem( $file ); @@ -47,6 +50,10 @@ sub import_package { clearPackageFlag => 1, setDefaultTemplate => 1, } ); + } + catch { + $storage->delete; + die "Error during package import on $file: $_"; }; $storage->delete; @@ -54,26 +61,10 @@ sub import_package { 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->newById( $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 ); - } return $package; } +__PACKAGE__->meta->make_immutable; 1; diff --git a/lib/WebGUI/Upgrade/Script.pm b/lib/WebGUI/Upgrade/Script.pm index c60a4a273..80d58180e 100644 --- a/lib/WebGUI/Upgrade/Script.pm +++ b/lib/WebGUI/Upgrade/Script.pm @@ -5,6 +5,7 @@ use warnings; use feature (); use Sub::Exporter; +use Sub::Name; use WebGUI::Upgrade (); use Scope::Guard; use Scalar::Util qw(weaken); @@ -25,6 +26,7 @@ sub import { $extra->{into_level}++; } + # save this in a lexical so _build_exports can pull it out $caller_upgrade_file = File::Spec->rel2abs( (caller 0)[1] ); feature->import(':5.10'); @@ -34,30 +36,71 @@ sub import { $class->$exporter( $extra, @args ); } -our @cleanups; +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 $quiet = $ENV{WEBGUI_UPGRADE_QUIET}; - - my $session; - my $config; - my $dbh; - my $collateral; - my $versionTag; + 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 $quiet = $ENV{WEBGUI_UPGRADE_QUIET}; my $upgrade_file = $caller_upgrade_file; + (my $vol, my $dir, my $shortname) = File::Spec->splitpath( $upgrade_file ); + $shortname =~ s/\.[^.]*$//; - my $session_sub; - my $config_sub; - my $dbh_sub; - my $collateral_sub; - my $version_tag_sub; + # need to be able to reference these directly in the cleanup code + my $session; + my $versionTag; + + # these subs are kept separate so the others can call them + my $config_sub = sub () { + state $config = do { + require WebGUI::Config; + WebGUI::Config->new($configFile, 1); + }; + return $config; + }; + my $session_sub = sub () { + return $session + if $session && ! $session->closed; + + require WebGUI::Session; + $session = WebGUI::Session->open($config_sub->()); + $session->user({userId => 3}); + return $session; + }; + my $version_tag_sub = sub (;$) { + my $name = shift; + require WebGUI::VersionTag; + if ($versionTag) { + if ($name) { + $versionTag->commit; + } + elsif ( ! $versionTag->get('isCommitted') ) { + return $versionTag; + } + } + $name ||= $shortname; + $versionTag = WebGUI::VersionTag->getWorking($session_sub->()); + $versionTag->set({name => "Upgrade to $version - $name"}); + return $versionTag; + }; + my $dbh_sub = sub () { + state $dbh = do { + WebGUI::Upgrade->dbhForConfig($config_sub->()); + }; + return $dbh; + }; + my $collateral_sub = sub () { + state $collateral = do { + my $path = File::Spec->catpath($vol, File::Spec->catdir($dir, $shortname), ''); + Path::Class::Dir->new($path); + }; + return $collateral; + }; - my $run_cleanup = 0; my $cleanup = sub { + state $has_run = 0; return - if $run_cleanup++; + if $has_run++; if ($session) { require WebGUI::VersionTag; if (WebGUI::VersionTag->getWorking($session, 'nocreate')) { @@ -71,72 +114,24 @@ sub _build_exports { }; my $cleanup_guard = Scope::Guard->new( $cleanup ); + # we keep a weakened copy around. this prevents us from keeping a + # copy if the guard gets freed, but otherwise allows us to call it + # manually in END. 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, - + my $subs = { + # this closes over the guard, keeping it alive until the sub is either + # run or deleted. WebGUI::Upgrade::File::pl will end up deleting + # the sub when it cleans up the temporary namespace it uses. _cleanup => sub { undef $cleanup_guard; }, + config => $config_sub, + session => $session_sub, + version_tag => $version_tag_sub, + dbh => $dbh_sub, + collateral => $collateral_sub, quiet => sub () { return $quiet; }, @@ -199,13 +194,21 @@ sub _build_exports { $cache->clear; }, }; + # give the subs some names to help with diagnostics + my $sub_package = $shortname; + $sub_package =~ s/\W//g; + for my $sub_name ( keys %$subs ) { + subname join('::', __PACKAGE__, $sub_package, $sub_name) => $subs->{$sub_name}; + } + return $subs; } END { - for (@cleanups) { + for my $cleanup (@cleanups) { + # could be a weakened ref that went away next - unless $_; - $_->(); + unless $cleanup; + $cleanup->(); } } diff --git a/t/Upgrade.t b/t/Upgrade.t index 0069aab38..68bbb0e5d 100644 --- a/t/Upgrade.t +++ b/t/Upgrade.t @@ -38,6 +38,7 @@ my $upgrade = Test::MockObject::Extends->new( ); $upgrade->set_always('getCurrentVersion', '8.0.0'); $upgrade->set_always('getCodeVersion', '8.4.3'); +$upgrade->set_true('markVersionUpgrade'); { no warnings 'redefine'; @@ -74,8 +75,8 @@ capture { $upgrade->called_pos_ok(1, 'getCurrentVersion'); $upgrade->called_pos_ok(2, 'getCodeVersion'); SKIP: { - $upgrade->called_pos_ok(3, 'runUpgradeFile') || skip 'upgrade not run', 1; - my $upgradeFile = $upgrade->call_args_pos(3, 4); + $upgrade->called_pos_ok(4, 'runUpgradeFile') || skip 'upgrade not run', 1; + my $upgradeFile = $upgrade->call_args_pos(4, 4); ok $upgradeFile =~ /\b00_simple\.pl$/, 'correct upgrade file run'; } @@ -89,14 +90,16 @@ $upgrade->mock(testUpgrade => sub { }); { - my $stdout = capture { $upgrade->testUpgrade('output.pl') }; + my $stdout = capture { eval { + $upgrade->testUpgrade('output.pl'); + } }; ok $stdout =~ 'Simple Output', 'report command functions correctly'; ok $stdout =~ 'Done', 'done command functions correctly'; } { $upgrade->quiet(1); - my $stdout = capture { $upgrade->testUpgrade('output.pl') }; + my $stdout = capture { eval { $upgrade->testUpgrade('output.pl') } }; ok $stdout !~ 'Simple Output', 'quiet flag silences report command'; ok $stdout !~ 'Done', 'quiet flag silences done command'; } @@ -166,9 +169,9 @@ END_PM } { - my $stdout = capture { + my $stdout = capture { eval { $upgrade->testUpgrade('select.sql'); - }; + } }; my @lines = split /[\r\n]+/, $stdout; my $dateApplied = $lines[1];