X-Git-Url: http://koha-dev.rot13.org:8081/gitweb/?a=blobdiff_plain;f=Koha%2FConfig.pm;h=eb0671dc2e6172aa6b30467f86278535b2e5b990;hb=075ef09f48b66df7766c22e1c9ecf1d3cf7a039a;hp=b0f36f25515f58c796f8a85f6461985b6c4527a8;hpb=252c7c06b30a0f42aa523752e6e3aef02f16af41;p=srvgit

diff --git a/Koha/Config.pm b/Koha/Config.pm
index b0f36f2551..eb0671dc2e 100644
--- a/Koha/Config.pm
+++ b/Koha/Config.pm
@@ -15,9 +15,30 @@ package Koha::Config;
 # You should have received a copy of the GNU General Public License
 # along with Koha; if not, see <http://www.gnu.org/licenses>.
 
+=head1 NAME
+
+Koha::Config - Read Koha configuration file
+
+=head1 SYNOPSIS
+
+    use Koha::Config;
+
+    my $config = Koha::Config->get_instance;
+    my $database = $config->get('database');
+    my $serverinfo = $config->get('biblioserver', 'serverinfo');
+
+    my $otherconfig = Koha::Config->get_instance('/path/to/other/koha-conf.xml');
+
+=head1 DESCRIPTION
+
+Koha::Config is a helper module for reading configuration variables from the
+main Koha configuration file ($KOHA_CONF)
+
+=cut
+
 use Modern::Perl;
 
-use XML::Simple;
+use XML::LibXML qw( XML_ELEMENT_NODE XML_TEXT_NODE );
 
 # Default config file, if none is specified
 use constant CONFIG_FNAME => "/etc/koha/koha-conf.xml";
@@ -30,43 +51,94 @@ use constant CONFIG_FNAME => "/etc/koha/koha-conf.xml";
 # developers should set the KOHA_CONF environment variable
 my $INSTALLED_CONFIG_FNAME = '__KOHA_CONF_DIR__/koha-conf.xml';
 
-# Should not be called outside of C4::Context or Koha::Cache
-# use C4::Context->config instead
+=head1 CLASS METHODS
+
+=head2 get_instance
+
+    $config = Koha::Config->get_instance;
+    $config = Koha::Config->get_instance($file);
+
+Reads C<$file> and returns the corresponding C<Koha::Config> object.
+
+If C<$file> is not given (or undef) it defaults to the result of
+C<Koha::Config-E<gt>guess_koha_conf>.
+
+Multiple calls with the same arguments will return the same object, and the
+file will be read only the first time.
+
+=cut
+
+our %configs;
+
+sub get_instance {
+    my ($class, $file) = @_;
+
+    $file //= $class->guess_koha_conf;
+
+    unless (exists $configs{$file}) {
+        $configs{$file} = $class->read_from_file($file);
+    }
+
+    return $configs{$file};
+}
+
+=head2 read_from_file
+
+    $config = Koha::Config->read_from_file($file);
+
+Reads C<$file> and returns the corresponding C<Koha::Config> object.
+
+Unlike C<get_instance>, this method will read the file at every call, so use it
+carefully. In most cases, you should use C<get_instance> instead.
+
+=cut
+
 sub read_from_file {
     my ( $class, $file ) = @_;
 
     return if not defined $file;
 
-    my $xml;
+    my $config = {};
     eval {
-        $xml = XMLin(
-            $file,
-            keyattr => ['id'],
-            forcearray => ['listen', 'server', 'serverinfo'],
-            suppressempty => ''
-        );
+        my $dom = XML::LibXML->load_xml(location => $file);
+        foreach my $childNode ($dom->documentElement->nonBlankChildNodes) {
+            $class->_read_from_dom_node($childNode, $config);
+        }
     };
 
     if ($@) {
         die "\nError reading file $file.\nTry running this again as the koha instance user (or use the koha-shell command in debian)\n\n";
     }
 
-    return $xml;
+    return bless $config, $class;
 }
 
