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

(-)a/C4/Context.pm (-62 / +16 lines)
Lines 117-138 environment variable to the pathname of a configuration file to use. Link Here
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};
(-)a/Koha/Config.pm (-34 / +164 lines)
Lines 15-20 package Koha::Config; Link Here
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;
(-)a/Koha/Database.pm (-65 / +99 lines)
Lines 25-44 Koha::Database Link Here
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.
(-)a/t/Context.t (-6 / +1 lines)
Lines 18-24 Link Here
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] };
(-)a/t/Koha/Config.t (-1 / +59 lines)
Lines 17-23 Link Here
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
};
(-)a/t/db_dependent/Koha/Database.t (-1 / +10 lines)
Lines 16-22 Link Here
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
};
(-)a/t/lib/Mocks.pm (-3 / +3 lines)
Lines 42-56 Mock the configuration I<$config_entry> with the specified I<$value>. Link Here
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
    });
(-)a/t/timezones.t (-7 / +6 lines)
Lines 1-34 Link Here
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
- 

Return to bug 28306