Attachment 120794 Details for Bug 28306 – Bug 28306: Allow to query database with minimal memory footprint

[patch] Bug 28306: Allow to query database with minimal memory footprint

Bug-28306-Allow-to-query-database-with-minimal-mem.patch (text/plain), 26.61 KB, created by Martin Renvoize (ashimema) on 2021-05-10 14:11:34 UTC

(hide)

Description:

Filename:

MIME Type:

Creator: Martin Renvoize (ashimema)

Created: 2021-05-10 14:11:34 UTC

Size: 26.61 KB

patch

obsolete

>From 7e8f7937911ac473243460aa5b8a36263df35950 Mon Sep 17 00:00:00 2001
>From: Julian Maurice <julian.maurice@biblibre.com>
>Date: Mon, 10 May 2021 08:54:35 +0200
>Subject: [PATCH] Bug 28306: Allow to query database with minimal memory
> footprint
>
>The goal is to be able to build a database handler (dbh) and to execute
>queries without loading unnecessary stuff. This will be useful to reduce
>memory usage of daemons that need to check the database
>periodically
>
>The patch provides a new method Koha::Database::dbh which returns a
>database handler without loading the DBIx::Class schema. This method is
>also used by DBIx::Class, so whether you use DBI or DBIx::Class, the
>same method is used to initialize the connection.
>
>The patch also moves some code in order to avoid loading C4::Context:
>- C4::Context::timezone moves to Koha::Config
>- C4::Context::db_scheme2dbi moves to Koha::Database
>
>To measure memory usage I used the following commands:
>
>* before the patch:
>perl -MKoha::Database \
>    -E 'Koha::Database->schema->storage->dbh->do("select 1");' \
>    -E '$|=1; say $$; sleep 2' \
>    | while read pid; do ps -p $pid -o rss=; done
>
>* after the patch:
>perl -MKoha::Database \
>    -E 'Koha::Database->dbh->do("select 1");' \
>    -E '$|=1; say $$; sleep 2' \
>    | while read pid; do ps -p $pid -o rss=; done
>
>It will give you the RSS (Resident Set Size) of the perl process in kB
>
>What I get:
>* before the patch: between 96.9MB and 97.2MB
>* after the patch: between 17.8MB and 18.2MB
>
>Note that if a timezone is configured (either from $KOHA_CONF or
>TZ environment variable), Koha will load DateTime::Timezone to check if
>it's valid, and it increases RSS to 36MB
>
>Another interesting metric is the number of modules loaded:
>* before the patch:
>perl -MKoha::Database \
>    -E 'Koha::Database->schema->storage->dbh;' \
>    -E 'say scalar keys %INC'
>
>Result: 567
>
>* after the patch:
>perl -MKoha::Database \
>    -E 'Koha::Database->dbh;' \
>    -E 'say scalar keys %INC'
>
>Result: 51
>
>Test plan:
>1. Apply the patch & restart starman
>2. Make sure Koha is still ok (ie. can access the database, does not
>have encoding issues, ...)
>3. Run the tests in t/Context.t, t/Koha/Config.t,
>t/db_dependent/Koha/Database.t, t/timezones.t
>
>Signed-off-by: Martin Renvoize <martin.renvoize@ptfs-europe.com>
>---
> C4/Context.pm                  |  78 +++----------
> Koha/Config.pm                 | 198 +++++++++++++++++++++++++++------
> Koha/Database.pm               | 165 ++++++++++++++++-----------
> t/Context.t                    |   7 +-
> t/Koha/Config.t                |  60 +++++++++-
> t/db_dependent/Koha/Database.t |  11 +-
> t/lib/Mocks.pm                 |   6 +-
> t/timezones.t                  |  12 +-
> 8 files changed, 358 insertions(+), 179 deletions(-)
>
>diff --git a/C4/Context.pm b/C4/Context.pm
>index c0e518a8bc..dd65346c3f 100644
>--- a/C4/Context.pm
>+++ b/C4/Context.pm
>@@ -119,22 +119,6 @@ environment variable to the pathname of a configuration file to use.
> $context = undef;        # Initially, no context is set
> @context_stack = ();        # Initially, no saved contexts
> 
>-=head2 db_scheme2dbi
>-
>-    my $dbd_driver_name = C4::Context::db_schema2dbi($scheme);
>-
>-This routines translates a database type to part of the name
>-of the appropriate DBD driver to use when establishing a new
>-database connection.  It recognizes 'mysql' and 'Pg'; if any
>-other scheme is supplied it defaults to 'mysql'.
>-
>-=cut
>-
>-sub db_scheme2dbi {
>-    my $scheme = shift // '';
>-    return $scheme eq 'Pg' ? $scheme : 'mysql';
>-}
>-
> sub import {
>     # Create the default context ($C4::Context::Context)
>     # the first time the module is called
>@@ -190,8 +174,9 @@ sub new {
>         }
>     }
> 
>-    my $self = Koha::Config->read_from_file($conf_fname);
>-    unless ( exists $self->{config} or defined $self->{config} ) {
>+    my $self = {};
>+    $self->{config} = Koha::Config->get_instance($conf_fname);
>+    unless ( defined $self->{config} ) {
>         warn "The config file ($conf_fname) has not been parsed correctly";
>         return;
>     }
>@@ -203,7 +188,6 @@ sub new {
>     $self->{tz} = undef; # local timezone object
> 
>     bless $self, $class;
>-    $self->{db_driver} = db_scheme2dbi($self->config('db_scheme'));  # cache database driver
>     return $self;
> }
> 
>@@ -285,28 +269,17 @@ sub restore_context
> 
>   $value = C4::Context->config("config_variable");
> 
>-  $value = C4::Context->config_variable;
>-
> Returns the value of a variable specified in the configuration file
> from which the current context was created.
> 
>-The second form is more compact, but of course may conflict with
>-method names. If there is a configuration variable called "new", then
>-C<C4::Config-E<gt>new> will not return it.
>-
> =cut
> 
> sub _common_config {
>-	my $var = shift;
>-	my $term = shift;
>-    return unless defined $context and defined $context->{$term};
>-       # Presumably $self->{$term} might be
>-       # undefined if the config file given to &new
>-       # didn't exist, and the caller didn't bother
>-       # to check the return value.
>-
>-    # Return the value of the requested config variable
>-    return $context->{$term}->{$var};
>+    my ($var, $term) = @_;
>+
>+    return unless defined $context and defined $context->{config};
>+
>+    return $context->{config}->get($var, $term);
> }
> 
> sub config {
>@@ -560,20 +533,21 @@ sub _new_Zconn {
>     $syntax = 'xml';
>     $elementSetName = 'marcxml';
> 
>-    my $host = $context->{'listen'}->{$server}->{'content'};
>-    my $user = $context->{"serverinfo"}->{$server}->{"user"};
>-    my $password = $context->{"serverinfo"}->{$server}->{"password"};
>+    my $host = _common_config($server, 'listen')->{content};
>+    my $serverinfo = _common_config($server, 'serverinfo');
>+    my $user = $serverinfo->{user};
>+    my $password = $serverinfo->{password};
>     eval {
>         # set options
>         my $o = ZOOM::Options->new();
>         $o->option(user => $user) if $user && $password;
>         $o->option(password => $password) if $user && $password;
>         $o->option(async => 1) if $async;
>-        $o->option(cqlfile=> $context->{"server"}->{$server}->{"cql2rpn"});
>-        $o->option(cclfile=> $context->{"serverinfo"}->{$server}->{"ccl2rpn"});
>+        $o->option(cqlfile=> _common_config($server, 'server')->{cql2rpn});
>+        $o->option(cclfile=> $serverinfo->{ccl2rpn});
>         $o->option(preferredRecordSyntax => $syntax);
>         $o->option(elementSetName => $elementSetName) if $elementSetName;
>-        $o->option(databaseName => $context->{"config"}->{$server}||"biblios");
>+        $o->option(databaseName => _common_config($server, 'config') || 'biblios');
> 
>         # create a new connection object
>         $Zconn= create ZOOM::Connection($o);
>@@ -858,26 +832,6 @@ sub get_versions {
>     return %versions;
> }
> 
>-=head2 timezone
>-
>-  my $C4::Context->timzone
>-
>-  Returns a timezone code for the instance of Koha
>-
>-=cut
>-
>-sub timezone {
>-    my $self = shift;
>-
>-    my $timezone = C4::Context->config('timezone') || $ENV{TZ} || 'local';
>-    if ( !DateTime::TimeZone->is_valid_name( $timezone ) ) {
>-        warn "Invalid timezone in koha-conf.xml ($timezone)";
>-        $timezone = 'local';
>-    }
>-
>-    return $timezone;
>-}
>-
> =head2 tz
> 
>   C4::Context->tz
>@@ -889,7 +843,7 @@ sub timezone {
> sub tz {
>     my $self = shift;
>     if (!defined $context->{tz}) {
>-        my $timezone = $self->timezone;
>+        my $timezone = $context->{config}->timezone;
>         $context->{tz} = DateTime::TimeZone->new(name => $timezone);
>     }
>     return $context->{tz};
>diff --git a/Koha/Config.pm b/Koha/Config.pm
>index face2fc11f..a19db2dae3 100644
>--- a/Koha/Config.pm
>+++ b/Koha/Config.pm
>@@ -15,6 +15,27 @@ 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::LibXML ':libxml';
>@@ -30,8 +51,48 @@ 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
>-# 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 ) = @_;
> 
>@@ -49,9 +110,109 @@ sub read_from_file {
>         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 $config;
>+    return bless $config, $class;
>+}
>+
>+=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 {
>+
>+    # If the $KOHA_CONF environment variable is set, use
>+    # that. Otherwise, use the built-in default.
>+    my $conf_fname;
>+    if ( exists $ENV{"KOHA_CONF"} and $ENV{'KOHA_CONF'} and -s $ENV{"KOHA_CONF"} ) {
>+        $conf_fname = $ENV{"KOHA_CONF"};
>+    } elsif ( $INSTALLED_CONFIG_FNAME !~ /__KOHA_CONF_DIR/ and -s $INSTALLED_CONFIG_FNAME ) {
>+        # NOTE: be careful -- don't change __KOHA_CONF_DIR in the above
>+        # regex to anything else -- don't want installer to rewrite it
>+        $conf_fname = $INSTALLED_CONFIG_FNAME;
>+    } elsif ( -s CONFIG_FNAME ) {
>+        $conf_fname = CONFIG_FNAME;
>+    }
>+    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) = @_;
> 
>@@ -103,35 +264,4 @@ sub _read_from_dom_node {
>     }
> }
> 
>-# 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.
>-
>-sub guess_koha_conf {
>-
>-    # If the $KOHA_CONF environment variable is set, use
>-    # that. Otherwise, use the built-in default.
>-    my $conf_fname;
>-    if ( exists $ENV{"KOHA_CONF"} and $ENV{'KOHA_CONF'} and -s $ENV{"KOHA_CONF"} ) {
>-        $conf_fname = $ENV{"KOHA_CONF"};
>-    } elsif ( $INSTALLED_CONFIG_FNAME !~ /__KOHA_CONF_DIR/ and -s $INSTALLED_CONFIG_FNAME ) {
>-        # NOTE: be careful -- don't change __KOHA_CONF_DIR in the above
>-        # regex to anything else -- don't want installer to rewrite it
>-        $conf_fname = $INSTALLED_CONFIG_FNAME;
>-    } elsif ( -s CONFIG_FNAME ) {
>-        $conf_fname = CONFIG_FNAME;
>-    }
>-    return $conf_fname;
>-}
>-
> 1;
>diff --git a/Koha/Database.pm b/Koha/Database.pm
>index df4d45ce7b..2dc5101a83 100644
>--- a/Koha/Database.pm
>+++ b/Koha/Database.pm
>@@ -25,21 +25,89 @@ Koha::Database
> =head1 SYNOPSIS
> 
>   use Koha::Database;
>-  my $database = Koha::Database->new();
>-  my $schema = $database->schema();
>+  my $schema = Koha::Database->schema();
> 
> =head1 FUNCTIONS
> 
> =cut
> 
> use Modern::Perl;
>-use Carp;
>-use C4::Context;
>-use base qw(Class::Accessor);
>+use DBI;
>+use Koha::Config;
>+
>+our $database;
>+
>+# FIXME: It is useless to have a Koha::Database object since all methods
>+# below act as class methods
>+# Koha::Database->new->schema is exactly the same as Koha::Database->schema
>+# We should use Koha::Database->schema everywhere and remove the `new` method
>+sub new { bless {}, shift }
>+
>+sub dbh {
>+    my $config = Koha::Config->get_instance;
>+    my $driver = db_scheme2dbi($config->get('db_scheme'));
>+    my $user = $config->get("user"),
>+    my $pass = $config->get("pass"),
>+    my $dsn = sprintf(
>+        'dbi:%s:database=%s;host=%s;port=%s',
>+        $driver,
>+        $config->get("database"),
>+        $config->get("hostname"),
>+        $config->get("port") || '',
>+    );
>+
>+    my $attr = {
>+        RaiseError => 1,
>+        PrintError => 1,
>+    };
>+
>+    if ($driver eq 'mysql') {
>+        my $tls = $config->get("tls");
>+        if ($tls && $tls eq 'yes') {
>+            $dsn .= sprintf(
>+                ';mysql_ssl=1;mysql_ssl_client_key=%s;mysql_ssl_client_cert=%s;mysql_ssl_ca_file=%s',
>+                $config->get('key'),
>+                $config->get('cert'),
>+                $config->get('ca'),
>+            );
>+        }
>+
>+        $attr->{mysql_enable_utf8} = 1;
>+    }
>+
>+    my $dbh = DBI->connect($dsn, $user, $pass, $attr);
>+
>+    if ($dbh) {
>+        my @queries;
>+        my $tz = $config->timezone;
>+        $tz = '' if $tz eq 'local';
>+
>+        if ($driver eq 'mysql') {
>+            push @queries, "SET NAMES 'utf8mb4'";
>+            push @queries, qq{SET time_zone = "$tz"} if $tz;
>+            if (   $config->get('strict_sql_modes')
>+                || ( exists $ENV{_} && $ENV{_} =~ m|prove| )
>+                || $ENV{KOHA_TESTING}
>+            ) {
>+                push @queries, q{
>+                    SET sql_mode = 'ONLY_FULL_GROUP_BY,STRICT_TRANS_TABLES,NO_ZERO_IN_DATE,NO_ZERO_DATE,ERROR_FOR_DIVISION_BY_ZERO,NO_ENGINE_SUBSTITUTION'
>+                };
>+            } else {
>+                push @queries, q{SET sql_mode = 'IGNORE_SPACE,NO_ZERO_IN_DATE,NO_ZERO_DATE,ERROR_FOR_DIVISION_BY_ZERO,NO_ENGINE_SUBSTITUTION'}
>+            }
>+        } elsif ($driver eq 'Pg') {
>+            push @queries, qq{SET TIME ZONE = "$tz"} if $tz;
>+            push @queries, q{set client_encoding = 'UTF8'};
>+        }
>+
>+        foreach my $query (@queries) {
>+            $dbh->do($query);
>+        }
>+    }
> 
>-use vars qw($database);
>+    return $dbh;
>+}
> 
>-__PACKAGE__->mk_accessors(qw( ));
> 
> # _new_schema
> # Internal helper function (not a method!). This creates a new
>@@ -49,62 +117,11 @@ sub _new_schema {
> 
>     require Koha::Schema;
> 
>-    my $db_driver = C4::Context::db_scheme2dbi(C4::Context->config('db_scheme'));;
>-
>-    my $db_name   = C4::Context->config("database");
>-    my $db_host   = C4::Context->config("hostname");
>-    my $db_port   = C4::Context->config("port") || '';
>-    my $db_user   = C4::Context->config("user");
>-    my $db_passwd = C4::Context->config("pass");
>-    my $tls = C4::Context->config("tls");
>-    my $tls_options;
>-    if( $tls && $tls eq 'yes' ) {
>-        my $ca = C4::Context->config('ca');
>-        my $cert = C4::Context->config('cert');
>-        my $key = C4::Context->config('key');
>-        $tls_options = ";mysql_ssl=1;mysql_ssl_client_key=".$key.";mysql_ssl_client_cert=".$cert.";mysql_ssl_ca_file=".$ca;
>-    }
>-
>-
>-
>-    my ( %encoding_attr, $encoding_query, $tz_query, $sql_mode_query );
>-    my $tz = C4::Context->timezone;
>-    $tz = q{} if ( $tz eq 'local' );
>-    if ( $db_driver eq 'mysql' ) {
>-        %encoding_attr = ( mysql_enable_utf8 => 1 );
>-        $encoding_query = "set NAMES 'utf8mb4'";
>-        $tz_query = qq(SET time_zone = "$tz") if $tz;
>-        if (   C4::Context->config('strict_sql_modes')
>-            || ( exists $ENV{_} && $ENV{_} =~ m|prove| )
>-            || $ENV{KOHA_TESTING}
>-        ) {
>-            $sql_mode_query = q{SET sql_mode = 'ONLY_FULL_GROUP_BY,STRICT_TRANS_TABLES,NO_ZERO_IN_DATE,NO_ZERO_DATE,ERROR_FOR_DIVISION_BY_ZERO,NO_ENGINE_SUBSTITUTION'};
>-        } else {
>-            $sql_mode_query = q{SET sql_mode = 'IGNORE_SPACE,NO_ZERO_IN_DATE,NO_ZERO_DATE,ERROR_FOR_DIVISION_BY_ZERO,NO_ENGINE_SUBSTITUTION'};
>-        }
>-    }
>-    elsif ( $db_driver eq 'Pg' ) {
>-        $encoding_query = "set client_encoding = 'UTF8';";
>-        $tz_query = qq(SET TIME ZONE = "$tz") if $tz;
>-    }
>-
>-    my $schema = Koha::Schema->connect(
>-        {
>-            dsn => "dbi:$db_driver:database=$db_name;host=$db_host;port=$db_port".($tls_options? $tls_options : ""),
>-            user => $db_user,
>-            password => $db_passwd,
>-            %encoding_attr,
>-            RaiseError => 1,
>-            PrintError => 1,
>-            quote_names => 1,
>-            auto_savepoint => 1,
>-            on_connect_do => [
>-                $encoding_query || (),
>-                $tz_query || (),
>-                $sql_mode_query || (),
>-            ]
>-        }
>-    );
>+    my $schema = Koha::Schema->connect({
>+        dbh_maker => \&Koha::Database::dbh,
>+        quote_names => 1,
>+        auto_savepoint => 1,
>+    });
> 
>     my $dbh = $schema->storage->dbh;
>     eval {
>@@ -127,7 +144,8 @@ sub _new_schema {
> 
> =head2 schema
> 
>-    $schema = $database->schema;
>+    $schema = Koha::Database->schema;
>+    $schema = Koha::Database->schema({ new => 1 });
> 
> Returns a database handle connected to the Koha database for the
> current context. If no connection has yet been made, this method
>@@ -141,8 +159,7 @@ possibly C<&set_schema>.
> =cut
> 
> sub schema {
>-    my $self = shift;
>-    my $params = shift;
>+    my ($class, $params) = @_;
> 
>     unless ( $params->{new} ) {
>         return $database->{schema} if defined $database->{schema};
>@@ -243,6 +260,22 @@ sub flush_schema_cache {
>     return 1;
> }
> 
>+=head2 db_scheme2dbi
>+
>+    my $dbd_driver_name = Koha::Database::db_scheme2dbi($scheme);
>+
>+This routines translates a database type to part of the name
>+of the appropriate DBD driver to use when establishing a new
>+database connection.  It recognizes 'mysql' and 'Pg'; if any
>+other scheme is supplied it defaults to 'mysql'.
>+
>+=cut
>+
>+sub db_scheme2dbi {
>+    my $scheme = shift // '';
>+    return $scheme eq 'Pg' ? $scheme : 'mysql';
>+}
>+
> =head2 EXPORT
> 
> None by default.
>diff --git a/t/Context.t b/t/Context.t
>index 8bff644cd5..156ae778bb 100755
>--- a/t/Context.t
>+++ b/t/Context.t
>@@ -18,7 +18,7 @@
> use Modern::Perl;
> 
> use DBI;
>-use Test::More tests => 35;
>+use Test::More tests => 31;
> use Test::MockModule;
> use Test::Warn;
> use YAML::XS;
>@@ -95,11 +95,6 @@ $is_super_librarian = eval{ C4::Context::IsSuperLibrarian() };
> is ( $@, q||, "IsSuperLibrarian does not log an error if \$userenv->{flags} is equal to 0" );
> is ( $is_super_librarian, 0, "With flag=0, it is not a super librarian" );
> 
>-is(C4::Context::db_scheme2dbi('mysql'), 'mysql', 'ask for mysql, get mysql');
>-is(C4::Context::db_scheme2dbi('Pg'),    'Pg',    'ask for Pg, get Pg');
>-is(C4::Context::db_scheme2dbi('xxx'),   'mysql', 'ask for unsupported DBMS, get mysql');
>-is(C4::Context::db_scheme2dbi(),        'mysql', 'ask for nothing, get mysql');
>-
> # C4::Context::interface
> my $lastwarn;
> local $SIG{__WARN__} = sub { $lastwarn = $_[0] };
>diff --git a/t/Koha/Config.t b/t/Koha/Config.t
>index 5493b098ca..0c847a1e3f 100755
>--- a/t/Koha/Config.t
>+++ b/t/Koha/Config.t
>@@ -17,7 +17,7 @@
> 
> use Modern::Perl;
> 
>-use Test::More tests => 2;
>+use Test::More tests => 4;
> use FindBin qw($Bin $Script);
> 
> use_ok('Koha::Config');
>@@ -235,3 +235,61 @@ subtest 'read_from_file() tests' => sub {
>     like( $@, qr{.*Error reading file.*}, 'File failing to read raises warning');
> };
> 
>+subtest 'get_instance' => sub {
>+    plan tests => 3;
>+
>+    my $config = Koha::Config->get_instance($config_filepath);
>+    isa_ok($config, 'Koha::Config', 'get_instance returns a Koha::Config object');
>+    my $same_config = Koha::Config->get_instance($config_filepath);
>+    is($config, $same_config, '2nd call to get_instance returns the same object');
>+
>+    local $ENV{KOHA_CONF} = $config_filepath;
>+    my $default_config = Koha::Config->get_instance;
>+    is($default_config, $config, 'get_instance without parameters reads $KOHA_CONF');
>+};
>+
>+subtest 'get' => sub {
>+    plan tests => 7;
>+
>+    my $config = Koha::Config->get_instance($config_filepath);
>+
>+    is_deeply(
>+        $config->get('biblioserver', 'listen'),
>+        { content => 'unix:/home/koha/var/run/zebradb/bibliosocket' },
>+    );
>+
>+    is_deeply(
>+        $config->get('biblioserver', 'server'),
>+        {
>+            'listenref' => 'biblioserver',
>+            'directory' => '/home/koha/var/lib/zebradb/biblios',
>+            'config' => '/home/koha/etc/zebradb/zebra-biblios-dom.cfg',
>+            'cql2rpn' => '/home/koha/etc/zebradb/pqf.properties',
>+            'xi:include' => [
>+                {
>+                    'href' => '/home/koha/etc/zebradb/retrieval-info-bib-dom.xml',
>+                    'xmlns:xi' => 'http://www.w3.org/2001/XInclude'
>+                },
>+                {
>+                    'xmlns:xi' => 'http://www.w3.org/2001/XInclude',
>+                    'href' => '/home/koha/etc/zebradb/explain-biblios.xml'
>+                }
>+            ],
>+        },
>+    );
>+
>+    is_deeply(
>+        $config->get('biblioserver', 'serverinfo'),
>+        {
>+            'ccl2rpn' => '/home/koha/etc/zebradb/ccl.properties',
>+            'user' => 'kohauser',
>+            'password' => 'zebrastripes',
>+        },
>+    );
>+
>+    is($config->get('db_scheme'), 'mysql');
>+    is($config->get('ca'), '');
>+
>+    is($config->get('unicorn'), undef, 'returns undef if key does not exist');
>+    is_deeply([$config->get('unicorn')], [undef], 'returns undef even in list context');
>+};
>diff --git a/t/db_dependent/Koha/Database.t b/t/db_dependent/Koha/Database.t
>index 2da6a3c7a1..8f8f124065 100755
>--- a/t/db_dependent/Koha/Database.t
>+++ b/t/db_dependent/Koha/Database.t
>@@ -16,7 +16,7 @@
> # along with Koha; if not, see <http://www.gnu.org/licenses>.
> 
> use Modern::Perl;
>-use Test::More tests => 2;
>+use Test::More tests => 3;
> use C4::Context;
> 
> my $dbh = C4::Context->dbh;
>@@ -24,3 +24,12 @@ my $sql_mode = $dbh->selectrow_array(q|SELECT @@SQL_MODE|);
> like( $sql_mode, qr{STRICT_TRANS_TABLES}, 'Strict SQL modes must be turned on for tests' );
> 
> is( $dbh->{RaiseError}, 1, 'RaiseError must be turned on for tests' );
>+
>+subtest 'db_scheme2dbi' => sub {
>+    plan tests => 4;
>+
>+    is(Koha::Database::db_scheme2dbi('mysql'), 'mysql', 'ask for mysql, get mysql');
>+    is(Koha::Database::db_scheme2dbi('Pg'),    'Pg',    'ask for Pg, get Pg');
>+    is(Koha::Database::db_scheme2dbi('xxx'),   'mysql', 'ask for unsupported DBMS, get mysql');
>+    is(Koha::Database::db_scheme2dbi(),        'mysql', 'ask for nothing, get mysql');
>+};
>diff --git a/t/lib/Mocks.pm b/t/lib/Mocks.pm
>index 17d54f1a53..ba8971dfca 100644
>--- a/t/lib/Mocks.pm
>+++ b/t/lib/Mocks.pm
>@@ -7,15 +7,15 @@ use Test::MockModule;
> 
> my %configs;
> sub mock_config {
>-    my $context = Test::MockModule->new('C4::Context');
>+    my $koha_config = Test::MockModule->new('Koha::Config');
>     my ( $conf, $value ) = @_;
>     $configs{$conf} = $value;
>-    $context->mock('config', sub {
>+    $koha_config->redefine('get', sub {
>         my ( $self, $conf ) = @_;
>         if ( exists $configs{$conf} ) {
>             return $configs{$conf}
>         } else {
>-            my $method = $context->original('config');
>+            my $method = $koha_config->original('get');
>             return $method->($self, $conf);
>         }
>     });
>diff --git a/t/timezones.t b/t/timezones.t
>index ee64438852..64b13b78a9 100755
>--- a/t/timezones.t
>+++ b/t/timezones.t
>@@ -1,34 +1,34 @@
> use Modern::Perl;
> 
> use C4::Context;
>+use Koha::Config;
> 
> use Test::More tests => 5;
> use Test::Warn;
> use t::lib::Mocks;
> 
>-use DateTime::TimeZone;
>-
> $ENV{TZ} = q{};
> t::lib::Mocks::mock_config( 'timezone', q{} );
>-is( C4::Context->timezone, 'local',
>+my $config = Koha::Config->get_instance;
>+is( $config->timezone, 'local',
>     'Got local timezone with no env or config timezone set' );
> 
> $ENV{TZ} = 'Antarctica/Macquarie';
> is(
>-    C4::Context->timezone,
>+    $config->timezone,
>     'Antarctica/Macquarie',
>     'Got correct timezone using ENV, overrides local time'
> );
> 
> t::lib::Mocks::mock_config( 'timezone', 'Antarctica/South_Pole' );
> is(
>-    C4::Context->timezone,
>+    $config->timezone,
>     'Antarctica/South_Pole',
>     'Got correct timezone using config, overrides env'
> );
> 
> t::lib::Mocks::mock_config( 'timezone', 'Your/Timezone' );
> warning_is {
>-    is( C4::Context->timezone, 'local', 'Invalid timezone falls back to local' ); }
>+    is( $config->timezone, 'local', 'Invalid timezone falls back to local' ); }
>     'Invalid timezone in koha-conf.xml (Your/Timezone)',
>     'Invalid timezone raises a warning';
>-- 
>2.20.1

Actions: View | Diff | Splinter Review

Attachments on bug 28306: 120752 | 120794 | 123145 | 123148 | 123149 | 123150 | 123151 | 124274 | 124282