Attachment #123148 for bug #28306

View | Details | Raw Unified | Return to bug 28306
Collapse All | Expand All




$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

        }
    }

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

    $self->{tz} = undef; # local timezone object

    bless $self, $class;
    $self->{db_driver} = db_scheme2dbi($self->config('db_scheme'));  # cache database driver
    return $self;
}



  $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, $term) = @_;

    return unless defined $context and defined $context->{config};

    return $context->{config}->get($var, $term);
       # 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};
}

sub config {

    $syntax = 'xml';
    $elementSetName = 'marcxml';

    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=> _common_config($server, 'server')->{cql2rpn});
        $o->option(cclfile=> $serverinfo->{ccl2rpn});
        $o->option(preferredRecordSyntax => $syntax);
        $o->option(elementSetName => $elementSetName) if $elementSetName;
        $o->option(databaseName => _common_config($server, 'config') || 'biblios');

        # create a new connection object
        $Zconn= create ZOOM::Connection($o);

    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

sub tz {
    my $self = shift;
    if (!defined $context->{tz}) {
        my $timezone = $context->{config}->timezone;
        $context->{tz} = DateTime::TimeZone->new(name => $timezone);
    }
    return $context->{tz};




# 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 );

# developers should set the KOHA_CONF environment variable
my $INSTALLED_CONFIG_FNAME = '__KOHA_CONF_DIR__/koha-conf.xml';

=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 ) = @_;


        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 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) = @_;


    }
}

# 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;




=head1 SYNOPSIS

  use Koha::Database;
  my $schema = Koha::Database->schema();
  my $schema = $database->schema();

=head1 FUNCTIONS

=cut

use Modern::Perl;
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);
        }
    }

    return $dbh;
}

__PACKAGE__->mk_accessors(qw( ));

