Koha/Config.pm

   1 package Koha::Config;
   2
   3 # This file is part of Koha.
   4 #
   5 # Koha is free software; you can redistribute it and/or modify it
   6 # under the terms of the GNU General Public License as published by
   7 # the Free Software Foundation; either version 3 of the License, or
   8 # (at your option) any later version.
   9 #
  10 # Koha is distributed in the hope that it will be useful, but
  11 # WITHOUT ANY WARRANTY; without even the implied warranty of
  12 # MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
  13 # GNU General Public License for more details.
  14 #
  15 # You should have received a copy of the GNU General Public License
  16 # along with Koha; if not, see <http://www.gnu.org/licenses>.
  17
  18 =head1 NAME
  19
  20 Koha::Config - Read Koha configuration file
  21
  22 =head1 SYNOPSIS
  23
  24     use Koha::Config;
  25
  26     my $config = Koha::Config->get_instance;
  27     my $database = $config->get('database');
  28     my $serverinfo = $config->get('biblioserver', 'serverinfo');
  29
  30     my $otherconfig = Koha::Config->get_instance('/path/to/other/koha-conf.xml');
  31
  32 =head1 DESCRIPTION
  33
  34 Koha::Config is a helper module for reading configuration variables from the
  35 main Koha configuration file ($KOHA_CONF)
  36
  37 =cut
  38
  39 use Modern::Perl;
  40
  41 use XML::LibXML qw( XML_ELEMENT_NODE XML_TEXT_NODE );
  42
  43 # Default config file, if none is specified
  44 use constant CONFIG_FNAME => "/etc/koha/koha-conf.xml";
  45
  46 # path to config file set by installer
  47 # __KOHA_CONF_DIR__ is set by rewrite-confg.PL
  48 # when Koha is installed in 'standard' or 'single'
  49 # mode.  If Koha was installed in 'dev' mode,
  50 # __KOHA_CONF_DIR__ is *not* rewritten; instead
  51 # developers should set the KOHA_CONF environment variable
  52 my $INSTALLED_CONFIG_FNAME = '__KOHA_CONF_DIR__/koha-conf.xml';
  53
  54 =head1 CLASS METHODS
  55
  56 =head2 get_instance
  57
  58     $config = Koha::Config->get_instance;
  59     $config = Koha::Config->get_instance($file);
  60
  61 Reads C<$file> and returns the corresponding C<Koha::Config> object.
  62
  63 If C<$file> is not given (or undef) it defaults to the result of
  64 C<Koha::Config-E<gt>guess_koha_conf>.
  65
  66 Multiple calls with the same arguments will return the same object, and the
  67 file will be read only the first time.
  68
  69 =cut
  70
  71 our %configs;
  72
  73 sub get_instance {
  74     my ($class, $file) = @_;
  75
  76     $file //= $class->guess_koha_conf;
  77
  78     unless (exists $configs{$file}) {
  79         $configs{$file} = $class->read_from_file($file);
  80     }
  81
  82     return $configs{$file};
  83 }
  84
  85 =head2 read_from_file
  86
  87     $config = Koha::Config->read_from_file($file);
  88
  89 Reads C<$file> and returns the corresponding C<Koha::Config> object.
  90
  91 Unlike C<get_instance>, this method will read the file at every call, so use it
  92 carefully. In most cases, you should use C<get_instance> instead.
  93
  94 =cut
  95
  96 sub read_from_file {
  97     my ( $class, $file ) = @_;
  98
  99     return if not defined $file;
 100
 101     my $config = {};
 102     eval {
 103         my $dom = XML::LibXML->load_xml(location => $file);
 104         foreach my $childNode ($dom->documentElement->nonBlankChildNodes) {
 105             $class->_read_from_dom_node($childNode, $config);
 106         }
 107     };
 108
 109     if ($@) {
 110         die "\nError reading file $file.\nTry running this again as the koha instance user (or use the koha-shell command in debian)\n\n";
 111     }
 112
 113     return bless $config, $class;
 114 }
 115
 116 =head2 guess_koha_conf
 117
 118     $file = Koha::Config->guess_koha_conf;
 119
 120 Returns the path to Koha main configuration file.
 121
 122 Koha's main configuration file koha-conf.xml is searched for according to this
 123 priority list:
 124
 125 =over
 126
 127 =item 1. Path supplied via use C4::Context '/path/to/koha-conf.xml'
 128
 129 =item 2. Path supplied in KOHA_CONF environment variable.
 130
 131 =item 3. Path supplied in INSTALLED_CONFIG_FNAME, as long as value has changed
 132 from its default of '__KOHA_CONF_DIR__/koha-conf.xml', as happens when Koha is
 133 installed in 'standard' or 'single' mode.
 134
 135 =item 4. Path supplied in CONFIG_FNAME.
 136
 137 =back
 138
 139 The first entry that refers to a readable file is used.
 140
 141 =cut
 142
 143 sub guess_koha_conf {
 144
 145     # If the $KOHA_CONF environment variable is set, use
 146     # that. Otherwise, use the built-in default.
 147     my $conf_fname;
 148     if ( exists $ENV{"KOHA_CONF"} and $ENV{'KOHA_CONF'} and -s $ENV{"KOHA_CONF"} ) {
 149         $conf_fname = $ENV{"KOHA_CONF"};
 150     } elsif ( $INSTALLED_CONFIG_FNAME !~ /__KOHA_CONF_DIR/ and -s $INSTALLED_CONFIG_FNAME ) {
 151         # NOTE: be careful -- don't change __KOHA_CONF_DIR in the above
 152         # regex to anything else -- don't want installer to rewrite it
 153         $conf_fname = $INSTALLED_CONFIG_FNAME;
 154     } elsif ( -s CONFIG_FNAME ) {
 155         $conf_fname = CONFIG_FNAME;
 156     }
 157     return $conf_fname;
 158 }
 159
 160 =head1 INSTANCE METHODS
 161
 162 =head2 get
 163
 164     $value = $config->get($key);
 165     $value = $config->get($key, $section);
 166
 167 Returns the configuration entry corresponding to C<$key> and C<$section>.
 168 The returned value can be a string, an arrayref or a hashref.
 169 If C<$key> is not found, it returns undef.
 170
 171 C<$section> can be one of 'listen', 'server', 'serverinfo', 'config'.
 172 If not given, C<$section> defaults to 'config'.
 173
 174 =cut
 175
 176 sub get {
 177     my ($self, $key, $section) = @_;
 178
 179     $section //= 'config';
 180
 181     my $value;
 182     if (exists $self->{$section} and exists $self->{$section}->{$key}) {
 183         $value = $self->{$section}->{$key};
 184     }
 185
 186     return $value;
 187 }
 188
 189 =head2 timezone
 190
 191   $timezone = $config->timezone
 192
 193   Returns the configured timezone. If not configured or invalid, it returns
 194   'local'.
 195
 196 =cut
 197
 198 sub timezone {
 199     my ($self) = @_;
 200
 201     my $timezone = $self->get('timezone') || $ENV{TZ};
 202     if ($timezone) {
 203         require DateTime::TimeZone;
 204         if ( !DateTime::TimeZone->is_valid_name( $timezone ) ) {
 205             warn "Invalid timezone in koha-conf.xml ($timezone)";
 206             $timezone = 'local';
 207         }
 208     } else {
 209         $timezone = 'local';
 210     }
 211
 212     return $timezone;
 213 }
 214
 215
 216 sub _read_from_dom_node {
 217     my ($class, $node, $config) = @_;
 218
 219     if ($node->nodeType == XML_TEXT_NODE) {
 220         $config->{content} = $node->textContent;
 221     } elsif ($node->nodeType == XML_ELEMENT_NODE) {
 222         my $subconfig = {};
 223
 224         foreach my $attribute ($node->attributes) {
 225             my $key = $attribute->nodeName;
 226             my $value = $attribute->value;
 227             $subconfig->{$key} = $value;
 228         }
 229
 230         foreach my $childNode ($node->nonBlankChildNodes) {
 231             $class->_read_from_dom_node($childNode, $subconfig);
 232         }
 233
 234         my $key = $node->nodeName;
 235         if ($node->hasAttribute('id')) {
 236             my $id = $node->getAttribute('id');
 237             $config->{$key} //= {};
 238             $config->{$key}->{$id} = $subconfig;
 239             delete $subconfig->{id};
 240         } else {
 241             my @keys = keys %$subconfig;
 242             if (1 == scalar @keys && $keys[0] eq 'content') {
 243                 # An element with no attributes and no child elements becomes its text content
 244                 $subconfig = $subconfig->{content};
 245             } elsif (0 == scalar @keys) {
 246                 # An empty element becomes an empty string
 247                 $subconfig = '';
 248             }
 249
 250             if (exists $config->{$key}) {
 251                 unless (ref $config->{$key} eq 'ARRAY') {
 252                     $config->{$key} = [$config->{$key}];
 253                 }
 254                 push @{ $config->{$key} }, $subconfig;
 255             } else {
 256                 if (grep { $_ eq $key } (qw(listen server serverinfo))) {
 257                     # <listen>, <server> and <serverinfo> are always arrays
 258                     $config->{$key} = [$subconfig];
 259                 } else {
 260                     $config->{$key} = $subconfig;
 261                 }
 262             }
 263         }
 264     }
 265 }
 266
 267 1;