From 12033dc13d43c4ec572c33650fd7c885633fa903 Mon Sep 17 00:00:00 2001
From: Marcel de Rooy <m.de.rooy@rijksmuseum.nl>
Date: Tue, 14 Oct 2014 11:49:36 +0200
Subject: [PATCH] Bug 13068: Counterpatch using atomicupdate directory
Content-Type: text/plain; charset=utf-8

This patch makes a distinction between atomicupdates belonging to an
official db revision and development updates.
It also keeps track of the dev updates since the last official db rev.
(This is done via a local pref; so easily accessible if needed.)

The db revs can be txt files, perl scripts or sql files.
Sql files are run via the installer.

A new db revision is now only a matter of dropping a file in atomicupdates
for the developer. The RM only adds one line to updatedatabase like:
    ExecDBRev( $aupd, '13068', 'Refined dbrev', '13068.pl', '3.17.00.028');

Amended on Oct 16: Promoted the two debugging prints to actual prints. They
will be helpful for any developer. Added a sort for safety. Added some POD
comments.
---
 installer/data/mysql/updatedatabase.pl |  109 ++++++++++++++++++++++++++++++++
 1 files changed, 109 insertions(+), 0 deletions(-)

diff --git a/installer/data/mysql/updatedatabase.pl b/installer/data/mysql/updatedatabase.pl
index d6b7d24..5ebc371 100755
--- a/installer/data/mysql/updatedatabase.pl
+++ b/installer/data/mysql/updatedatabase.pl
@@ -38,13 +38,24 @@ use C4::Context;
 use C4::Installer;
 use C4::Dates;
 
+use File::Slurp;
 use MARC::Record;
 use MARC::File::XML ( BinaryEncoding => 'utf8' );
 
+use constant ATOMICUPD_PREF => '_LocalAtomicUpdates';
+
 # FIXME - The user might be installing a new database, so can't rely
 # on /etc/koha.conf anyway.
 
 my $debug = 0;
+my $aupd = { #hash for atomic updates
+    location  => C4::Context->config('intranetdir')."/installer/data/mysql/atomicupdate",
+    remember  => C4::Context->preference(ATOMICUPD_PREF)//'',
+    skipfiles => {
+        'Bug-4246-Talking-Tech-itiva-phone-notifications.pl' => 1,
+        'oai_sets.sql' => 1,
+    },
+};
 
 my (
     $sth, $sti,
@@ -8800,9 +8811,107 @@ if ( CheckVersion($DBversion) ) {
     SetVersion($DBversion);
 }
 
+#FIXME Will be fixed with the first db rev new style
+#The first dbrev should look like this:
+#ExecDBRev( $aupd, '13068', 'Refined dbrev', '13068.pl', '3.17.00.028');
+
+# This point marks the end of the approved database revisions.
+# The following line runs proposed patches found in atomicupdate. On a
+# production system, it will [should] not find any.
+RunRemainingAtomicUpdates( $aupd );
 
 =head1 FUNCTIONS
 
+=head2 RunRemainingAtomicUpdates
+
+This subroutine will run all development updates in the atomicupdate
+directory. It will skip the official db revisions, that have been
+collected in the skipfiles hash. It also skips recently applied
+dev updates as recorded in local pref _LocalAtomicUpdates.
+
+=cut
+
+sub RunRemainingAtomicUpdates {
+    my ( $atomicupd ) = @_;
+    my $loc = $atomicupd->{location};
+    my @updates = glob( $loc .'/*');
+    foreach my $upd ( sort @updates ) { #sort feels safer here
+        $upd =~ s/$loc\///;
+        if( exists $atomicupd->{skipfiles}->{$upd} ) {
+        #Skip files that belong to official db revisions
+           print "Skipping $upd as installed official db rev\n";
+           next;
+        }
+        if( $atomicupd->{remember} =~ /(^|;)$upd;/ ) {
+        #Skip files that have recently been applied
+        #Note that an official db rev erases this list
+           print "Skipping $upd as recently applied dev update\n";
+           next;
+        }
+        if( $upd !~ /\.(txt|sql|pl)$/ ) {
+            print "Unsupported file format: $upd\n";
+            next;
+        }
+        ExecDBRev( $atomicupd, '', '', $upd, 'XXX' );
+   }
+}
+
+=head2 ExecDBRev
+
+This subroutine checks if an official db revision should still be
+applied. If not, it records the file in the skipfiles hash and returns.
+Otherwise it applies the db rev from the atomicupdate directory.
+The db rev can be a perl file, a sql file or a txt file.
+
+=cut
+
+sub ExecDBRev {
+    my ( $atomicupd, $bugno, $descr, $file, $version ) = @_;
+
+    my $devrun = $version=~/XXX$/;
+    $atomicupd->{skipfiles}->{$file} = 1 if !$devrun && $file;
+    return 0 if !CheckVersion($version);
+
+    my $rv;
+    if( $file =~ /\.txt$/ ) {
+    #This dbrev prints some warning
+        my $contents= read_file( $atomicupd->{location}. "/$file" );
+        print $contents;
+        $rv = 1;
+    } elsif( $file =~ /\.pl$/ ) {
+    #Run perl script
+        $rv = do $atomicupd->{location}. "/$file";
+        if( !$rv ) {
+            print "ERROR: $@\n" if $@;
+            print "ERROR: $!\n" if $!;
+            $rv = 1 if !$! && !$@; #apparently, the file does not end with 1;
+        }
+    } elsif( $file =~ /\.sql$/ ) {
+    #Run sql file via installer
+        my $installer = C4::Installer->new();
+        $rv = $installer->load_sql( $atomicupd->{location}. "/$file" )? 0: 1;
+        #Note: load_sql already warns
+    } else {
+        print "DB rev $version contains unsupported file $file\n";
+        $rv = 0;
+    }
+
+    if( $devrun ) {
+        print "Dev upgrade $file done\n";
+        _atomic_memory( $atomicupd, $file ) if $rv;
+    } else {
+        _atomic_memory( $atomicupd ); #Official db rev clears the atomic pref
+        SetVersion($version);
+        print "Upgrade to $version done (Bug $bugno - $descr)\n";
+    }
+}
+
+sub _atomic_memory {
+    my ( $atomicupd, $upd ) = @_;
+    $atomicupd->{remember}= $upd? $atomicupd->{remember}."$upd;": '';
+    C4::Context->set_preference( ATOMICUPD_PREF, $atomicupd->{remember} );
+}
+
 =head2 TableExists($table)
 
 =cut
-- 
1.7.7.6