# _new_schema
# Internal helper function (not a method!). This creates a new


    require Koha::Schema;

    my $schema = Koha::Schema->connect({
        dbh_maker => \&Koha::Database::dbh,
        quote_names => 1,
        auto_savepoint => 1,
    });
    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 $dbh = $schema->storage->dbh;
    eval {


=head2 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

=cut

sub schema {
    my ($class, $params) = @_;
    my $params = shift;

    unless ( $params->{new} ) {
        return $database->{schema} if defined $database->{schema};

    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.




use Modern::Perl;

use DBI;
use Test::More tests => 31;
use Test::MockModule;
use Test::Warn;
use YAML::XS;

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





use Modern::Perl;

use Test::More tests => 4;
use FindBin qw($Bin $Script);

use_ok('Koha::Config');

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




# along with Koha; if not, see <http://www.gnu.org/licenses>.

use Modern::Perl;
use Test::More tests => 3;
use C4::Context;

my $dbh = C4::Context->dbh;

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




=cut

sub mock_config {
    my $koha_config = Test::MockModule->new('Koha::Config');
    my ( $conf, $value ) = @_;
    $configs{$conf} = $value;
    $koha_config->redefine('get', sub {
        my ( $self, $conf ) = @_;
        if ( exists $configs{$conf} ) {
            return $configs{$conf}
        } else {
            my $method = $koha_config->original('get');
            return $method->($self, $conf);
        }
    });




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{} );
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(
    $config->timezone,
    'Antarctica/Macquarie',
    'Got correct timezone using ENV, overrides local time'
);

t::lib::Mocks::mock_config( 'timezone', 'Antarctica/South_Pole' );
is(
    $config->timezone,
    'Antarctica/South_Pole',
    'Got correct timezone using config, overrides env'
);

t::lib::Mocks::mock_config( 'timezone', 'Your/Timezone' );
warning_is {
    is( $config->timezone, 'local', 'Invalid timezone falls back to local' ); }
    'Invalid timezone in koha-conf.xml (Your/Timezone)',
    'Invalid timezone raises a warning';
- 

Return to bug 28306

Lines 117-138 environment variable to the pathname of a configuration file to use. Link Here

(-)a/C4/Context.pm (-62 / +16 lines)
117	$context = undef; # Initially, no context is set	117	$context = undef; # Initially, no context is set
118	@context_stack = (); # Initially, no saved contexts	118	@context_stack = (); # Initially, no saved contexts
119		119
120	=head2 db_scheme2dbi
121
122	my $dbd_driver_name = C4::Context::db_schema2dbi($scheme);
123
124	This routines translates a database type to part of the name
125	of the appropriate DBD driver to use when establishing a new
126	database connection. It recognizes 'mysql' and 'Pg'; if any
127	other scheme is supplied it defaults to 'mysql'.
128
129	=cut
130
131	sub db_scheme2dbi {
132	my $scheme = shift // '';
133	return $scheme eq 'Pg' ? $scheme : 'mysql';
134	}
135
136	sub import {	120	sub import {
137	# Create the default context ($C4::Context::Context)	121	# Create the default context ($C4::Context::Context)
138	# the first time the module is called	122	# the first time the module is called
Lines 188-195 sub new { Link Here
188	}	172	}
189	}	173	}
190		174
191	my $self = Koha::Config->read_from_file($conf_fname);	175	my $self = {};
192	unless ( exists $self->{config} or defined $self->{config} ) {	176	$self->{config} = Koha::Config->get_instance($conf_fname);
		177	unless ( defined $self->{config} ) {
193	warn "The config file ($conf_fname) has not been parsed correctly";	178	warn "The config file ($conf_fname) has not been parsed correctly";
194	return;	179	return;
195	}	180	}
Lines 201-207 sub new { Link Here
201	$self->{tz} = undef; # local timezone object	186	$self->{tz} = undef; # local timezone object
202		187
203	bless $self, $class;	188	bless $self, $class;
204	$self->{db_driver} = db_scheme2dbi($self->config('db_scheme')); # cache database driver
205	return $self;	189	return $self;
206	}	190	}
207		191
Lines 283-310 sub restore_context Link Here
283		267
284	$value = C4::Context->config("config_variable");	268	$value = C4::Context->config("config_variable");
285		269
286	$value = C4::Context->config_variable;
287
288	Returns the value of a variable specified in the configuration file	270	Returns the value of a variable specified in the configuration file
289	from which the current context was created.	271	from which the current context was created.
290		272
291	The second form is more compact, but of course may conflict with
292	method names. If there is a configuration variable called "new", then
293	C<C4::Config-E<gt>new> will not return it.
294
295	=cut	273	=cut
296		274
297	sub _common_config {	275	sub _common_config {
298	my $var = shift;	276	my ($var, $term) = @_;
299	my $term = shift;	277
300	return unless defined $context and defined $context->{$term};	278	return unless defined $context and defined $context->{config};
301	# Presumably $self->{$term} might be	279
302	# undefined if the config file given to &new	280	return $context->{config}->get($var, $term);
303	# didn't exist, and the caller didn't bother
304	# to check the return value.
305
306	# Return the value of the requested config variable
307	return $context->{$term}->{$var};
308	}	281	}
309		282
310	sub config {	283	sub config {
Lines 558-577 sub _new_Zconn { Link Here
558	$syntax = 'xml';	531	$syntax = 'xml';
559	$elementSetName = 'marcxml';	532	$elementSetName = 'marcxml';
560		533
561	my $host = $context->{'listen'}->{$server}->{'content'};	534	my $host = _common_config($server, 'listen')->{content};
562	my $user = $context->{"serverinfo"}->{$server}->{"user"};	535	my $serverinfo = _common_config($server, 'serverinfo');
563	my $password = $context->{"serverinfo"}->{$server}->{"password"};	536	my $user = $serverinfo->{user};
		537	my $password = $serverinfo->{password};
564	eval {	538	eval {
565	# set options	539	# set options
566	my $o = ZOOM::Options->new();	540	my $o = ZOOM::Options->new();
567	$o->option(user => $user) if $user && $password;	541	$o->option(user => $user) if $user && $password;
568	$o->option(password => $password) if $user && $password;	542	$o->option(password => $password) if $user && $password;
569	$o->option(async => 1) if $async;	543	$o->option(async => 1) if $async;
570	$o->option(cqlfile=> $context->{"server"}->{$server}->{"cql2rpn"});	544	$o->option(cqlfile=> _common_config($server, 'server')->{cql2rpn});
571	$o->option(cclfile=> $context->{"serverinfo"}->{$server}->{"ccl2rpn"});	545	$o->option(cclfile=> $serverinfo->{ccl2rpn});
572	$o->option(preferredRecordSyntax => $syntax);	546	$o->option(preferredRecordSyntax => $syntax);
573	$o->option(elementSetName => $elementSetName) if $elementSetName;	547	$o->option(elementSetName => $elementSetName) if $elementSetName;
574	$o->option(databaseName => $context->{"config"}->{$server}\|\|"biblios");	548	$o->option(databaseName => _common_config($server, 'config') \|\| 'biblios');
575		549
576	# create a new connection object	550	# create a new connection object
577	$Zconn= create ZOOM::Connection($o);	551	$Zconn= create ZOOM::Connection($o);
Lines 840-865 sub get_versions { Link Here
840	return %versions;	814	return %versions;
841	}	815	}
842		816
843	=head2 timezone
844
845	my $C4::Context->timzone
846
847	Returns a timezone code for the instance of Koha
848
849	=cut
850
851	sub timezone {
852	my $self = shift;
853
854	my $timezone = C4::Context->config('timezone') \|\| $ENV{TZ} \|\| 'local';
855	if ( !DateTime::TimeZone->is_valid_name( $timezone ) ) {
856	warn "Invalid timezone in koha-conf.xml ($timezone)";
857	$timezone = 'local';
858	}
859
860	return $timezone;
861	}
862
863	=head2 tz	817	=head2 tz
864		818
865	C4::Context->tz	819	C4::Context->tz
Lines 871-877 sub timezone { Link Here
871	sub tz {	825	sub tz {
872	my $self = shift;	826	my $self = shift;
873	if (!defined $context->{tz}) {	827	if (!defined $context->{tz}) {
874	my $timezone = $self->timezone;	828	my $timezone = $context->{config}->timezone;
875	$context->{tz} = DateTime::TimeZone->new(name => $timezone);	829	$context->{tz} = DateTime::TimeZone->new(name => $timezone);
876	}	830	}
877	return $context->{tz};	831	return $context->{tz};

Lines 25-44 Koha::Database Link Here

(-)a/Koha/Database.pm (-65 / +99 lines)
25	=head1 SYNOPSIS	25	=head1 SYNOPSIS
26		26
27	use Koha::Database;	27	use Koha::Database;
28	my $database = Koha::Database->new();	28	my $schema = Koha::Database->schema();
29	my $schema = $database->schema();
30		29
31	=head1 FUNCTIONS	30	=head1 FUNCTIONS
32		31
33	=cut	32	=cut
34		33
35	use Modern::Perl;	34	use Modern::Perl;
36	use C4::Context;	35	use DBI;
37	use base qw(Class::Accessor);	36	use Koha::Config;
		37
		38	our $database;
		39
		40	# FIXME: It is useless to have a Koha::Database object since all methods
		41	# below act as class methods
		42	# Koha::Database->new->schema is exactly the same as Koha::Database->schema
		43	# We should use Koha::Database->schema everywhere and remove the `new` method
		44	sub new { bless {}, shift }
		45
		46	sub dbh {
		47	my $config = Koha::Config->get_instance;
		48	my $driver = db_scheme2dbi($config->get('db_scheme'));
		49	my $user = $config->get("user"),
		50	my $pass = $config->get("pass"),
		51	my $dsn = sprintf(
		52	'dbi:%s:database=%s;host=%s;port=%s',
		53	$driver,
		54	$config->get("database"),
		55	$config->get("hostname"),
		56	$config->get("port") \|\| '',
		57	);
		58
		59	my $attr = {
		60	RaiseError => 1,
		61	PrintError => 1,
		62	};
		63
		64	if ($driver eq 'mysql') {
		65	my $tls = $config->get("tls");
		66	if ($tls && $tls eq 'yes') {
		67	$dsn .= sprintf(
		68	';mysql_ssl=1;mysql_ssl_client_key=%s;mysql_ssl_client_cert=%s;mysql_ssl_ca_file=%s',
		69	$config->get('key'),
		70	$config->get('cert'),
		71	$config->get('ca'),
		72	);
		73	}
		74
		75	$attr->{mysql_enable_utf8} = 1;
		76	}
		77
		78	my $dbh = DBI->connect($dsn, $user, $pass, $attr);
		79
		80	if ($dbh) {
		81	my @queries;
		82	my $tz = $config->timezone;
		83	$tz = '' if $tz eq 'local';
		84
		85	if ($driver eq 'mysql') {
		86	push @queries, "SET NAMES 'utf8mb4'";
		87	push @queries, qq{SET time_zone = "$tz"} if $tz;
		88	if ( $config->get('strict_sql_modes')
		89	\|\| ( exists $ENV{_} && $ENV{_} =~ m\|prove\| )
		90	\|\| $ENV{KOHA_TESTING}
		91	) {
		92	push @queries, q{
		93	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'
		94	};
		95	} else {
		96	push @queries, q{SET sql_mode = 'IGNORE_SPACE,NO_ZERO_IN_DATE,NO_ZERO_DATE,ERROR_FOR_DIVISION_BY_ZERO,NO_ENGINE_SUBSTITUTION'}
		97	}
		98	} elsif ($driver eq 'Pg') {
		99	push @queries, qq{SET TIME ZONE = "$tz"} if $tz;
		100	push @queries, q{set client_encoding = 'UTF8'};
101	}
102
103	foreach my $query (@queries) {
104	$dbh->do($query);
105	}
106	}
38		107
39	use vars qw($database);	108	return $dbh;
		109	}
40		110
41	__PACKAGE__->mk_accessors(qw( ));
42		111
43	# _new_schema	112	# _new_schema
44	# Internal helper function (not a method!). This creates a new	113	# Internal helper function (not a method!). This creates a new
Lines 48-109 sub _new_schema { Link Here
48		117
49	require Koha::Schema;	118	require Koha::Schema;
50		119
51	my $db_driver = C4::Context::db_scheme2dbi(C4::Context->config('db_scheme'));;	120	my $schema = Koha::Schema->connect({
52		121	dbh_maker => \&Koha::Database::dbh,
53	my $db_name = C4::Context->config("database");	122	quote_names => 1,
54	my $db_host = C4::Context->config("hostname");	123	auto_savepoint => 1,
55	my $db_port = C4::Context->config("port") \|\| '';	124	});
56	my $db_user = C4::Context->config("user");
57	my $db_passwd = C4::Context->config("pass");
58	my $tls = C4::Context->config("tls");
59	my $tls_options;
60	if( $tls && $tls eq 'yes' ) {
61	my $ca = C4::Context->config('ca');
62	my $cert = C4::Context->config('cert');
63	my $key = C4::Context->config('key');
64	$tls_options = ";mysql_ssl=1;mysql_ssl_client_key=".$key.";mysql_ssl_client_cert=".$cert.";mysql_ssl_ca_file=".$ca;
65	}
66
67
68
69	my ( %encoding_attr, $encoding_query, $tz_query, $sql_mode_query );
70	my $tz = C4::Context->timezone;
71	$tz = q{} if ( $tz eq 'local' );
72	if ( $db_driver eq 'mysql' ) {
73	%encoding_attr = ( mysql_enable_utf8 => 1 );
74	$encoding_query = "set NAMES 'utf8mb4'";
75	$tz_query = qq(SET time_zone = "$tz") if $tz;
76	if ( C4::Context->config('strict_sql_modes')
77	\|\| ( exists $ENV{_} && $ENV{_} =~ m\|prove\| )
78	\|\| $ENV{KOHA_TESTING}
79	) {
80	$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'};
81	} else {
82	$sql_mode_query = q{SET sql_mode = 'IGNORE_SPACE,NO_ZERO_IN_DATE,NO_ZERO_DATE,ERROR_FOR_DIVISION_BY_ZERO,NO_ENGINE_SUBSTITUTION'};
83	}
84	}
85	elsif ( $db_driver eq 'Pg' ) {
86	$encoding_query = "set client_encoding = 'UTF8';";
87	$tz_query = qq(SET TIME ZONE = "$tz") if $tz;
88	}
89
90	my $schema = Koha::Schema->connect(
91	{
92	dsn => "dbi:$db_driver:database=$db_name;host=$db_host;port=$db_port".($tls_options? $tls_options : ""),
93	user => $db_user,
94	password => $db_passwd,
95	%encoding_attr,
96	RaiseError => 1,
97	PrintError => 1,
98	quote_names => 1,
99	auto_savepoint => 1,
100	on_connect_do => [
101	$encoding_query \|\| (),
102	$tz_query \|\| (),
103	$sql_mode_query \|\| (),
104	]
105	}
106	);
107		125
108	my $dbh = $schema->storage->dbh;	126	my $dbh = $schema->storage->dbh;
109	eval {	127	eval {
Lines 126-132 sub _new_schema { Link Here
126		144
127	=head2 schema	145	=head2 schema
128		146
129	$schema = $database->schema;	147	$schema = Koha::Database->schema;
		148	$schema = Koha::Database->schema({ new => 1 });
130		149
131	Returns a database handle connected to the Koha database for the	150	Returns a database handle connected to the Koha database for the
132	current context. If no connection has yet been made, this method	151	current context. If no connection has yet been made, this method
Lines 140-147 possibly C<&set_schema>. Link Here
140	=cut	159	=cut
141		160
142	sub schema {	161	sub schema {
143	my $self = shift;	162	my ($class, $params) = @_;
144	my $params = shift;
145		163
146	unless ( $params->{new} ) {	164	unless ( $params->{new} ) {
147	return $database->{schema} if defined $database->{schema};	165	return $database->{schema} if defined $database->{schema};
Lines 242-247 sub flush_schema_cache { Link Here
242	return 1;	260	return 1;
243	}	261	}
244		262
		263	=head2 db_scheme2dbi
		264
		265	my $dbd_driver_name = Koha::Database::db_scheme2dbi($scheme);
		266
		267	This routines translates a database type to part of the name
		268	of the appropriate DBD driver to use when establishing a new
		269	database connection. It recognizes 'mysql' and 'Pg'; if any
		270	other scheme is supplied it defaults to 'mysql'.
		271
		272	=cut
		273
		274	sub db_scheme2dbi {
		275	my $scheme = shift // '';
		276	return $scheme eq 'Pg' ? $scheme : 'mysql';
		277	}
		278
245	=head2 EXPORT	279	=head2 EXPORT
246		280
247	None by default.	281	None by default.

Lines 18-24 Link Here

(-)a/t/Context.t (-6 / +1 lines)
18	use Modern::Perl;	18	use Modern::Perl;
19		19
20	use DBI;	20	use DBI;
21	use Test::More tests => 35;	21	use Test::More tests => 31;
22	use Test::MockModule;	22	use Test::MockModule;
23	use Test::Warn;	23	use Test::Warn;
24	use YAML::XS;	24	use YAML::XS;
Lines 95-105 $is_super_librarian = eval{ C4::Context::IsSuperLibrarian() }; Link Here
95	is ( $@, q\|\|, "IsSuperLibrarian does not log an error if \$userenv->{flags} is equal to 0" );	95	is ( $@, q\|\|, "IsSuperLibrarian does not log an error if \$userenv->{flags} is equal to 0" );
96	is ( $is_super_librarian, 0, "With flag=0, it is not a super librarian" );	96	is ( $is_super_librarian, 0, "With flag=0, it is not a super librarian" );
97		97
98	is(C4::Context::db_scheme2dbi('mysql'), 'mysql', 'ask for mysql, get mysql');
99	is(C4::Context::db_scheme2dbi('Pg'), 'Pg', 'ask for Pg, get Pg');
100	is(C4::Context::db_scheme2dbi('xxx'), 'mysql', 'ask for unsupported DBMS, get mysql');
101	is(C4::Context::db_scheme2dbi(), 'mysql', 'ask for nothing, get mysql');
102
103	# C4::Context::interface	98	# C4::Context::interface
104	my $lastwarn;	99	my $lastwarn;
105	local $SIG{__WARN__} = sub { $lastwarn = $_[0] };	100	local $SIG{__WARN__} = sub { $lastwarn = $_[0] };

Lines 17-23 Link Here

(-)a/t/Koha/Config.t (-1 / +59 lines)
17		17
18	use Modern::Perl;	18	use Modern::Perl;
19		19
20	use Test::More tests => 2;	20	use Test::More tests => 4;
21	use FindBin qw($Bin $Script);	21	use FindBin qw($Bin $Script);
22		22
23	use_ok('Koha::Config');	23	use_ok('Koha::Config');
Lines 247-249 subtest 'read_from_file() tests' => sub { Link Here
247	like( $@, qr{.Error reading file.}, 'File failing to read raises warning');	247	like( $@, qr{.Error reading file.}, 'File failing to read raises warning');
248	};	248	};
249		249
		250	subtest 'get_instance' => sub {
		251	plan tests => 3;
		252
		253	my $config = Koha::Config->get_instance($config_filepath);
		254	isa_ok($config, 'Koha::Config', 'get_instance returns a Koha::Config object');
		255	my $same_config = Koha::Config->get_instance($config_filepath);
		256	is($config, $same_config, '2nd call to get_instance returns the same object');
		257
		258	local $ENV{KOHA_CONF} = $config_filepath;
		259	my $default_config = Koha::Config->get_instance;
		260	is($default_config, $config, 'get_instance without parameters reads $KOHA_CONF');
		261	};
		262
		263	subtest 'get' => sub {
		264	plan tests => 7;
		265
		266	my $config = Koha::Config->get_instance($config_filepath);
		267
		268	is_deeply(
		269	$config->get('biblioserver', 'listen'),
		270	{ content => 'unix:/home/koha/var/run/zebradb/bibliosocket' },
		271	);
		272
		273	is_deeply(
		274	$config->get('biblioserver', 'server'),
		275	{
		276	'listenref' => 'biblioserver',
		277	'directory' => '/home/koha/var/lib/zebradb/biblios',
		278	'config' => '/home/koha/etc/zebradb/zebra-biblios-dom.cfg',
		279	'cql2rpn' => '/home/koha/etc/zebradb/pqf.properties',
		280	'xi:include' => [
		281	{
		282	'href' => '/home/koha/etc/zebradb/retrieval-info-bib-dom.xml',
		283	'xmlns:xi' => 'http://www.w3.org/2001/XInclude'
		284	},
		285	{
		286	'xmlns:xi' => 'http://www.w3.org/2001/XInclude',
		287	'href' => '/home/koha/etc/zebradb/explain-biblios.xml'
		288	}
		289	],
		290	},
		291	);
		292
		293	is_deeply(
		294	$config->get('biblioserver', 'serverinfo'),
		295	{
		296	'ccl2rpn' => '/home/koha/etc/zebradb/ccl.properties',
		297	'user' => 'kohauser',
		298	'password' => 'zebrastripes',
		299	},
		300	);
		301
		302	is($config->get('db_scheme'), 'mysql');
		303	is($config->get('ca'), '');
		304
		305	is($config->get('unicorn'), undef, 'returns undef if key does not exist');
		306	is_deeply([$config->get('unicorn')], [undef], 'returns undef even in list context');
		307	};

Lines 16-22 Link Here

(-)a/t/db_dependent/Koha/Database.t (-1 / +10 lines)
16	# along with Koha; if not, see <http://www.gnu.org/licenses>.	16	# along with Koha; if not, see <http://www.gnu.org/licenses>.
17		17
18	use Modern::Perl;	18	use Modern::Perl;
19	use Test::More tests => 2;	19	use Test::More tests => 3;
20	use C4::Context;	20	use C4::Context;
21		21
22	my $dbh = C4::Context->dbh;	22	my $dbh = C4::Context->dbh;
Lines 24-26 my $sql_mode = $dbh->selectrow_array(q\|SELECT @@SQL_MODE\|); Link Here
24	like( $sql_mode, qr{STRICT_TRANS_TABLES}, 'Strict SQL modes must be turned on for tests' );	24	like( $sql_mode, qr{STRICT_TRANS_TABLES}, 'Strict SQL modes must be turned on for tests' );
25		25
26	is( $dbh->{RaiseError}, 1, 'RaiseError must be turned on for tests' );	26	is( $dbh->{RaiseError}, 1, 'RaiseError must be turned on for tests' );
		27
		28	subtest 'db_scheme2dbi' => sub {
		29	plan tests => 4;
		30
		31	is(Koha::Database::db_scheme2dbi('mysql'), 'mysql', 'ask for mysql, get mysql');
		32	is(Koha::Database::db_scheme2dbi('Pg'), 'Pg', 'ask for Pg, get Pg');
		33	is(Koha::Database::db_scheme2dbi('xxx'), 'mysql', 'ask for unsupported DBMS, get mysql');
		34	is(Koha::Database::db_scheme2dbi(), 'mysql', 'ask for nothing, get mysql');
		35	};

Lines 15-20 package Koha::Config; Link Here

(-)a/Koha/Config.pm (-34 / +164 lines)
15	# You should have received a copy of the GNU General Public License	15	# You should have received a copy of the GNU General Public License
16	# along with Koha; if not, see <http://www.gnu.org/licenses>.	16	# along with Koha; if not, see <http://www.gnu.org/licenses>.
17		17
		18	=head1 NAME
		19
		20	Koha::Config - Read Koha configuration file
		21
		22	=head1 SYNOPSIS
		23
		24	use Koha::Config;
		25
		26	my $config = Koha::Config->get_instance;
		27	my $database = $config->get('database');
		28	my $serverinfo = $config->get('biblioserver', 'serverinfo');
		29
		30	my $otherconfig = Koha::Config->get_instance('/path/to/other/koha-conf.xml');
		31
		32	=head1 DESCRIPTION
		33
		34	Koha::Config is a helper module for reading configuration variables from the
		35	main Koha configuration file ($KOHA_CONF)
		36
		37	=cut
		38
18	use Modern::Perl;	39	use Modern::Perl;
19		40
20	use XML::LibXML qw( XML_ELEMENT_NODE XML_TEXT_NODE );	41	use XML::LibXML qw( XML_ELEMENT_NODE XML_TEXT_NODE );
Lines 30-37 use constant CONFIG_FNAME => "/etc/koha/koha-conf.xml"; Link Here
30	# developers should set the KOHA_CONF environment variable	51	# developers should set the KOHA_CONF environment variable
31	my $INSTALLED_CONFIG_FNAME = '__KOHA_CONF_DIR__/koha-conf.xml';	52	my $INSTALLED_CONFIG_FNAME = '__KOHA_CONF_DIR__/koha-conf.xml';
32		53
33	# Should not be called outside of C4::Context	54	=head1 CLASS METHODS
34	# use C4::Context->config instead	55
		56	=head2 get_instance
		57
		58	$config = Koha::Config->get_instance;
		59	$config = Koha::Config->get_instance($file);
		60
		61	Reads C<$file> and returns the corresponding C<Koha::Config> object.
		62
		63	If C<$file> is not given (or undef) it defaults to the result of
		64	C<Koha::Config-E<gt>guess_koha_conf>.
		65
		66	Multiple calls with the same arguments will return the same object, and the
		67	file will be read only the first time.
		68
		69	=cut
		70
		71	our %configs;
		72
		73	sub get_instance {
		74	my ($class, $file) = @_;
		75
		76	$file //= $class->guess_koha_conf;
		77
		78	unless (exists $configs{$file}) {
		79	$configs{$file} = $class->read_from_file($file);
		80	}
		81
		82	return $configs{$file};
		83	}
		84
		85	=head2 read_from_file
		86
		87	$config = Koha::Config->read_from_file($file);
		88
		89	Reads C<$file> and returns the corresponding C<Koha::Config> object.
		90
		91	Unlike C<get_instance>, this method will read the file at every call, so use it
		92	carefully. In most cases, you should use C<get_instance> instead.
		93
		94	=cut
		95
35	sub read_from_file {	96	sub read_from_file {
36	my ( $class, $file ) = @_;	97	my ( $class, $file ) = @_;
37		98
Lines 49-57 sub read_from_file { Link Here
49	die "\nError reading file $file.\nTry running this again as the koha instance user (or use the koha-shell command in debian)\n\n";	110	die "\nError reading file $file.\nTry running this again as the koha instance user (or use the koha-shell command in debian)\n\n";
50	}	111	}
51		112
52	return $config;	113	return bless $config, $class;
		114	}
		115
		116	=head2 guess_koha_conf
		117
		118	$file = Koha::Config->guess_koha_conf;
		119
		120	Returns the path to Koha main configuration file.
		121
		122	Koha's main configuration file koha-conf.xml is searched for according to this
		123	priority list:
		124
		125	=over
		126
		127	=item 1. Path supplied via use C4::Context '/path/to/koha-conf.xml'
		128
		129	=item 2. Path supplied in KOHA_CONF environment variable.
		130
		131	=item 3. Path supplied in INSTALLED_CONFIG_FNAME, as long as value has changed
		132	from its default of '__KOHA_CONF_DIR__/koha-conf.xml', as happens when Koha is
		133	installed in 'standard' or 'single' mode.
		134
		135	=item 4. Path supplied in CONFIG_FNAME.
		136
		137	=back
		138
		139	The first entry that refers to a readable file is used.
		140
		141	=cut
		142
		143	sub guess_koha_conf {
		144
		145	# If the $KOHA_CONF environment variable is set, use
		146	# that. Otherwise, use the built-in default.
		147	my $conf_fname;
		148	if ( exists $ENV{"KOHA_CONF"} and $ENV{'KOHA_CONF'} and -s $ENV{"KOHA_CONF"} ) {
		149	$conf_fname = $ENV{"KOHA_CONF"};
		150	} elsif ( $INSTALLED_CONFIG_FNAME !~ /__KOHA_CONF_DIR/ and -s $INSTALLED_CONFIG_FNAME ) {
		151	# NOTE: be careful -- don't change __KOHA_CONF_DIR in the above
		152	# regex to anything else -- don't want installer to rewrite it
		153	$conf_fname = $INSTALLED_CONFIG_FNAME;
		154	} elsif ( -s CONFIG_FNAME ) {
		155	$conf_fname = CONFIG_FNAME;
		156	}
		157	return $conf_fname;
		158	}
		159
		160	=head1 INSTANCE METHODS
		161
		162	=head2 get
		163
		164	$value = $config->get($key);
		165	$value = $config->get($key, $section);
		166
		167	Returns the configuration entry corresponding to C<$key> and C<$section>.
		168	The returned value can be a string, an arrayref or a hashref.
		169	If C<$key> is not found, it returns undef.
		170
		171	C<$section> can be one of 'listen', 'server', 'serverinfo', 'config'.
		172	If not given, C<$section> defaults to 'config'.
		173
		174	=cut
		175
		176	sub get {
		177	my ($self, $key, $section) = @_;
178
179	$section //= 'config';
180
181	my $value;
182	if (exists $self->{$section} and exists $self->{$section}->{$key}) {
183	$value = $self->{$section}->{$key};
184	}
185
186	return $value;
187	}
188
189	=head2 timezone
190
191	$timezone = $config->timezone
192
193	Returns the configured timezone. If not configured or invalid, it returns
194	'local'.
195
196	=cut
197
198	sub timezone {
199	my ($self) = @_;
200
201	my $timezone = $self->get('timezone') \|\| $ENV{TZ};
202	if ($timezone) {
203	require DateTime::TimeZone;
204	if ( !DateTime::TimeZone->is_valid_name( $timezone ) ) {
205	warn "Invalid timezone in koha-conf.xml ($timezone)";
206	$timezone = 'local';
207	}
208	} else {
209	$timezone = 'local';
210	}
211
212	return $timezone;
53	}	213	}
54		214
		215
55	sub _read_from_dom_node {	216	sub _read_from_dom_node {
56	my ($class, $node, $config) = @_;	217	my ($class, $node, $config) = @_;
57		218
Lines 103-137 sub _read_from_dom_node { Link Here
103	}	264	}
104	}	265	}
105		266
106	# Koha's main configuration file koha-conf.xml
107	# is searched for according to this priority list:
108	#
109	# 1. Path supplied via use C4::Context '/path/to/koha-conf.xml'
110	# 2. Path supplied in KOHA_CONF environment variable.
111	# 3. Path supplied in INSTALLED_CONFIG_FNAME, as long
112	# as value has changed from its default of
113	# '__KOHA_CONF_DIR__/koha-conf.xml', as happens
114	# when Koha is installed in 'standard' or 'single'
115	# mode.
116	# 4. Path supplied in CONFIG_FNAME.
117	#
118	# The first entry that refers to a readable file is used.
119
120	sub guess_koha_conf {
121
122	# If the $KOHA_CONF environment variable is set, use
123	# that. Otherwise, use the built-in default.
124	my $conf_fname;
125	if ( exists $ENV{"KOHA_CONF"} and $ENV{'KOHA_CONF'} and -s $ENV{"KOHA_CONF"} ) {
126	$conf_fname = $ENV{"KOHA_CONF"};
127	} elsif ( $INSTALLED_CONFIG_FNAME !~ /__KOHA_CONF_DIR/ and -s $INSTALLED_CONFIG_FNAME ) {
128	# NOTE: be careful -- don't change __KOHA_CONF_DIR in the above
129	# regex to anything else -- don't want installer to rewrite it
130	$conf_fname = $INSTALLED_CONFIG_FNAME;
131	} elsif ( -s CONFIG_FNAME ) {
132	$conf_fname = CONFIG_FNAME;
133	}
134	return $conf_fname;
135	}
136
137	1;	267	1;

Lines 42-56 Mock the configuration I<$config_entry> with the specified I<$value>. Link Here

(-)a/t/lib/Mocks.pm (-3 / +3 lines)
42	=cut	42	=cut
43		43
44	sub mock_config {	44	sub mock_config {
45	my $context = Test::MockModule->new('C4::Context');	45	my $koha_config = Test::MockModule->new('Koha::Config');
46	my ( $conf, $value ) = @_;	46	my ( $conf, $value ) = @_;
47	$configs{$conf} = $value;	47	$configs{$conf} = $value;
48	$context->mock('config', sub {	48	$koha_config->redefine('get', sub {
49	my ( $self, $conf ) = @_;	49	my ( $self, $conf ) = @_;
50	if ( exists $configs{$conf} ) {	50	if ( exists $configs{$conf} ) {
51	return $configs{$conf}	51	return $configs{$conf}
52	} else {	52	} else {
53	my $method = $context->original('config');	53	my $method = $koha_config->original('get');
54	return $method->($self, $conf);	54	return $method->($self, $conf);
55	}	55	}
56	});	56	});

Lines 1-34 Link Here

(-)a/t/timezones.t (-7 / +6 lines)
1	use Modern::Perl;	1	use Modern::Perl;
2		2
3	use C4::Context;	3	use C4::Context;
		4	use Koha::Config;
4		5
5	use Test::More tests => 5;	6	use Test::More tests => 5;
6	use Test::Warn;	7	use Test::Warn;
7	use t::lib::Mocks;	8	use t::lib::Mocks;
8		9
9	use DateTime::TimeZone;
10
11	$ENV{TZ} = q{};	10	$ENV{TZ} = q{};
12	t::lib::Mocks::mock_config( 'timezone', q{} );	11	t::lib::Mocks::mock_config( 'timezone', q{} );
13	is( C4::Context->timezone, 'local',	12	my $config = Koha::Config->get_instance;
		13	is( $config->timezone, 'local',
14	'Got local timezone with no env or config timezone set' );	14	'Got local timezone with no env or config timezone set' );
15		15
16	$ENV{TZ} = 'Antarctica/Macquarie';	16	$ENV{TZ} = 'Antarctica/Macquarie';
17	is(	17	is(
18	C4::Context->timezone,	18	$config->timezone,
19	'Antarctica/Macquarie',	19	'Antarctica/Macquarie',
20	'Got correct timezone using ENV, overrides local time'	20	'Got correct timezone using ENV, overrides local time'
21	);	21	);
22		22
23	t::lib::Mocks::mock_config( 'timezone', 'Antarctica/South_Pole' );	23	t::lib::Mocks::mock_config( 'timezone', 'Antarctica/South_Pole' );
24	is(	24	is(
25	C4::Context->timezone,	25	$config->timezone,
26	'Antarctica/South_Pole',	26	'Antarctica/South_Pole',
27	'Got correct timezone using config, overrides env'	27	'Got correct timezone using config, overrides env'
28	);	28	);
29		29
30	t::lib::Mocks::mock_config( 'timezone', 'Your/Timezone' );	30	t::lib::Mocks::mock_config( 'timezone', 'Your/Timezone' );
31	warning_is {	31	warning_is {
32	is( C4::Context->timezone, 'local', 'Invalid timezone falls back to local' ); }	32	is( $config->timezone, 'local', 'Invalid timezone falls back to local' ); }
33	'Invalid timezone in koha-conf.xml (Your/Timezone)',	33	'Invalid timezone in koha-conf.xml (Your/Timezone)',
34	'Invalid timezone raises a warning';	34	'Invalid timezone raises a warning';
35	-