View | Details | Raw Unified | Return to bug 9998
Collapse All | Expand All

(-)a/misc/maintenance/cmp_sysprefs.pl (-1 / +290 lines)
Line 0 Link Here
0
- 
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
21
# This script imports/exports systempreferences to file.
22
# Two interesting features are:
23
# 1) It may help you to compare systempreferences between Koha instances.
24
# 2) You can also quickly restore subsets of preferences while testing.
25
#    Just leave only e.g. some circulations prefs in a file and compare with
26
#    the update flag.
27
28
use strict;
29
use warnings;
30
use open OUT=>':encoding(UTF-8)', ':std';
31
32
use Getopt::Long;
33
34
use C4::Context;
35
my $dbh=C4::Context->dbh;
36
37
my ($help, $cmd, $filename, $override,$compare_add,$compare_del,$compare_upd,
38
    $ignore_opt);
39
GetOptions(
40
    'help'       => \$help,
41
    'cmd:s'      => \$cmd,
42
    'file:s'     => \$filename,
43
    'add'        => \$compare_add,
44
    'del'        => \$compare_del,
45
    'upd'        => \$compare_upd,
46
    'ign-opt'    => \$ignore_opt,
47
);
48
49
if($filename && !-e $filename && $cmd !~ /^b/) {
50
    die "File $filename not found";
51
}
52
if(!$cmd || $help) {
53
    Usage();
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
    #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
        #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 Usage {
98
    print <<_USAGE_
99
100
This script may backup, compare and restore system preferences from file.
101
The following parameters are available:
102
    -help:         Print this usage statement
103
    -cmd:          Command: backup, compare, restore or test
104
    -file:         File name for command
105
    -add:          Only for compares: restore preferences not in db
106
    -del:          Only for compares: delete preferences not in file
107
    -upd:          Only for compares: update preferences when values differ
108
    -ign-opt:      Ignore options/explanation when comparing with delete flag
109
110
Precaution: only the last command or file name will be used. The add, del and
111
upd parameters are extensions for the compare command. They allow you to act
112
immediately on the compare results.
113
114
When restoring a preferences file containing a version pref to a database having
115
another version, the restore will not be made. Similarly, a version pref will
116
never be overwritten. A restore will overwrite prefs but not delete them.
117
118
It is possible to edit the preference backup files. But be careful. The first
119
parameter for each preference is a line count. Some preference values use more
120
than one line. If you edit a file, make sure that the line counts are still
121
valid.
122
123
You can compare/restore using edited/partial preference files. Take special
124
care when using the del parameter in comparing such a partial file. It will
125
delete all prefs in the database not found in your partial file. Partial pref
126
files can however be very useful when testing or monitoring a limited set of
127
prefs.
128
129
The ign-opt flag allows you to delete preferences that have explanation or
130
options in the database. If you do not set this flag, a compare with delete
131
will by default only delete preferences without explanation/options. Use this
132
option only if you understand the risk. Note that a restore will recover value,
133
not explanation or options. (See also BZ 10199.)
134
135
_USAGE_
136
}
137
138
sub PrintCompare {
139
    my($ch,$s1,$s2)=@_;
140
    foreach(sort keys %$ch) {
141
        my $v=$ch->{$_};
142
        print "$_: ";
143
        if($v eq '1') { print "Not in $s2"; }
144
        elsif($v eq '2') { print "Not in $s1"; }
145
        else { print "Different values: $v"; }
146
        print "\n";
147
    }
148
}
149
150
sub HandleCompareChanges {
151
    my($cmp_pref,$dbpref,$filepref)=@_;
152
    my $t=0;
153
    foreach my $k (sort keys %$cmp_pref) {
154
        my $cmp=$cmp_pref->{$k};
155
        if( $cmp eq '1' ) {
156
            ++$t && DeleteOnePref($k) if $compare_del;
157
        }
158
        elsif( $cmp eq '2' ) {
159
            my $kwc=$filepref->{$k}->{orgkey};
160
            my $val=$filepref->{$k}->{value};
161
            my $type=$filepref->{$k}->{type};
162
            ++$t && InsertIgnoreOnePref($kwc,$val,$type) if $compare_add;
163
        }
164
        elsif($cmp) { #should contain something..
165
            my $val=$filepref->{$k}->{value};
166
            ++$t && UpdateOnePref($k,$val) if $compare_upd;
167
        }
168
    }
169
    print "Adjusted (at most) $t prefs from this compare.\n";
170
    #at most refers to: insert ignore, update ... where ...
171
    #the number is a maximum, no guarantee
172
}
173
174
sub ComparePrefs {
175
    my ($ph1, $ph2)=@_;
176
    my $res={};
177
    foreach my $k (keys %$ph1) {
178
        if(!exists $ph2->{$k}) {
179
            $res->{$k}=1;
180
        }
181
        else {
182
            my $v1=$ph1->{$k}->{value}//'NULL';
183
            my $v2=$ph2->{$k}->{value}//'NULL';
184
            if($v1 ne $v2) {
185
                $res->{$k}="$v1 / $v2";
186
            }
187
        }
188
    }
189
    foreach my $k (keys %$ph2) {
190
        if(!exists $ph1->{$k}) {
191
            $res->{$k}=2;
192
        }
193
    }
194
    return $res;
195
}
196
197
sub ReadPrefsFromDb {
198
    my $sql="SELECT variable AS orgkey, LOWER(variable) AS variable, value, type FROM systempreferences ORDER BY variable";
199
    my $hash= $dbh->selectall_hashref($sql,'variable');
200
    return $hash;
201
}
202
203
sub ReadPrefsFromFile {
204
    my($file)=@_;
205
    open my $fh,'<:encoding(UTF-8)', $filename;
206
    my @lines=<$fh>;
207
    close $fh;
208
    my $hash;
209
    for(my $t=0; $t<@lines; $t++) {
210
        next if $lines[$t]=~/^\s*#|^\s*$/; # comment line or empty line
211
        my @l= split ",", $lines[$t], 4;
212
        die "Invalid pref file; check line ".++$t if @l<4 || $l[0]!~/^\d+$/ || $t+$l[0]>=@lines;
213
        my $key=lc $l[1];
214
        $hash->{$key}={ orgkey=>$l[1], value => $l[3], type=> $l[2] };
215
        for(my $j=0; $j<$l[0]; $j++){$hash->{$key}->{value}.= $lines[$t+$j+1];}
216
        $t=$t+$l[0];
217
        $hash->{$key}->{value}=~ s/\n$//; #only 'last' line
218
    }
219
    return $hash;
220
}
221
222
sub SavePrefsToFile {
223
    my ($hash, $fh)=@_;
224
    print $fh '#cmp_sysprefs.pl: '.C4::Context->config('database').
225
        ', '.localtime."\n";
226
    foreach my $k (sort keys %$hash) {
227
    #sort handles underscore differently than mysql?
228
        my $c= CountLines($hash->{$k}->{value});
229
        my $kwc= $hash->{$k}->{orgkey}; # key-with-case
230
        print $fh "$c,$kwc,".
231
            ($hash->{$k}->{type}//'Free').','.
232
            ($hash->{$k}->{value}//'NULL')."\n";
233
    }
234
}
235
236
sub SavePrefsToDb {
237
    my ($hash)=@_;
238
    my $t=0;
239
    #will not erase everything! you can do that in mysql :)
240
    foreach my $k (keys %$hash) {
241
        my $v=$hash->{$k}->{value} eq 'NULL'? undef: $hash->{$k}->{value};
242
        my $kwc=$hash->{$k}->{orgkey}//$k;
243
        my $type=$hash->{$k}->{type}//'Free';
244
        #insert and update seem overkill, but better than delete and insert
245
        #you cannot assume that the pref IS or IS NOT there
246
        InsertIgnoreOnePref($kwc,$v,$type);
247
        UpdateOnePref($k, $v);
248
        $t++;
249
    }
250
    print "Updated $t prefs\n";
251
}
252
253
sub InsertIgnoreOnePref {
254
    my($kwc,$v,$t)=@_;
255
    $dbh->do("INSERT IGNORE INTO systempreferences (variable, value, type)
256
        VALUES (?,?,?)",undef,($kwc,$v,$t));
257
}
258
259
sub UpdateOnePref {
260
    my($k,$v)=@_;
261
    return if lc $k eq 'version';
262
    $dbh->do("UPDATE systempreferences SET value=? WHERE variable=?",
263
        undef,($v,$k));
264
}
265
266
sub DeleteOnePref {
267
    my($k)=@_;
268
    return if lc $k eq 'version';
269
    my $sql="DELETE FROM systempreferences WHERE variable=?";
270
    unless($ignore_opt) {
271
        $sql.=" AND COALESCE(explanation,'')='' AND COALESCE(options,'')=''";
272
    }
273
    $dbh->do($sql,undef,($k));
274
}
275
276
sub CheckVersionPref { #additional precaution
277
                       #if there are versions, compare them
278
    my ($hash)=@_;
279
    my $hv=$hash->{version}->{value};
280
    return if !defined $hv;
281
    my ($dv)=$dbh->selectrow_array("SELECT value FROM systempreferences
282
        WHERE variable LIKE ?",undef,('version'));
283
    return if !defined $dv;
284
    die "Versions do not match ($dv, $hv)" if $dv ne $hv;
285
}
286
287
sub CountLines {
288
    my @ma;
289
    return ($_[0] && (@ma=$_[0]=~/\r?\n|\r\n?/g))? scalar @ma: 0;
290
}

Return to bug 9998