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