more comments, support for txt and pod upgrade files

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

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;

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;

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;

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;

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;