Browse Source

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>

Signed-off-by: Nick Clemens <nick@bywatersolutions.com>

Signed-off-by: Kyle M Hall <kyle@bywatersolutions.com>

Signed-off-by: Jonathan Druart <jonathan.druart@bugs.koha-community.org>
21.11/bug30761
Julian Maurice 2 years ago
committed by Jonathan Druart
parent
commit
4605304f62
  1. 78
      C4/Context.pm
  2. 198
      Koha/Config.pm
  3. 164
      Koha/Database.pm
  4. 7
      t/Context.t
  5. 60
      t/Koha/Config.t
  6. 11
      t/db_dependent/Koha/Database.t
  7. 6
      t/lib/Mocks.pm
  8. 12
      t/timezones.t

78
C4/Context.pm

@ -117,22 +117,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
@ -188,8 +172,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;
}
@ -201,7 +186,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;
}
@ -283,28 +267,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 {
@ -558,20 +531,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);
@ -840,26 +814,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
@ -871,7 +825,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};

198
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 qw( XML_ELEMENT_NODE XML_TEXT_NODE );
@ -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;

164
Koha/Database.pm

@ -25,20 +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 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
@ -48,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 {
@ -126,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
@ -140,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};
@ -242,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.

7
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] };

60
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');
@ -247,3 +247,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');
};

11
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');
};

6
t/lib/Mocks.pm

@ -42,15 +42,15 @@ Mock the configuration I<$config_entry> with the specified I<$value>.
=cut
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);
}
});

12
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';

Loading…
Cancel
Save