more comments, support for txt and pod upgrade files
This commit is contained in:
parent
29c01ffad7
commit
8326c63c1e
9 changed files with 201 additions and 142 deletions
|
|
@ -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
19
lib/WebGUI/Upgrade/File/pod.pm
Normal 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;
|
||||
|
||||
|
|
@ -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
27
lib/WebGUI/Upgrade/File/txt.pm
Normal 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;
|
||||
|
||||
|
|
@ -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;
|
||||
|
||||
|
|
|
|||
Loading…
Add table
Add a link
Reference in a new issue