3 # Copyright 2013 Rijksmuseum
5 # This file is part of Koha.
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
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.
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.
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
28 use open OUT => ':encoding(UTF-8)', ':std';
34 my $dbh = C4::Context->dbh;
36 my ( $help, $cmd, $filename, $override, $compare_add, $compare_del, $compare_upd, $ignore_opt );
40 'file:s' => \$filename,
41 'add' => \$compare_add,
42 'del' => \$compare_del,
43 'upd' => \$compare_upd,
44 'ign-opt' => \$ignore_opt,
47 if ( $filename && !-e $filename && $cmd !~ /^b/ ) {
48 die "File $filename not found";
50 if ( !$cmd || !$filename || $help ) {
51 pod2usage( -verbose => 2 );
55 #------------------------------------------------------------------------------
58 if ( $cmd =~ /^b/i && $filename ) {
59 my $dbprefs = ReadPrefsFromDb();
60 open my $fh, '>:encoding(UTF-8)', $filename;
61 SavePrefsToFile( $dbprefs, $fh );
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 );
73 #compare prefs (with db)
74 if ( $cmd =~ /^c/i && $filename ) {
75 my $dbprefs = ReadPrefsFromDb();
76 my $fileprefs = ReadPrefsFromFile($filename);
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;
86 if ( $cmd =~ /^r/i && $filename ) {
87 my $fileprefs = ReadPrefsFromFile($filename);
88 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);
95 #------------------------------------------------------------------------------
98 my ( $ch, $s1, $s2 ) = @_;
99 foreach ( sort keys %$ch ) {
102 if ( $v eq '1' ) { print "Not in $s2"; }
103 elsif ( $v eq '2' ) { print "Not in $s1"; }
104 else { print "Different values: $v"; }
109 sub HandleCompareChanges {
110 my ( $cmp_pref, $dbpref, $filepref ) = @_;
112 foreach my $k ( sort keys %$cmp_pref ) {
113 my $cmp = $cmp_pref->{$k};
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;
126 print "Adjusted $t prefs from this compare.\n";
130 my ( $ph1, $ph2 ) = @_;
132 foreach my $k ( keys %$ph1 ) {
133 if ( !exists $ph2->{$k} ) {
136 my $v1 = $ph1->{$k}->{value} // 'NULL';
137 my $v2 = $ph2->{$k}->{value} // 'NULL';
139 $res->{$k} = "$v1 / $v2";
143 foreach my $k ( keys %$ph2 ) {
144 if ( !exists $ph1->{$k} ) {
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' );
157 sub ReadPrefsFromFile {
159 open my $fh, '<:encoding(UTF-8)', $filename;
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;
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 ]; }
171 $hash->{$key}->{value} =~ s/\n$//; #only 'last' line
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 ) {
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";
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';
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 );
204 print "Updated $t prefs\n";
207 sub InsertIgnoreOnePref {
208 my ( $kwc, $v, $t ) = @_;
210 'INSERT IGNORE INTO systempreferences (variable, value, type)
211 VALUES (?,?,?)', undef, ( $kwc, $v, $t )
213 return !defined($i) || $i eq '0E0'? 0: $i;
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;
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,'')=''";
230 my $i = $dbh->do( $sql, undef, ($k) );
231 return !defined($i) || $i eq '0E0'? 0: $i;
234 sub CheckVersionPref { #additional precaution
235 #if there are versions, compare them
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')
243 return if !defined $dv;
244 die "Versions do not match ($dv, $hv)" if $dv ne $hv;
249 return ( $_[0] && ( @ma = $_[0] =~ /\r?\n|\r\n?/g ) ) ? scalar @ma : 0;
258 cmp_sysprefs.pl -help
260 cmp_sysprefs.pl -cmd backup -file prefbackup
262 cmp_sysprefs.pl -cmd compare -file prefbackup -upd
264 cmp_sysprefs.pl -cmd compare -file prefbackup -del -ign-opt
266 cmp_sysprefs.pl -cmd restore -file prefbackup
270 This script may backup, compare and restore system preferences from file.
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.
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.
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
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
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.)
301 Print this usage statement.
305 Command: backup, compare, restore or test.
309 Name of the file used in command.
313 Only for compares: restore preferences not present in database.
317 Only for compares: delete preferences not present in file.
321 Only for compares: update preferences when values differ.
325 Ignore options/explanation when comparing with delete flag. Use this flag with care.