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

lib/WebGUI/Upgrade.pm

@@ -4,67 +4,92 @@ use strict;
 use warnings;
 use WebGUI::Paths;
 use WebGUI;
-
+use Try::Tiny;
-sub upgradeSite {
+use WebGUI::Pluggable;
-    my $class = shift;
+use DBI;
-    my ($configFile) = @_;
+use WebGUI::Config;
-    my $fromVersion = '7.8.1';
-    my $steps = $class->calcUpgradePath($fromVersion);
-    for my $step ( @$steps ) {
-        $class->runUpgradeStep($configFile, $step);
-    }
-}
 
 sub upgradeSites {
     my $class = shift;
+    my $quiet = shift;
     my @configs = WebGUI::Paths->siteConfigs;
     for my $configFile (@configs) {
-        $class->upgradeSite($configFile);
+        my $bareFilename = $configFile;
+        $bareFilename =~ s{.*/}{};
+        print "Upgrading $bareFilename:\n";
+        try {
+            $class->upgradeSite($configFile, $quiet);
+        }
+        catch {
+            print "Error upgrading $bareFilename: $@\n";
+        }
+    }
+}
+
+sub upgradeSite {
+    my $class = shift;
+    my ($configFile, $quiet) = @_;
+    my $fromVersion = $class->getCurrentVersion($configFile);
+    my @steps = $class->calcUpgradePath($fromVersion, $WebGUI::Version);
+    for my $step ( @steps ) {
+        $class->runUpgradeStep($configFile, $step, $quiet);
     }
 }
 
 sub calcUpgradePath {
     my $class = shift;
-    my $fromVersion = $class->decimalize_version(shift);
+    my ($fromVersionStr, $toVersionStr) = @_;
-    my $toVersion = $class->decimalize_version('7.9.3'); #$WebGUI::VERSION);
+    my $fromVersion = $class->numericVersion($fromVersionStr);
+    my $toVersion = $class->numericVersion($toVersionStr);
 
-    my %from;
+    my %upgrades;
     opendir my $dh, WebGUI::Paths->upgrades;
     while ( my $dir = readdir $dh ) {
         next
             if $dir =~ /^\./;
         next
             unless -d File::Spec->catdir(WebGUI::Paths->upgrades, $dir);
-        if ($dir =~ /^(\d+\.\d+\.\d+)-(\d+\.\d+\.\d+)$/) {
+        if ($dir =~ /^((\d+\.\d+\.\d+)-(\d+\.\d+\.\d+))$/) {
-            $from{ $class->decimalize_version($1) }{ $class->decimalize_version($2) } = "$1-$2";
+            $upgrades{ $class->numericVersion($2) }{ $class->numericVersion($3) } = $1;
         }
     }
     closedir $dh;
 
-    my $findSteps;
+    my @steps;
-    $findSteps = sub {
+    while ( 1 ) {
-        my ($found, $steps) = @_;
+        my $atVersion = @steps ? $steps[-1][0] : $fromVersion;
-        if ($found eq $toVersion) {
+        last
-            return $steps;
+            if $atVersion eq $toVersion;
+
+        # find the available steps for the version we are at
+        my $stepsAvail = $upgrades{ $atVersion };
+        if ( $stepsAvail && %{ $stepsAvail } ) {
+            # take the lowest destination version, and remove it so it isn't considered again
+            my ($nextStep) = sort { $a <=> $b } keys %{ $stepsAvail };
+            my $dir = delete $stepsAvail->{$nextStep};
+            # add a step for that 
+            push @steps, [$nextStep, $dir];
         }
-        my $stepsAvail = $from{$found};
+        # if we don't have any steps available, the last step we tried won't work so remove it
-        for my $nextStep ( sort { $a <=> $b } keys %{ $stepsAvail } ) {
+        elsif ( @steps ) {
-            my $doneSteps = $findSteps->($nextStep, [@$steps, $stepsAvail->{$nextStep}]);
+            pop @steps;
-            return $doneSteps
-                if $doneSteps;
         }
-        return;
+        # if there is no way forward and we can't backtrack, bail out
-    };
+        else {
-    my $steps = $findSteps->($fromVersion, []);
+            die "Can't find upgrade path from $fromVersionStr to $toVersionStr.\n";
-    return $steps;
+        }
+    }
+    return map { $_->[1] } @steps;
 }
 
 sub runUpgradeStep {
     my $class = shift;
-    my ($configFile, $step) = @_;
+    my ($configFile, $step, $quiet) = @_;
-    print "Running upgrade $step\n";
+
+    my ($version) = $step =~ /-(\d+\.\d+\.\d+)$/;
+    print "Running upgrades for $step.\n";
     my $upgradesDir = File::Spec->catdir(WebGUI::Paths->upgrades, $step);
-    opendir my($dh), $upgradesDir;
+    opendir my($dh), $upgradesDir or die "Can't get upgrades for $step: $!\n";
     while ( my $upgradeFile = readdir $dh ) {
         next
             if $upgradeFile =~ /^\./;
@@ -74,18 +99,67 @@ sub runUpgradeStep {
         my ($extension) = $filename =~ /\.([^.]+)$/;
         next
             unless $extension;
-        my $sub = __PACKAGE__->can('upgrade_file_' . $extension);
+
-        if ($sub) {
+        my $package = 'WebGUI::Upgrade::File::' . $extension;
-            $class->$sub($configFile, $filename);
+        if ( try { WebGUI::Pluggable::load($package) } && $package->can('run') ) {
+            $package->run($configFile, $version, $filename, $quiet);
         }
         else {
             warn "Don't know how to use $extension upgrade file\n";
         }
     }
     closedir $dh;
+    $class->markVersionUpgrade($configFile, $version);
 }
 
-sub decimalize_version {
+sub markVersionUpgrade {
+    my $class = shift;
+    my $configFile = shift;
+    my $version = shift;
+
+    my $dbh = $class->dbhForConfig($configFile);
+
+    $dbh->do(
+        'INSERT INTO webguiVersion (webguiVersion, versionType, dateApplied) VALUES (?,?,?)', {},
+        $version, 'upgrade', time,
+    );
+}
+
+sub getCurrentVersion {
+    my $class = shift;
+    my $configFile = shift;
+    my $config = WebGUI::Config->new($configFile, 1);
+    my $dbh = $class->dbhForConfig($config);
+
+    my $sth = $dbh->prepare('SELECT webguiVersion FROM webguiVersion');
+    $sth->execute;
+    my ($version) = map { $_->[0] }
+        sort { $a->[1] <=> $b->[1] }
+        map { [ $_->[0], $class->numericVersion($_->[0]) ] }
+        @{ $sth->fetchall_arrayref( [0] ) };
+    $sth->finish;
+    return $version;
+}
+
+sub dbhForConfig {
+    my $class = shift;
+    my $config = shift;
+
+    my $dsn = $config->get('dsn');
+    my $user = $config->get('dbuser');
+    my $pass = $config->get('dbpass');
+
+    my (undef, $driver) = DBI->parse_dsn($dsn);
+    my $dbh = DBI->connect($dsn, $user, $pass, {
+        RaiseError => 1,
+        AutoCommit => 1,
+        PrintError => 0,
+        $driver eq 'mysql' ? (mysql_enable_utf8 => 1) : (),
+    });
+    return $dbh;
+}
+
+sub numericVersion {
     my $class = shift;
     my $version = shift;
     my @parts = split /\./, $version;
@@ -96,62 +170,5 @@ sub decimalize_version {
     return $decVersion;
 }
 
-sub upgrade_file_pl {
-    my $class = shift;
-    my ($configFile, $file) = @_;
-    open my $fh, '<', $file;
-    my $contents = do { local $/; <$fh> };
-    close $fh;
-    my $code = sprintf <<'END_CODE', $file, $contents;
-package WebGUI::Upgrade::Script;
-use strict;
-use warnings;
-# line 1 "%s"
-%s
-END_CODE
-    my $pid = fork;
-    if (!$pid) {
-        $WebGUI::Upgrade::Script::configFile = $configFile;
-        $WebGUI::Upgrade::Script::quiet = 0;
-        eval $code;
-        die $@ if $@;
-        exit;
-    }
-    waitpid $pid, 0;
-}
-
-sub upgrade_file_sql {
-    my $class = shift;
-    my ($configFile, $file) = @_;
-    warn "running sql script: $file\n";
-}
-
-package WebGUI::Upgrade::Script;
-
-our $configFile;
-our $config;
-our $session;
-our $quiet;
-
-sub report {
-    print @_ unless $quiet;
-}
-
-sub done {
-    print "Done.\n" unless $quiet;
-}
-
-sub session () {
-    require WebGUI::Session;
-    $session ||= WebGUI::Session->open(config());
-    return $session;
-}
-
-sub config () {
-    require WebGUI::Config;
-    $config ||= WebGUI::Config->new($configFile, 1);
-    return $config;
-}
-
 1;
 

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