From a892f655efae77b302c9cd5978d4881eac14589c Mon Sep 17 00:00:00 2001 From: Julian Maurice Date: Fri, 30 Apr 2021 17:13:48 +0200 Subject: [PATCH] Bug 28278: Improve $KOHA_CONF parsing speed by using XML::LibXML MIME-Version: 1.0 Content-Type: text/plain; charset=utf8 Content-Transfer-Encoding: 8bit - Without the patch: $ hyperfine --warmup 1 \ 'perl -MKoha::Config -e "Koha::Config->read_from_file(\$ENV{KOHA_CONF}) for (1..1000)"' Time (mean ± σ): 3.585 s ± 0.018 s [User: 3.531 s, System: 0.049 s] Range (min … max): 3.547 s … 3.612 s 10 runs - With the patch: $ hyperfine --warmup 1 \ 'perl -MKoha::Config -e "Koha::Config->read_from_file(\$ENV{KOHA_CONF}) for (1..1000)"' Time (mean ± σ): 1.122 s ± 0.028 s [User: 1.104 s, System: 0.014 s] Range (min … max): 1.095 s … 1.189 s 10 runs Test plan: 1. Apply the first patch (the one with the unit tests) and make sure tests pass: `prove t/Koha/Config.t` 2. Apply the rest of the patches and verify that tests still pass: `prove t/Koha/Config.t`. Signed-off-by: Victor Grousset/tuxayo Signed-off-by: Martin Renvoize Signed-off-by: Jonathan Druart --- Koha/Config.pm | 67 +++++++++++++++++++++++++++++++++++++++++++------- 1 file changed, 58 insertions(+), 9 deletions(-) diff --git a/Koha/Config.pm b/Koha/Config.pm index b0f36f2551..3e46e2728d 100644 --- a/Koha/Config.pm +++ b/Koha/Config.pm @@ -17,7 +17,7 @@ package Koha::Config; use Modern::Perl; -use XML::Simple; +use XML::LibXML ':libxml'; # Default config file, if none is specified use constant CONFIG_FNAME => "/etc/koha/koha-conf.xml"; @@ -37,21 +37,70 @@ sub read_from_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 $config; +} + +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))) { + # , and are always arrays + $config->{$key} = [$subconfig]; + } else { + $config->{$key} = $subconfig; + } + } + } + } } # Koha's main configuration file koha-conf.xml -- 2.39.5