misc/maintenance/cmp_sysprefs.pl

   1 #!/usr/bin/perl
   2
   3 # Copyright 2013 Rijksmuseum
   4 #
   5 # This file is part of Koha.
   6 #
   7 # Koha is free software; you can redistribute it and/or modify it
   8 # under the terms of the GNU General Public License as published by
   9 # the Free Software Foundation; either version 3 of the License, or
  10 # (at your option) any later version.
  11 #
  12 # Koha is distributed in the hope that it will be useful, but
  13 # WITHOUT ANY WARRANTY; without even the implied warranty of
  14 # MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
  15 # GNU General Public License for more details.
  16 #
  17 # You should have received a copy of the GNU General Public License
  18 # along with Koha; if not, see <http://www.gnu.org/licenses>.
  19
  20 # This script imports/exports systempreferences to file.
  21 # Two interesting features are:
  22 # 1) It may help you to compare systempreferences between Koha instances.
  23 # 2) You can also quickly restore subsets of preferences while testing.
  24 #    Just leave only e.g. some circulations prefs in a file and compare with
  25 #    the update flag.
  26
  27 use Modern::Perl;
  28 use open OUT => ':encoding(UTF-8)', ':std';
  29
  30 use Getopt::Long;
  31 use Pod::Usage;
  32
  33 use Koha::Script;
  34 use C4::Context;
  35 my $dbh = C4::Context->dbh;
  36
  37 my ( $help, $cmd, $filename, $override, $compare_add, $compare_del, $compare_upd, $ignore_opt, $partial );
  38 GetOptions(
  39     'help'    => \$help,
  40     'cmd:s'   => \$cmd,
  41     'file:s'  => \$filename,
  42     'add'     => \$compare_add,
  43     'del'     => \$compare_del,
  44     'upd'     => \$compare_upd,
  45     'ign-opt' => \$ignore_opt,
  46     'partial' => \$partial,
  47 );
  48
  49 if ( $filename && !-e $filename && $cmd !~ /^b/ ) {
  50     die "File $filename not found";
  51 }
  52 if ( !$cmd || !$filename || $help ) {
  53     pod2usage( -verbose => 2 );
  54     exit;
  55 }
  56
  57 #------------------------------------------------------------------------------
  58
  59 #backup prefs
  60 if ( $cmd =~ /^b/i && $filename ) {
  61     my $dbprefs = ReadPrefsFromDb();
  62     open my $fh, '>:encoding(UTF-8)', $filename;
  63     SavePrefsToFile( $dbprefs, $fh );
  64     close $fh;
  65 }
  66
  67 #test pref file: read and save for gaining confidence :) run a diff
  68 if ( $cmd =~ /^t/i && $filename ) {
  69     my $fileprefs = ReadPrefsFromFile($filename);
  70     open my $fh, '>:encoding(UTF-8)', $filename . ".sav";
  71     SavePrefsToFile( $fileprefs, $fh );
  72     close $fh;
  73 }
  74
  75 #compare prefs (with db)
  76 if ( $cmd =~ /^c/i && $filename ) {
  77     my $dbprefs   = ReadPrefsFromDb();
  78     my $fileprefs = ReadPrefsFromFile($filename);
  79
  80     #compare now
  81     my $cmp = ComparePrefs( $dbprefs, $fileprefs );
  82     PrintCompare( $cmp, "database", "file $filename" );
  83     HandleCompareChanges( $cmp, $dbprefs, $fileprefs )
  84       if $compare_add || $compare_del || $compare_upd;
  85 }
  86
  87 #restore prefs
  88 if ( $cmd =~ /^r/i && $filename ) {
  89     my $fileprefs = ReadPrefsFromFile($filename);
  90     CheckVersionPref($fileprefs);
  91
  92     #override this check by removing Version from your file
  93     #if you know what you are doing of course
  94     SavePrefsToDb($fileprefs);
  95 }
  96
  97 #------------------------------------------------------------------------------
  98
  99 sub PrintCompare {
 100     my ( $ch, $s1, $s2 ) = @_;
 101     foreach ( sort keys %$ch ) {
 102         my $v = $ch->{$_};
 103         next if $v eq '1' && $partial;
 104         print "$_: ";
 105         if    ( $v eq '1' ) { print "Not in $s2"; }
 106         elsif ( $v eq '2' ) { print "Not in $s1"; }
 107         else                { print "Different values: $v"; }
 108         print "\n";
 109     }
 110 }
 111
 112 sub HandleCompareChanges {
 113     my ( $cmp_pref, $dbpref, $filepref ) = @_;
 114     my $t = 0;
 115     foreach my $k ( sort keys %$cmp_pref ) {
 116         my $cmp = $cmp_pref->{$k};
 117         if ( $cmp eq '1' ) {
 118             $t += DeleteOnePref($k) if $compare_del;
 119         } elsif ( $cmp eq '2' ) {
 120             my $kwc  = $filepref->{$k}->{orgkey};
 121             my $val  = $filepref->{$k}->{value};
 122             my $type = $filepref->{$k}->{type};
 123             $t += InsertIgnoreOnePref( $kwc, $val, $type ) if $compare_add;
 124         } elsif ($cmp) {    #should contain something..
 125             my $val = $filepref->{$k}->{value};
 126             $t += UpdateOnePref( $k, $val ) if $compare_upd;
 127         }
 128     }
 129     print "Adjusted $t prefs from this compare.\n";
 130 }
 131
 132 sub ComparePrefs {
 133     my ( $ph1, $ph2 ) = @_;
 134     my $res = {};
 135     foreach my $k ( keys %$ph1 ) {
 136         if ( !exists $ph2->{$k} ) {
 137             $res->{$k} = 1;
 138         } else {
 139             my $v1 = $ph1->{$k}->{value} // 'NULL';
 140             my $v2 = $ph2->{$k}->{value} // 'NULL';
 141             if ( $v1 ne $v2 ) {
 142                 $res->{$k} = "$v1 / $v2";
 143             }
 144         }
 145     }
 146     foreach my $k ( keys %$ph2 ) {
 147         if ( !exists $ph1->{$k} ) {
 148             $res->{$k} = 2;
 149         }
 150     }
 151     return $res;
 152 }
 153
 154 sub ReadPrefsFromDb {
 155     my $sql = 'SELECT variable AS orgkey, LOWER(variable) AS variable, value, type FROM systempreferences ORDER BY variable';
 156     my $hash = $dbh->selectall_hashref( $sql, 'variable' );
 157     return $hash;
 158 }
 159
 160 sub ReadPrefsFromFile {
 161     my ($file) = @_;
 162     open my $fh, '<:encoding(UTF-8)', $filename;
 163     my @lines = <$fh>;
 164     close $fh;
 165     my $hash;
 166     for ( my $t = 0 ; $t < @lines ; $t++ ) {
 167         next if $lines[$t] =~ /^\s*#|^\s*$/;    # comment line or empty line
 168         my @l = split ",", $lines[$t], 4;
 169         die "Invalid pref file; check line " . ++$t if @l < 4 || $l[0] !~ /^\d+$/ || $t + $l[0] >= @lines;
 170         my $key = lc $l[1];
 171         $hash->{$key} = { orgkey => $l[1], value => $l[3], type => $l[2] };
 172         for ( my $j = 0 ; $j < $l[0] ; $j++ ) { $hash->{$key}->{value} .= $lines[ $t + $j + 1 ]; }
 173         $t = $t + $l[0];
 174         $hash->{$key}->{value} =~ s/\n$//;      #only 'last' line
 175     }
 176     return $hash;
 177 }
 178
 179 sub SavePrefsToFile {
 180     my ( $hash, $fh ) = @_;
 181     print $fh '#cmp_sysprefs.pl: ' . C4::Context->config('database') . ', ' . localtime . "\n";
 182     foreach my $k ( sort keys %$hash ) {
 183
 184         #sort handles underscore differently than mysql?
 185         my $c   = CountLines( $hash->{$k}->{value} );
 186         my $kwc = $hash->{$k}->{orgkey};                # key-with-case
 187         print $fh "$c,$kwc," . ( $hash->{$k}->{type} // 'Free' ) . ',' . ( $hash->{$k}->{value} // 'NULL' ) . "\n";
 188     }
 189 }
 190
 191 sub SavePrefsToDb {
 192     my ($hash) = @_;
 193     my $t = 0;
 194
 195     #will not erase everything! you can do that in mysql :)
 196     foreach my $k ( keys %$hash ) {
 197         my $v = $hash->{$k}->{value} eq 'NULL' ? undef : $hash->{$k}->{value};
 198         my $kwc  = $hash->{$k}->{orgkey} // $k;
 199         my $type = $hash->{$k}->{type}   // 'Free';
 200
 201         #insert and update seem overkill, but better than delete and insert
 202         #you cannot assume that the pref IS or IS NOT there
 203         InsertIgnoreOnePref( $kwc, $v, $type );
 204         UpdateOnePref( $k, $v );
 205         $t++;
 206     }
 207     print "Updated $t prefs\n";
 208 }
 209
 210 sub InsertIgnoreOnePref {
 211     my ( $kwc, $v, $t ) = @_;
 212     my $i = $dbh->do(
 213         'INSERT IGNORE INTO systempreferences (variable, value, type)
 214         VALUES (?,?,?)', undef, ( $kwc, $v, $t )
 215     );
 216     return !defined($i) || $i eq '0E0'? 0: $i;
 217 }
 218
 219 sub UpdateOnePref {
 220     my ( $k, $v ) = @_;
 221     return 0 if lc $k eq 'version';
 222     my $i = $dbh->do( 'UPDATE systempreferences SET value=? WHERE variable=?', undef, ( $v, $k ) );
 223     return !defined($i) || $i eq '0E0'? 0: $i;
 224 }
 225
 226 sub DeleteOnePref {
 227     my ($k) = @_;
 228     return if lc $k eq 'version';
 229     my $sql = 'DELETE FROM systempreferences WHERE variable=?';
 230     unless ($ignore_opt) {
 231         $sql .= " AND COALESCE(explanation,'')='' AND COALESCE(options,'')=''";
 232     }
 233     my $i = $dbh->do( $sql, undef, ($k) );
 234     return !defined($i) || $i eq '0E0'? 0: $i;
 235 }
 236
 237 sub CheckVersionPref {    #additional precaution
 238                           #if there are versions, compare them
 239     my ($hash) = @_;
 240     my $hv = exists $hash->{version}? $hash->{version}->{value}: undef;
 241     return if !defined $hv;
 242     my ($dv) = $dbh->selectrow_array(
 243         'SELECT value FROM systempreferences
 244         WHERE variable LIKE ?', undef, ('version')
 245     );
 246     return if !defined $dv;
 247     die "Versions do not match ($dv, $hv)" if $dv ne $hv;
 248 }
 249
 250 sub CountLines {
 251     my @ma;
 252     return ( $_[0] && ( @ma = $_[0] =~ /\r?\n|\r\n?/g ) ) ? scalar @ma : 0;
 253 }
 254
 255 =head1 NAME
 256
 257 cmp_sysprefs.pl
 258
 259 =head1 SYNOPSIS
 260
 261 cmp_sysprefs.pl -help
 262
 263 cmp_sysprefs.pl -cmd backup -file prefbackup
 264
 265 cmp_sysprefs.pl -cmd compare -file prefbackup -upd
 266
 267 cmp_sysprefs.pl -cmd compare -file prefbackup -del -ign-opt
 268
 269 cmp_sysprefs.pl -cmd restore -file prefbackup
 270
 271 =head1 DESCRIPTION
 272
 273 This script may backup, compare and restore system preferences from file.
 274
 275 Precaution: only the last command or file name will be used. The add, del and
 276 upd parameters are extensions for the compare command. They allow you to act
 277 immediately on the compare results.
 278
 279 When restoring a preferences file containing a version pref to a database having
 280 another version, the restore will not be made. Similarly, a version pref will
 281 never be overwritten. A restore will overwrite prefs but not delete them.
 282
 283 It is possible to edit the preference backup files. But be careful. The first
 284 parameter for each preference is a line count. Some preference values use more
 285 than one line. If you edit a file, make sure that the line counts are still
 286 valid.
 287
 288 You can compare/restore using edited/partial preference files. Take special
 289 care when using the del parameter in comparing such a partial file. It will
 290 delete all prefs in the database not found in your partial file. Partial pref
 291 files can however be very useful when testing or monitoring a limited set of
 292 prefs.
 293
 294 The ign-opt flag allows you to delete preferences that have explanation or
 295 options in the database. If you do not set this flag, a compare with delete
 296 will by default only delete preferences without explanation/options. Use this
 297 option only if you understand the risk. Note that a restore will recover value,
 298 not explanation or options. (See also BZ 10199.)
 299
 300 =over 8
 301
 302 =item B<-help>
 303
 304 Print this usage statement.
 305
 306 =item B<-cmd>
 307
 308 Command: backup, compare, restore or test.
 309
 310 =item B<-file>
 311
 312 Name of the file used in command.
 313
 314 =item B<-partial>
 315
 316 Only for partial compares: skip 'not present in file'-messages.
 317
 318 =item B<-add>
 319
 320 Only for compares: restore preferences not present in database.
 321
 322 =item B<-del>
 323
 324 Only for compares: delete preferences not present in file.
 325
 326 =item B<-upd>
 327
 328 Only for compares: update preferences when values differ.
 329
 330 =item B<-ign-opt>
 331
 332 Ignore options/explanation when comparing with delete flag. Use this flag with care.
 333
 334 =back
 335
 336 =cut