From db0b9acef45156a83e48c2d3642fd1160e2f50d8 Mon Sep 17 00:00:00 2001 From: Julian Maurice 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 --- C4/Context.pm | 78 +++---------- Koha/Config.pm | 198 +++++++++++++++++++++++++++------ Koha/Database.pm | 165 ++++++++++++++++----------- t/Context.t | 7 +- t/Koha/Config.t | 61 +++++++++- t/db_dependent/Koha/Database.t | 11 +- t/lib/Mocks.pm | 6 +- t/timezones.t | 12 +- 8 files changed, 359 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 -Cnew> 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 . +=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 object. + +If C<$file> is not given (or undef) it defaults to the result of +Cguess_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 object. + +Unlike C, this method will read the file at every call, so use it +carefully. In most cases, you should use C 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..feca147716 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,62 @@ 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 . 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