-# Koha's main configuration file koha-conf.xml
-# is searched for according to this priority list:
-#
-# 1. Path supplied via use C4::Context '/path/to/koha-conf.xml'
-# 2. Path supplied in KOHA_CONF environment variable.
-# 3. Path supplied in INSTALLED_CONFIG_FNAME, as long
-#    as value has changed from its default of
-#    '__KOHA_CONF_DIR__/koha-conf.xml', as happens
-#    when Koha is installed in 'standard' or 'single'
-#    mode.
-# 4. Path supplied in CONFIG_FNAME.
-#
-# The first entry that refers to a readable file is used.
+=head2 guess_koha_conf
+
+    $file = Koha::Config->guess_koha_conf;
+
+Returns the path to Koha main configuration file.
+
+Koha's main configuration file koha-conf.xml is searched for according to this
+priority list:
+
+=over
+
+=item 1. Path supplied via use C4::Context '/path/to/koha-conf.xml'
+
+=item 2. Path supplied in KOHA_CONF environment variable.
+
+=item 3. Path supplied in INSTALLED_CONFIG_FNAME, as long as value has changed
+from its default of '__KOHA_CONF_DIR__/koha-conf.xml', as happens when Koha is
+installed in 'standard' or 'single' mode.
+
+=item 4. Path supplied in CONFIG_FNAME.
+
+=back
+
+The first entry that refers to a readable file is used.
+
+=cut
 
 sub guess_koha_conf {
 
@@ -85,4 +157,111 @@ sub guess_koha_conf {
     return $conf_fname;
 }
 
+=head1 INSTANCE METHODS
+
+=head2 get
+
+    $value = $config->get($key);
+    $value = $config->get($key, $section);
+
+Returns the configuration entry corresponding to C<$key> and C<$section>.
+The returned value can be a string, an arrayref or a hashref.
+If C<$key> is not found, it returns undef.
+
+C<$section> can be one of 'listen', 'server', 'serverinfo', 'config'.
+If not given, C<$section> defaults to 'config'.
+
+=cut
+
+sub get {
+    my ($self, $key, $section) = @_;
+
+    $section //= 'config';
+
+    my $value;
+    if (exists $self->{$section} and exists $self->{$section}->{$key}) {
+        $value = $self->{$section}->{$key};
+    }
+
+    return $value;
+}
+
+=head2 timezone
+
+  $timezone = $config->timezone
+
+  Returns the configured timezone. If not configured or invalid, it returns
+  'local'.
+
+=cut
+
+sub timezone {
+    my ($self) = @_;
+
+    my $timezone = $self->get('timezone') || $ENV{TZ};
+    if ($timezone) {
+        require DateTime::TimeZone;
+        if ( !DateTime::TimeZone->is_valid_name( $timezone ) ) {
+            warn "Invalid timezone in koha-conf.xml ($timezone)";
+            $timezone = 'local';
+        }
+    } else {
+        $timezone = 'local';
+    }
+
+    return $timezone;
+}
+
+
+sub _read_from_dom_node {
+    my ($class, $node, $config) = @_;
+
+    if ($node->nodeType == XML_TEXT_NODE) {
+        $config->{content} = $node->textContent;
+    } elsif ($node->nodeType == XML_ELEMENT_NODE) {
+        my $subconfig = {};
+
+        foreach my $attribute ($node->attributes) {
+            my $key = $attribute->nodeName;
+            my $value = $attribute->value;
+            $subconfig->{$key} = $value;
+        }
+
+        foreach my $childNode ($node->nonBlankChildNodes) {
+            $class->_read_from_dom_node($childNode, $subconfig);
+        }
+
+        my $key = $node->nodeName;
+        if ($node->hasAttribute('id')) {
+            my $id = $node->getAttribute('id');
+            $config->{$key} //= {};
+            $config->{$key}->{$id} = $subconfig;
+            delete $subconfig->{id};
+        } else {
+            my @keys = keys %$subconfig;
+            if (1 == scalar @keys && $keys[0] eq 'content') {
+                # An element with no attributes and no child elements becomes its text content
+                $subconfig = $subconfig->{content};
+            } elsif (0 == scalar @keys) {
+                # An empty element becomes an empty string
+                $subconfig = '';
+            }
+
+            if (exists $config->{$key}) {
+                unless (ref $config->{$key} eq 'ARRAY') {
+                    $config->{$key} = [$config->{$key}];
+                }
+                push @{ $config->{$key} }, $subconfig;
+            } else {
+                if (grep { $_ eq $key } (qw(listen server serverinfo))) {
+                    # <listen>, <server> and <serverinfo> are always arrays
+                    $config->{$key} = [$subconfig];
+                } else {
+                    $config->{$key} = $subconfig;
+                }
+            }
+        }
+    }
+}
+
 1;