Koha/t/db_dependent/Context.t

#!/usr/bin/perl

# Copyright 2008, 2022 Koha development team
#
# 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 Test::More tests => 5;
use Test::MockModule;

use C4::Context;
use Koha::Database;

our $schema;
$schema = Koha::Database->new->schema;

subtest 'Environment' => sub {
    plan tests => 2;
    # First we need to check your environmental variables
    my $ret;
    for (qw(KOHA_CONF PERL5LIB)) {
        ok( $ret = $ENV{$_}, "ENV{$_} = $ret" );
    }
};

subtest 'Tests with preferences' => sub {
    plan tests => 22;
    $schema->storage->txn_begin;

    my $dbh;
    ok($dbh = C4::Context->dbh(), 'Getting dbh from C4::Context');

    C4::Context->set_preference('OPACBaseURL','junk');
    C4::Context->clear_syspref_cache();
    my $OPACBaseURL = C4::Context->preference('OPACBaseURL');
    is($OPACBaseURL,'http://junk','OPACBaseURL saved with http:// when missing it');

    C4::Context->set_preference('OPACBaseURL','https://junk');
    C4::Context->clear_syspref_cache();
    $OPACBaseURL = C4::Context->preference('OPACBaseURL');
    is($OPACBaseURL,'https://junk','OPACBaseURL saved with https:// as specified');

    C4::Context->set_preference('OPACBaseURL','http://junk2');
    C4::Context->clear_syspref_cache();
    $OPACBaseURL = C4::Context->preference('OPACBaseURL');
    is($OPACBaseURL,'http://junk2','OPACBaseURL saved with http:// as specified');

    C4::Context->set_preference('OPACBaseURL', '');
    $OPACBaseURL = C4::Context->preference('OPACBaseURL');
    is($OPACBaseURL,'','OPACBaseURL saved empty as specified');

    C4::Context->set_preference('SillyPreference','random');
    C4::Context->clear_syspref_cache();
    my $SillyPeference = C4::Context->preference('SillyPreference');
    is($SillyPeference,'random','SillyPreference saved as specified');
    C4::Context->clear_syspref_cache();
    C4::Context->enable_syspref_cache();

    # Testing syspref caching
    $schema->storage->debug(1);
    my $trace_read;
    open my $trace, '>', \$trace_read or die "Can't open variable: $!";
    $schema->storage->debugfh( $trace );

    C4::Context->set_preference('SillyPreference', 'thing1');
    my $silly_preference = Koha::Config::SysPrefs->find('SillyPreference');
    is( $silly_preference->variable, 'SillyPreference', 'set_preference should have kept the case sensitivity' );

    my $pref = C4::Context->preference("SillyPreference");
    is(C4::Context->preference("SillyPreference"), 'thing1', "Retrieved syspref (value='thing1') successfully with default behavior");
    ok( $trace_read, 'Retrieved syspref from database');
    $trace_read = q{};

    is(C4::Context->preference("SillyPreference"), 'thing1', "Retrieved syspref (value='thing1') successfully with default behavior");
    is( $trace_read , q{}, 'Did not retrieve syspref from database');
    $trace_read = q{};

    C4::Context->disable_syspref_cache();
    $silly_preference->set( { value => 'thing2' } )->store();
    is(C4::Context->preference("SillyPreference"), 'thing2', "Retrieved syspref (value='thing2') successfully with disabled cache");
    ok($trace_read, 'Retrieved syspref from database');
    $trace_read = q{};

    $silly_preference->set( { value => 'thing3' } )->store();
    is(C4::Context->preference("SillyPreference"), 'thing3', "Retrieved syspref (value='thing3') successfully with disabled cache");
    ok($trace_read, 'Retrieved syspref from database');
    $trace_read = q{};

    C4::Context->enable_syspref_cache();
    is(C4::Context->preference("SillyPreference"), 'thing3', "Retrieved syspref (value='thing3') successfully from cache");
    isnt( $trace_read, q{}, 'The pref should be retrieved from the database if the cache has been enabled');
    $trace_read = q{};

    $silly_preference->set( { value => 'thing4' } )->store();
    C4::Context->clear_syspref_cache();
    is(C4::Context->preference("SillyPreference"), 'thing4', "Retrieved syspref (value='thing4') successfully after clearing cache");
    ok($trace_read, 'Retrieved syspref from database');
    $trace_read = q{};

    is(C4::Context->preference("SillyPreference"), 'thing4', "Retrieved syspref (value='thing4') successfully from cache");
    is( $trace_read, q{}, 'Did not retrieve syspref from database');
    $trace_read = q{};
    $silly_preference->delete();

    # AutoEmailNewUser should be a YesNo pref
    C4::Context->set_preference('AutoEmailNewUser', '');
    my $yesno_pref = Koha::Config::SysPrefs->find('AutoEmailNewUser');
    is( $yesno_pref->value(), 0, 'set_preference should have set the value to 0, instead of an empty string' );

    $schema->storage->txn_rollback;
};

subtest 'Check context hash keys' => sub {
    my $koha;
    ok($koha = C4::Context->new, 'C4::Context->new');
    my @keys = keys %$koha;
    my $width = 0;
    ok( @keys, 'Expecting entries in context hash' );
    if( @keys ) {
        $width = (sort {$a <=> $b} map {length} @keys)[-1];
    }
    foreach (sort @keys) {
        ok(exists $koha->{$_},
            '$koha->{' . sprintf('%' . $width . 's', $_)  . '} exists '
            . ((defined $koha->{$_}) ? "and is defined." : "but is not defined.")
        );
    }
    my $config;
    ok($config = $koha->{config}, 'Getting $koha->{config} ');
    done_testing();
};

subtest 'Zconn' => sub {
    plan tests => 2;
    my $oConnection = C4::Context->Zconn('biblioserver', 0);
    isnt($oConnection->option('async'), 1, "ZOOM connection is synchronous");
    $oConnection = C4::Context->Zconn('biblioserver', 1);
    is($oConnection->option('async'), 1, "ZOOM connection is asynchronous");
};

subtest 'get_versions' => sub {
    plan tests => 2;

    my $dbh = C4::Context->dbh;
    my $mod = Test::MockModule->new( 'C4::Context' );
    my $no_dbh;
    $mod->mock( 'dbh', sub { return $no_dbh ? undef : $dbh; } );

    my $client = `mysql -V`;
    my $server = ( C4::Context->dbh->selectrow_array("SHOW VARIABLES LIKE 'version'") )[1];
    my $server_version;
    if( $server =~ /(\d+(\.\d+)+)/ ) {
        $server_version = $1;
        $server_version =~ s/\./\\./g;
    }
    my $v;
    like( $v = { C4::Context::get_versions }->{mysqlVersion}, qr/$server_version/, "Server version $v found" );
    $no_dbh = 1;
    is( $v = { C4::Context::get_versions }->{mysqlVersion}, $client, "Client version $v found" );
};