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