From c4bdf43eb34fa8e659787b92f3f859424160bb8b Mon Sep 17 00:00:00 2001
From: Olli-Antti Kivilahti <olli-antti.kivilahti@jns.fi>
Date: Fri, 17 Mar 2017 07:34:52 +0200
Subject: [PATCH 4/5] Bug 14698: AtomicUpdater - Bindings to updatedatabase.pl

Instead of every time we execute updatedatabase.pl, we deploy AtomicUpdates smartly.

Also tries it's best to parse the bug number from the updatedatabase.pl-entries
and checks if that bug has already been applied via AtomicUpdater to prevent
adding same DB changes twice.
---
 installer/data/mysql/updatedatabase.pl | 108 +++++++++++++++++++++----
 1 file changed, 93 insertions(+), 15 deletions(-)

diff --git a/installer/data/mysql/updatedatabase.pl b/installer/data/mysql/updatedatabase.pl
index 3dae149304..4ab1b8369f 100755
--- a/installer/data/mysql/updatedatabase.pl
+++ b/installer/data/mysql/updatedatabase.pl
@@ -47,6 +47,8 @@ use MARC::File::XML ( BinaryEncoding => 'utf8' );
 use File::Path qw[remove_tree]; # perl core module
 use File::Slurp;
 
+use Koha::AtomicUpdater;
+
 # FIXME - The user might be installing a new database, so can't rely
 # on /etc/koha.conf anyway.
 
@@ -21434,21 +21436,32 @@ if( CheckVersion( $DBversion ) ) {
 
 # SEE bug 13068
 # if there is anything in the atomicupdate, read and execute it.
-my $update_dir = C4::Context->config('intranetdir') . '/installer/data/mysql/atomicupdate/';
-opendir( my $dirh, $update_dir );
-foreach my $file ( sort readdir $dirh ) {
-    next if $file !~ /\.(sql|perl)$/;  #skip other files
-    next if $file eq 'skeleton.perl'; # skip the skeleton file
-    print "DEV atomic update: $file\n";
-    if ( $file =~ /\.sql$/ ) {
-        my $installer = C4::Installer->new();
-        my $rv = $installer->load_sql( $update_dir . $file ) ? 0 : 1;
-    } elsif ( $file =~ /\.perl$/ ) {
-        my $code = read_file( $update_dir . $file );
-        eval $code;
-        say "Atomic update generated errors: $@" if $@;
-    }
-}
+#
+#my $update_dir = C4::Context->config('intranetdir') . '/installer/data/mysql/atomicupdate/';
+#
+#opendir( my $dirh, $update_dir );
+#foreach my $file ( sort readdir $dirh ) {
+#    next if $file !~ /\.(sql|perl)$/;  #skip other files
+#    next if $file eq 'skeleton.perl'; # skip the skeleton file
+#    print "DEV atomic update: $file\n";
+#    if ( $file =~ /\.sql$/ ) {
+#        my $installer = C4::Installer->new();
+#        my $rv = $installer->load_sql( $update_dir . $file ) ? 0 : 1;
+#    } elsif ( $file =~ /\.perl$/ ) {
+#        my $code = read_file( $update_dir . $file );
+#        eval $code;
+#        say "Atomic update generated errors: $@" if $@;
+#    }
+#}
+
+#Use Koha::AtomicUpdater instead to prevent reinstalling DB upgrades
+my $atomicUpdater = Koha::AtomicUpdater->new({
+    verbose => 2,
+    scriptDir => C4::Context->config('intranetdir') . '/installer/data/mysql/atomicupdate/',
+});
+$atomicUpdater->buildUpdateOrderFromGit(1000);
+$atomicUpdater->applyAtomicUpdates();
+
 
 =head1 FUNCTIONS
 
@@ -21561,6 +21574,12 @@ as implemented in bug 7167.
 =cut
 
 sub CheckVersion {
+    #Check if we have already applied this update as an atomicupdate
+    my $bug = eval { _getBugNumber() } || 0;
+    warn $@ if $@;
+    my $atomicUpdate = Koha::AtomicUpdater->find( $bug );
+    return 0 if $atomicUpdate;
+
     my ($proposed_version) = @_;
     my $version_number = TransformToNum($proposed_version);
 
@@ -21577,4 +21596,63 @@ sub CheckVersion {
     }
 }
 
+my $skipped = 0;
+sub _getBugNumber {
+    my $skip = 100;
+    return 0 if $skip >= ++$skipped;
+    require File::Slurp;
+    my ($package, $filename, $line) = caller(2); #Get the second caller from the stack trace
+    my $updatedatabase = File::Slurp::read_file(__FILE__,  binmode => ':utf8', array_ref => 1);
+
+    my ($err, @err);
+
+    my $linePointer = $line;
+    ##Look for the block-ending '}'
+    do {
+        $linePointer+=1;
+    } while ($updatedatabase->[$linePointer] !~ /^\}/);
+    my $blockEndLine = $linePointer;
+
+
+    ##Look for 'SetVersion', fail if it is missing, just for safety's sake.
+    ($err, @err) = (undef, undef);
+    my $getSetVersion = sub {
+        my $i = shift;
+        unless ($updatedatabase->[$i] =~ /^\s{2,5}SetVersion ?\( ?\$DBversion ?\);\s+$/) {
+            return "_getBugNumber():> Line: $i: Malformed SetVersion. Unsafe to proceed.\n".$updatedatabase->[$i];
+        }
+        return undef;
+    };
+    foreach my $step (1..5) {
+        $err = &$getSetVersion($blockEndLine-$step);
+        last unless $err;
+        push(@err, $err);
+    }
+    die join("",@err) if $err;
+
+
+    ##Look for 'Upgrade done'-message
+    ($err, @err) = (undef, undef);
+    my $getUpgradeMsg = sub {
+        my $i = shift;
+        unless ($updatedatabase->[$i] =~ /print "Upgraded? to \$DBversion done/ ||
+                $updatedatabase->[$i] =~ /print "Upgrade done \(/ ) {
+            return "_getBugNumber():> Line: $i: Malformed Bug message. Unsafe to proceed.\n".$updatedatabase->[$i];
+        }
+        return undef;
+    };
+    $linePointer = $blockEndLine;
+    foreach my $step ((1..5)) {
+        $err = &$getUpgradeMsg( --$linePointer );
+        last unless $err;
+        push(@err, $err);
+    }
+    die join("",@err) if $err;
+
+    if ($updatedatabase->[$linePointer] =~ /Bug (\d{4,5})/) {
+        return $1;
+    }
+    die "_getBugNumber():> Failed for line '$line' looking at row:\n".$updatedatabase->[$linePointer];
+}
+
 exit;
-- 
2.17.1