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

more comments, support for txt and pod upgrade files

Browse source
This commit is contained in:
Graham Knop 2010-05-18 20:34:52 -05:00
parent 29c01ffad7
commit 8326c63c1e
9 changed files with 201 additions and 142 deletions
Download patch file Download diff file Expand all files Collapse all files

18
lib/WebGUI/Upgrade.pm
View file

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

9
lib/WebGUI/Upgrade/File.pm Normal file
View file

@ -0,0 +1,9 @@
package WebGUI::Upgrade::File;
use Moose::Role;
requires 'run';
sub once { 0 }
1;

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

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

19
lib/WebGUI/Upgrade/File/pod.pm Normal file
View file

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

17
lib/WebGUI/Upgrade/File/sql.pm
View file

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

27
lib/WebGUI/Upgrade/File/txt.pm Normal file
View file

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

35
lib/WebGUI/Upgrade/File/wgpkg.pm
View file

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

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

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

15
t/Upgrade.t
View file

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