WebGUI::Upgrade progress. Handles sql scripts and WebGUI packages.

lib/WebGUI/Upgrade/File/pl.pm

@@ -0,0 +1,123 @@
+package WebGUI::Upgrade::File::pl;
+use 5.010;
+use strict;
+use warnings;
+
+use WebGUI::Upgrade;
+
+sub _runCode {
+    eval sprintf <<'END_CODE', $_[0], $_[1];
+use strict;
+use warnings;
+local @_;
+local $_;
+local *_runCode;
+local *run;
+# line 1 "%s"
+%s
+END_CODE
+}
+
+my $configFile;
+my $quiet;
+my $version;
+my $file;
+my $session;
+my $config;
+my $dbh;
+my $versionTag;
+sub run {
+    my $class = shift;
+    ($configFile, $version, $file, $quiet) = @_;
+    ($session, $config, $dbh, $versionTag) = undef;
+    my $pid = fork;
+    if (! $pid) {
+        open my $fh, '<', $file;
+        my $contents = do { local $/; <$fh> };
+        close $fh;
+        _runCode($file, $contents);
+        if ($session) {
+            require WebGUI::VersionTag;
+            if (WebGUI::VersionTag->getWorking($session, 'nocreate')) {
+                version_tag()->commit;
+            }
+            $session->var->end;
+            $session->close;
+        }
+        die $@
+            if $@;
+        exit;
+    }
+    waitpid $pid, 0;
+    if ($?) {
+        die "Error processing $file\n";
+    }
+}
+
+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({user => 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;
+        }
+    }
+}
+
+1;
+

lib/WebGUI/Upgrade/File/sql.pm

@@ -0,0 +1,46 @@
+package WebGUI::Upgrade::File::sql;
+use strict;
+use warnings;
+
+use WebGUI::Config;
+
+sub run {
+    my ($class, $configFile, $version, $file, $quiet) = @_;
+
+    my $config = WebGUI::Config->new($configFile, 1);
+    my $dsn = $config->get('dsn');
+    my $username = $config->get('dbuser');
+    my $password = $config->get('dbpass');
+    my $database = ( split /[:;]/msx, $dsn )[2];
+    my $hostname = 'localhost';
+    my $port = '3306';
+    while ( $dsn =~ /([^=;:]+)=([^;:]+)/msxg ) {
+        if ( $1 eq 'host' || $1 eq 'hostname' ) {
+            $hostname = $2;
+        }
+        elsif ( $1 eq 'db' || $1 eq 'database' || $1 eq 'dbname' ) {
+            $database = $2;
+        }
+        elsif ( $1 eq 'port' ) {
+            $port = $2;
+        }
+    }
+
+    my @command_line = (
+        'mysql',
+        '-h' . $hostname,
+        '-P' . $port,
+        $database,
+        '-u' . $username,
+        ( $password ? '-p' . $password : () ),
+        '--default-character-set=utf8',
+        '--batch',
+        '--execute=source ' . $file,
+    );
+    system { $command_line[0] } @command_line
+        and die "$!";
+    return 1;
+}
+
+1;
+

lib/WebGUI/Upgrade/File/wgpkg.pm

@@ -0,0 +1,66 @@
+package WebGUI::Upgrade::File::wgpkg;
+use 5.010;
+use strict;
+use warnings;
+
+use WebGUI::Asset;
+use WebGUI::Session;
+use WebGUI::Storage;
+use WebGUI::VersionTag;
+use File::Spec;
+
+sub run {
+    my $class = shift;
+    my ($configFile, $version, $file, $quiet) = @_;
+
+    my $session = WebGUI::Session->open($configFile);
+    $session->user({user => 3});
+
+    # Make a storage location for the package
+    my $storage = WebGUI::Storage->createTemp( $session );
+    $storage->addFileFromFilesystem( $file );
+
+    (undef, undef, my $shortname) = File::Spec->splitpath($file);
+    $shortname =~ s/\.[^.]*$//;
+
+    my $versionTag = WebGUI::VersionTag->getWorking($session);
+    $versionTag->set({name => "Upgrade to $version - $shortname"});
+
+    # Import the package into the import node
+    my $package = eval {
+        WebGUI::Asset->getImportNode($session)->importPackage( $storage );
+    };
+
+    $storage->delete;
+
+    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->newByDynamicClass( $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 );
+    }
+
+    $versionTag->commit;
+    $session->var->end;
+    $session->close;
+
+    return 1;
+}
+
+1;
+