misc/admin/koha-preferences

   1 #!/usr/bin/perl
   2 #
   3 # Copyright 2010 Jesse Weaver, Koha Dev Team
   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
  21 use Modern::Perl;
  22 use Koha::Script;
  23 use C4::Context;
  24 use C4::Debug;
  25 use C4::Log;
  26 use Getopt::Long;
  27 use Pod::Usage;
  28 use YAML::XS;
  29 use Encode;
  30 our %NOT_SET_PREFS = map { $_, 1 } qw( Version );
  31
  32 =head1 NAME
  33
  34 koha-preferences - Get, set, dump and load Koha system preferences
  35
  36 =head1 SYNOPSIS
  37
  38 misc/admin/koha-preferences COMMAND ...
  39
  40 =cut
  41
  42 sub print_usage {
  43     my ( $annoyed ) = @_;
  44
  45     if ( $annoyed ) {
  46         pod2usage( -verbose => 1, -exitval => 1, -output => \*STDERR );
  47     } else {
  48         pod2usage( -verbose => 1, -exitval => 0 );
  49     }
  50 }
  51
  52 sub _debug {
  53     my ( $message ) = @_;
  54
  55     print STDERR $message . "\n" if ( $C4::Debug::debug );
  56 }
  57
  58 sub _set_preference {
  59     my ( $preference, $value ) = @_;
  60
  61     _debug( "Setting $preference to $value" );
  62
  63     if (   $preference->{type} eq 'YesNo'
  64         && $value ne '0'
  65         && $value ne '1' )
  66     {
  67         print STDERR sprintf "System preference %s is YesNo and expects 1 or 0. '%s' was given, using '0'\n",
  68           $preference->{variable}, $value;
  69         $value = 0;
  70     }
  71
  72     C4::Context->set_preference( $preference->{variable}, $value );
  73 }
  74
  75 sub GetPreferences {
  76     my $dbh = C4::Context->dbh;
  77
  78     return {
  79         map { $_->{variable},  $_->{value} }
  80         @{ $dbh->selectall_arrayref( "
  81             SELECT
  82               variable, value, type
  83               FROM systempreferences
  84         ", { Slice => {} } ) }
  85     };
  86 }
  87
  88 sub SetPreferences {
  89     my ( %preferences ) = @_;
  90
  91     my $dbh = C4::Context->dbh;
  92
  93     # First, a quick check to make sure all of the system preferences exist
  94     my $current_state = $dbh->selectall_arrayref( "
  95         SELECT
  96           variable, type, value
  97           FROM systempreferences
  98           WHERE variable IN (" . join( ', ', map( "?", keys %preferences ) ) . ")
  99     ", { Slice => {} }, keys %preferences );
 100
 101     exit 2 if ( scalar( @$current_state ) != scalar( keys %preferences ) );
 102
 103     foreach my $row ( @$current_state ) {
 104         my $new_value = $preferences{ $row->{variable} };
 105         next if $new_value && $row->{value} && $new_value eq $row->{value};
 106
 107         _set_preference( $row, $new_value );
 108     }
 109
 110     # FIXME This may be not needed
 111     C4::Context->clear_syspref_cache();
 112 }
 113
 114 sub _fetch_preference {
 115     my ( $preference ) = @_;
 116
 117     my $dbh = C4::Context->dbh;
 118
 119     my $row = $dbh->selectrow_hashref( "
 120         SELECT
 121           variable, value, type
 122           FROM systempreferences
 123           WHERE variable = ?
 124           LIMIT 1
 125     ", {}, $preference );
 126
 127     exit 2 unless ( $row );
 128
 129     return $row;
 130 }
 131
 132 sub GetPreference {
 133     my ( $preference ) = @_;
 134
 135     return _fetch_preference( $preference );
 136 }
 137
 138 sub SetPreference {
 139     my ( $preference, $value ) = @_;
 140
 141     my $row = _fetch_preference( $preference );
 142
 143     exit 3 if ( $value eq $row->{'value'} ); #FIXME exit??
 144
 145     _set_preference( $row, $value );
 146 }
 147
 148 sub ClearPreference {
 149     my ( $preference ) = @_;
 150
 151     my $value = '';
 152
 153     my $row = _fetch_preference( $preference );
 154
 155     $value = 0 if ( $row->{'type'} eq 'YesNo' );
 156
 157     exit 3 if ( $value eq $row->{'value'} );
 158
 159     _set_preference( $row, $value );
 160 }
 161
 162 =head1 OPTIONS
 163
 164 COMMAND can be any of the following:
 165
 166 =over
 167
 168 =item B<dump> [ -o I<OUTFILE> ]
 169
 170 Dump all of Koha's system preferences as a simple YAML mapping into OUTFILE or
 171 STDOUT.
 172
 173 =item B<load> [ -i I<INFILE> ] [ -f|--force ]
 174
 175 Reads system preferences specified in YAML in INFILE or STDIN.  Will exit with a
 176 status of 2, without setting any sysprefs, if any of the sysprefs do not exist.
 177 Will also exit if any of the sysprefs are YesNo and have an invalid value.
 178
 179 If there is a Version syspref in the input, it will not be set in the database,
 180 but it will be checked to make sure the running Koha version is equal or higher.
 181 The script will exit with a status of 4 if this is not true. Pass the -f option
 182 to skip this check.
 183
 184 =item B<get> I<PREFERENCE>
 185
 186 Print the value of the system preference PREFERENCE, followed by a newline.  If
 187 no such syspref exists, will exit with a status of 2.
 188
 189 =item B<set> I<PREFERENCE> I<VALUE>
 190
 191 Set the system preference PREFERENCE to the value VALUE. If no such syspref
 192 exists, will exit with a status of 2. If the syspref already has that value,
 193 will exit with a status of 3.
 194
 195 If the syspref is YesNo, will accept only a boolean value. The syntax is *not*
 196 lax and must be 1 or 0.
 197
 198 =item B<clear> I<PREFERENCE>
 199
 200 Clears the value of the system preference PREFERENCE. If no such syspref exists,
 201 will exit with a status of 2. Will set YesNo sysprefs to 'false'.
 202
 203 =item B<manual>
 204
 205 Print a longer, more detailed manual.
 206
 207 =cut
 208
 209 my %commands = (
 210     dump => sub{
 211         my ( $outfile );
 212
 213         GetOptions(
 214             'o:s' => \$outfile
 215         ) || _print_usage( 1 );
 216
 217         if ( $outfile ) {
 218             YAML::XS::DumpFile( $outfile, GetPreferences() );
 219         } else {
 220             print Encode::decode_utf8(YAML::XS::Dump(GetPreferences()));
 221         }
 222     },
 223     load => sub {
 224         my ( $infile, $force_version );
 225
 226         GetOptions(
 227             'i:s' => \$infile,
 228             'f' => \$force_version,
 229         );
 230
 231         my $preferences = YAML::XS::LoadFile($infile || \*STDIN);
 232
 233         die "Expected a YAML mapping" if ( ref($preferences) ne 'HASH' );
 234
 235         die "Tried to load preferences for version " . $preferences->{'Version'} . ", we are " . C4::Context->preference( 'Version' ) if ( $preferences->{'Version'} && C4::Context->preference( 'Version' ) < $preferences->{'Version'} );
 236
 237         my %prefs_to_set = (
 238             map { $_, $preferences->{$_} }
 239             grep { !$NOT_SET_PREFS{$_} }
 240             keys %$preferences
 241         );
 242
 243         SetPreferences( %prefs_to_set );
 244     },
 245     get => sub {
 246         my ( $preference ) = @_;
 247
 248         print_usage() unless ( $preference );
 249
 250         print GetPreference( $preference ) . "\n";
 251     },
 252     set => sub {
 253         my ( $preference, $value ) = @_;
 254
 255         print_usage() unless ( $preference && defined($value) );
 256
 257         SetPreference( $preference, $value );
 258     },
 259     clear => sub {
 260         my ( $preference ) = @_;
 261
 262         print_usage() unless ( $preference );
 263
 264         ClearPreference( $preference );
 265     },
 266     manual => sub {
 267         pod2usage( -verbose => 2 );
 268     }
 269 );
 270
 271 print_usage() if ( $ARGV[0] =~ /^(-h|--help|-help|help)$/ );
 272
 273 print_usage( 1 ) if ( !$ARGV[0] || ref($commands{$ARGV[0]}) ne 'CODE' );
 274
 275 my $command = $commands{$ARGV[0]};
 276 shift @ARGV;
 277 $command->(@ARGV);
 278
 279 =item B<help>
 280
 281 Print a short usage message.
 282
 283 =back
 284
 285 =head1 EXAMPLES
 286
 287   $ export KOHA_DEBUG=1 # Used here to show what is being stored
 288   $ misc/admin/koha-preferences get viewISBD
 289   0
 290   $ misc/admin/koha-preferences set viewISBD on
 291   Setting viewISBD to 1
 292   $ misc/admin/koha-preferences dump -o preferences.yaml
 293   $ [ edit preferences.yaml ]
 294   $ misc/admin/koha-preferences load -i preferences.yaml
 295   $ misc/admin/koha-preferences load -i preferences-too-new.yaml
 296   Tried to load preferences for version 3.0500012, we are 3.0300009 at misc/admin/koha-preferences line 255
 297   $ misc/admin/koha-preferences load # Can also work from STDIN
 298   XISBN: false
 299   viewMARC: y
 300   [ Control-D ]
 301   Setting viewMARC to 1
 302   Setting XISBN to 0
 303
 304 =cut