Koha/t/Context.t
Julian Maurice 4605304f62 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>
2021-08-31 10:27:52 +02:00

130 lines
4.8 KiB
Perl
Executable file

#!/usr/bin/perl
# This file is part of Koha.
#
# Koha is free software; you can redistribute it and/or modify it
# under the terms of the GNU General Public License as published by
# the Free Software Foundation; either version 3 of the License, or
# (at your option) any later version.
#
# Koha is distributed in the hope that it will be useful, but
# WITHOUT ANY WARRANTY; without even the implied warranty of
# MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
# GNU General Public License for more details.
#
# You should have received a copy of the GNU General Public License
# along with Koha; if not, see <http://www.gnu.org/licenses>.
use Modern::Perl;
use DBI;
use Test::More tests => 31;
use Test::MockModule;
use Test::Warn;
use YAML::XS;
use t::lib::Mocks;
BEGIN {
use_ok('C4::Context');
}
subtest 'yaml_preference() tests' => sub {
plan tests => 3;
my $data = [ 'uno', 'dos', { 'tres' => 'cuatro' } ];
my $context = Test::MockModule->new( 'C4::Context' );
$context->mock( 'preference', YAML::XS::Dump($data) );
my $pref = C4::Context->new->yaml_preference( 'nothing' );
is_deeply( $pref, $data, 'yaml_preference returns the right structure' );
$context->mock( 'preference', qq{- uno: dsa\n\t- dos: asd} );
warning_like
{ $pref = C4::Context->new->yaml_preference('nothing') }
qr/^Unable to parse nothing syspref/,
'Invalid YAML on syspref throws a warning';
is( $pref, undef, 'Invalid YAML on syspref makes it return undef' );
$context->unmock( 'preference' );
};
subtest 'needs_install() tests' => sub {
plan tests => 2;
t::lib::Mocks::mock_preference( 'Version', '3.0.0' );
is( C4::Context->needs_install, 0, 'Preference is defined, no need to install' );
t::lib::Mocks::mock_preference( 'Version', undef ); # the behaviour when ->preference fails to fetch
is( C4::Context->needs_install, 1, "->preference(Version) is not defined, need to install" );
};
my $context = Test::MockModule->new('C4::Context');
my $userenv = {};
$context->mock('userenv', sub {
return $userenv;
});
local $SIG{__WARN__} = sub { die $_[0] };
eval { C4::Context::IsSuperLibrarian(); };
like ( $@, qr/not defined/, "IsSuperLibrarian logs an error if no userenv is defined" );
$userenv->{flags} = 42;
my $is_super_librarian = eval{ C4::Context::IsSuperLibrarian() };
is ( $@, q||, "IsSuperLibrarian does not log an error if userenv is defined" );
is ( $is_super_librarian, 0, "With flag=42, it is not a super librarian" );
$userenv->{flags} = 421;
$is_super_librarian = eval{ C4::Context::IsSuperLibrarian() };
is ( $@, q||, "IsSuperLibrarian does not log an error if userenv is defined" );
is ( $is_super_librarian, 1, "With flag=1, it is a super librarian" );
$userenv->{flags} = undef;
$is_super_librarian = eval{ C4::Context::IsSuperLibrarian() };
is ( $@, q||, "IsSuperLibrarian does not log an error if \$userenv->{flags} is undefined" );
is ( $is_super_librarian, 0, "With flag=undef, it is not a super librarian" );
$userenv->{flags} = 0;
$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" );
# C4::Context::interface
my $lastwarn;
local $SIG{__WARN__} = sub { $lastwarn = $_[0] };
is(C4::Context->interface, 'opac','interface defaults to opac');
is(C4::Context->interface('foobar'), 'opac', 'interface foobar');
like($lastwarn, qr/invalid interface : 'foobar'/, 'interface warn on foobar');
is(C4::Context->interface, 'opac', 'interface still opac');
is(C4::Context->interface('intranet'), 'intranet', 'interface intranet');
is(C4::Context->interface, 'intranet', 'interface still intranet');
is(C4::Context->interface('foobar'), 'intranet', 'interface foobar again');
is(C4::Context->interface, 'intranet', 'interface still intranet');
is(C4::Context->interface('OPAC'), 'opac', 'interface OPAC uc');
is(C4::Context->interface, 'opac', 'interface still opac');
#Bug 14751
is( C4::Context->interface( 'SiP' ), 'sip', 'interface SiP' );
is( C4::Context->interface( 'COMMANDLINE' ), 'commandline', 'interface commandline uc' );
is( C4::Context->interface( 'CRON' ), 'cron', 'interface cron uc' );
{
local %ENV = %ENV;
delete $ENV{HTTPS};
is( C4::Context->https_enabled, 0, "Undefined HTTPS env returns 0");
$ENV{HTTPS} = '1';
is( C4::Context->https_enabled, 0, "Invalid 1 HTTPS env returns 0");
$ENV{HTTPS} = 'off';
is( C4::Context->https_enabled, 0, "off HTTPS env returns 0");
$ENV{HTTPS} = 'OFF';
is( C4::Context->https_enabled, 0, "OFF HTTPS env returns 0");
$ENV{HTTPS} = 'on';
is( C4::Context->https_enabled, 1, "on HTTPS env returns 1");
$ENV{HTTPS} = 'ON';
is( C4::Context->https_enabled, 1, "ON HTTPS env returns 1");
}