162 lines
3.2 KiB
Perl
162 lines
3.2 KiB
Perl
package WebGUI::Upgrade::File::pl;
|
|
use 5.010;
|
|
use strict;
|
|
use warnings;
|
|
|
|
use WebGUI::Upgrade ();
|
|
use WebGUI::Upgrade::File::wgpkg ();
|
|
use POSIX ();
|
|
use Path::Class::Dir ();
|
|
use Exporter qw(import);
|
|
|
|
sub _runCode {
|
|
eval sprintf <<'END_CODE', $_[0], $_[1];
|
|
package WebGUI::Upgrade::File::pl::script;
|
|
use strict;
|
|
use warnings;
|
|
local @_;
|
|
local $_;
|
|
use WebGUI::Upgrade::File::pl qw(:script);
|
|
# line 1 "%s"
|
|
%s
|
|
;
|
|
use namespace::clean;
|
|
END_CODE
|
|
}
|
|
our @EXPORT_OK = qw(
|
|
report
|
|
done
|
|
config
|
|
session
|
|
dbh
|
|
version_tag
|
|
rm_lib
|
|
collateral
|
|
import_package
|
|
);
|
|
our %EXPORT_TAGS = (
|
|
script => \@EXPORT_OK,
|
|
);
|
|
|
|
my $configFile;
|
|
my $quiet;
|
|
my $version;
|
|
my $file;
|
|
my $session;
|
|
my $config;
|
|
my $dbh;
|
|
my $collateral;
|
|
my $versionTag;
|
|
sub run {
|
|
my $class = shift;
|
|
($configFile, $version, $file, $quiet) = @_;
|
|
($session, $config, $dbh, $versionTag, $collateral) = undef;
|
|
open my $fh, '<', $file;
|
|
my $contents = do { local $/; <$fh> };
|
|
close $fh;
|
|
|
|
my @res;
|
|
if (wantarray) {
|
|
@res = _runCode($file, $contents);
|
|
}
|
|
else {
|
|
$res[0] = _runCode($file, $contents);
|
|
}
|
|
|
|
my $error = $@;
|
|
if ($session) {
|
|
require WebGUI::VersionTag;
|
|
if (WebGUI::VersionTag->getWorking($session, 'nocreate')) {
|
|
version_tag()->commit;
|
|
}
|
|
$session->var->end;
|
|
$session->close;
|
|
}
|
|
die $error
|
|
if $error;
|
|
return (wantarray ? @res : $res[0]);
|
|
}
|
|
|
|
sub report {
|
|
print @_ unless $quiet;
|
|
}
|
|
|
|
sub done () {
|
|
print "Done.\n" unless $quiet;
|
|
}
|
|
|
|
sub config () {
|
|
require WebGUI::Config;
|
|
$config ||= WebGUI::Config->new($configFile, 1);
|
|
return $config;
|
|
}
|
|
|
|
sub session () {
|
|
return $session
|
|
if $session;
|
|
|
|
require WebGUI::Session;
|
|
$session = WebGUI::Session->open(config);
|
|
$session->user({userId => 3});
|
|
return $session;
|
|
}
|
|
|
|
sub dbh () {
|
|
return $dbh
|
|
if $dbh;
|
|
|
|
$dbh = WebGUI::Upgrade->dbhForConfig(config);
|
|
return $dbh;
|
|
}
|
|
|
|
sub version_tag {
|
|
my $name = shift;
|
|
require WebGUI::VersionTag;
|
|
if ($versionTag) {
|
|
if ($name) {
|
|
$versionTag->commit;
|
|
}
|
|
else {
|
|
return $versionTag;
|
|
}
|
|
}
|
|
if (! $name) {
|
|
(undef, undef, my $shortname) = File::Spec->splitpath($file);
|
|
$shortname =~ s/\.[^.]*$//;
|
|
$name = $shortname;
|
|
}
|
|
$versionTag = WebGUI::VersionTag->getWorking(session);
|
|
$versionTag->set({name => "Upgrade to $version - $name"});
|
|
return $versionTag;
|
|
}
|
|
|
|
sub rm_lib {
|
|
my @modules = @_;
|
|
for my $module (@modules) {
|
|
$module =~ s{::}{/}g;
|
|
$module .= '.pm';
|
|
for my $inc (@INC) {
|
|
my $fullPath = File::Spec->catfile($inc, $module);
|
|
unlink $fullPath;
|
|
}
|
|
}
|
|
}
|
|
|
|
sub collateral () {
|
|
if (! $collateral) {
|
|
(my $vol, my $dir, my $shortname) = File::Spec->splitpath($file);
|
|
$shortname =~ s/\.[^.]*$//;
|
|
my $path = File::Spec->catpath($vol, File::Spec->catdir($dir, $shortname), '');
|
|
$collateral = Path::Class::Dir->new($path);
|
|
}
|
|
return $collateral;
|
|
}
|
|
|
|
sub import_package {
|
|
my $fullPath = collateral->file(@_);
|
|
require WebGUI::Upgrade::File::wgpkg;
|
|
WebGUI::Upgrade::File::wgpkg->import_package(session, $fullPath);
|
|
}
|
|
|
|
1;
|
|
|