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

(-)a/C4/Context.pm (-62 / +16 lines)
Lines 119-140 environment variable to the pathname of a configuration file to use. Link Here
119
$context = undef;        # Initially, no context is set
119
$context = undef;        # Initially, no context is set
120
@context_stack = ();        # Initially, no saved contexts
120
@context_stack = ();        # Initially, no saved contexts
121
121
122
=head2 db_scheme2dbi
123
124
    my $dbd_driver_name = C4::Context::db_schema2dbi($scheme);
125
126
This routines translates a database type to part of the name
127
of the appropriate DBD driver to use when establishing a new
128
database connection.  It recognizes 'mysql' and 'Pg'; if any
129
other scheme is supplied it defaults to 'mysql'.
130
131
=cut
132
133
sub db_scheme2dbi {
134
    my $scheme = shift // '';
135
    return $scheme eq 'Pg' ? $scheme : 'mysql';
136
}
137
138
sub import {
122
sub import {
139
    # Create the default context ($C4::Context::Context)
123
    # Create the default context ($C4::Context::Context)
140
    # the first time the module is called
124
    # the first time the module is called
Lines 190-197 sub new { Link Here
190
        }
174
        }
191
    }
175
    }
192
176
193
    my $self = Koha::Config->read_from_file($conf_fname);
177
    my $self = {};
194
    unless ( exists $self->{config} or defined $self->{config} ) {
178
    $self->{config} = Koha::Config->get_instance($conf_fname);
179
    unless ( defined $self->{config} ) {
195
        warn "The config file ($conf_fname) has not been parsed correctly";
180
        warn "The config file ($conf_fname) has not been parsed correctly";
196
        return;
181
        return;
197
    }
182
    }
Lines 203-209 sub new { Link Here
203
    $self->{tz} = undef; # local timezone object
188
    $self->{tz} = undef; # local timezone object
204
189
205
    bless $self, $class;
190
    bless $self, $class;
206
    $self->{db_driver} = db_scheme2dbi($self->config('db_scheme'));  # cache database driver
207
    return $self;
191
    return $self;
208
}
192
}
209
193
Lines 285-312 sub restore_context Link Here
285
269
286
  $value = C4::Context->config("config_variable");
270
  $value = C4::Context->config("config_variable");
287
271
288
  $value = C4::Context->config_variable;
289
290
Returns the value of a variable specified in the configuration file
272
Returns the value of a variable specified in the configuration file
291
from which the current context was created.
273
from which the current context was created.
292
274
293
The second form is more compact, but of course may conflict with
294
method names. If there is a configuration variable called "new", then
295
C<C4::Config-E<gt>new> will not return it.
296
297
=cut
275
=cut
298
276
299
sub _common_config {
277
sub _common_config {
300
	my $var = shift;
278
    my ($var, $term) = @_;
301
	my $term = shift;
279
302
    return unless defined $context and defined $context->{$term};
280
    return unless defined $context and defined $context->{config};
303
       # Presumably $self->{$term} might be
281
304
       # undefined if the config file given to &new
282
    return $context->{config}->get($var, $term);
305
       # didn't exist, and the caller didn't bother
306
       # to check the return value.
307
308
    # Return the value of the requested config variable
309
    return $context->{$term}->{$var};
310
}
283
}
311
284
312
sub config {
285
sub config {
Lines 560-579 sub _new_Zconn { Link Here
560
    $syntax = 'xml';
533
    $syntax = 'xml';
561
    $elementSetName = 'marcxml';
534
    $elementSetName = 'marcxml';
562
535
563
    my $host = $context->{'listen'}->{$server}->{'content'};
536
    my $host = _common_config($server, 'listen')->{content};
564
    my $user = $context->{"serverinfo"}->{$server}->{"user"};
537
    my $serverinfo = _common_config($server, 'serverinfo');
565
    my $password = $context->{"serverinfo"}->{$server}->{"password"};
538
    my $user = $serverinfo->{user};
539
    my $password = $serverinfo->{password};
566
    eval {
540
    eval {
567
        # set options
541
        # set options
568
        my $o = ZOOM::Options->new();
542
        my $o = ZOOM::Options->new();
569
        $o->option(user => $user) if $user && $password;
543
        $o->option(user => $user) if $user && $password;
570
        $o->option(password => $password) if $user && $password;
544
        $o->option(password => $password) if $user && $password;
571
        $o->option(async => 1) if $async;
545
        $o->option(async => 1) if $async;
572
        $o->option(cqlfile=> $context->{"server"}->{$server}->{"cql2rpn"});
546
        $o->option(cqlfile=> _common_config($server, 'server')->{cql2rpn});
573
        $o->option(cclfile=> $context->{"serverinfo"}->{$server}->{"ccl2rpn"});
547
        $o->option(cclfile=> $serverinfo->{ccl2rpn});
574
        $o->option(preferredRecordSyntax => $syntax);
548
        $o->option(preferredRecordSyntax => $syntax);
575
        $o->option(elementSetName => $elementSetName) if $elementSetName;
549
        $o->option(elementSetName => $elementSetName) if $elementSetName;
576
        $o->option(databaseName => $context->{"config"}->{$server}||"biblios");
550
        $o->option(databaseName => _common_config($server, 'config') || 'biblios');
577
551
578
        # create a new connection object
552
        # create a new connection object
579
        $Zconn= create ZOOM::Connection($o);
553
        $Zconn= create ZOOM::Connection($o);
Lines 858-883 sub get_versions { Link Here
858
    return %versions;
832
    return %versions;
859
}
833
}
860
834
861
=head2 timezone
862
863
  my $C4::Context->timzone
864
865
  Returns a timezone code for the instance of Koha
866
867
=cut
868
869
sub timezone {
870
    my $self = shift;
871
872
    my $timezone = C4::Context->config('timezone') || $ENV{TZ} || 'local';
873
    if ( !DateTime::TimeZone->is_valid_name( $timezone ) ) {
874
        warn "Invalid timezone in koha-conf.xml ($timezone)";
875
        $timezone = 'local';
876
    }
877
878
    return $timezone;
879
}
880
881
=head2 tz
835
=head2 tz
882
836
883
  C4::Context->tz
837
  C4::Context->tz
Lines 889-895 sub timezone { Link Here
889
sub tz {
843
sub tz {
890
    my $self = shift;
844
    my $self = shift;
891
    if (!defined $context->{tz}) {
845
    if (!defined $context->{tz}) {
892
        my $timezone = $self->timezone;
846
        my $timezone = $context->{config}->timezone;
893
        $context->{tz} = DateTime::TimeZone->new(name => $timezone);
847
        $context->{tz} = DateTime::TimeZone->new(name => $timezone);
894
    }
848
    }
895
    return $context->{tz};
849
    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 ':libxml';
41
use XML::LibXML ':libxml';
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 (-66 / +99 lines)
Lines 25-45 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 Carp;
35
use DBI;
37
use C4::Context;
36
use Koha::Config;
38
use base qw(Class::Accessor);
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
    }
39
107
40
use vars qw($database);
108
    return $dbh;
109
}
41
110
42
__PACKAGE__->mk_accessors(qw( ));
43
111
44
# _new_schema
112
# _new_schema
45
# Internal helper function (not a method!). This creates a new
113
# Internal helper function (not a method!). This creates a new
Lines 49-110 sub _new_schema { Link Here
49
117
50
    require Koha::Schema;
118
    require Koha::Schema;
51
119
52
    my $db_driver = C4::Context::db_scheme2dbi(C4::Context->config('db_scheme'));;
120
    my $schema = Koha::Schema->connect({
53
121
        dbh_maker => \&Koha::Database::dbh,
54
    my $db_name   = C4::Context->config("database");
122
        quote_names => 1,
55
    my $db_host   = C4::Context->config("hostname");
123
        auto_savepoint => 1,
56
    my $db_port   = C4::Context->config("port") || '';
124
    });
57
    my $db_user   = C4::Context->config("user");
58
    my $db_passwd = C4::Context->config("pass");
59
    my $tls = C4::Context->config("tls");
60
    my $tls_options;
61
    if( $tls && $tls eq 'yes' ) {
62
        my $ca = C4::Context->config('ca');
63
        my $cert = C4::Context->config('cert');
64
        my $key = C4::Context->config('key');
65
        $tls_options = ";mysql_ssl=1;mysql_ssl_client_key=".$key.";mysql_ssl_client_cert=".$cert.";mysql_ssl_ca_file=".$ca;
66
    }
67
68
69
70
    my ( %encoding_attr, $encoding_query, $tz_query, $sql_mode_query );
71
    my $tz = C4::Context->timezone;
72
    $tz = q{} if ( $tz eq 'local' );
73
    if ( $db_driver eq 'mysql' ) {
74
        %encoding_attr = ( mysql_enable_utf8 => 1 );
75
        $encoding_query = "set NAMES 'utf8mb4'";
76
        $tz_query = qq(SET time_zone = "$tz") if $tz;
77
        if (   C4::Context->config('strict_sql_modes')
78
            || ( exists $ENV{_} && $ENV{_} =~ m|prove| )
79
            || $ENV{KOHA_TESTING}
80
        ) {
81
            $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'};
82
        } else {
83
            $sql_mode_query = q{SET sql_mode = 'IGNORE_SPACE,NO_ZERO_IN_DATE,NO_ZERO_DATE,ERROR_FOR_DIVISION_BY_ZERO,NO_ENGINE_SUBSTITUTION'};
84
        }
85
    }
86
    elsif ( $db_driver eq 'Pg' ) {
87
        $encoding_query = "set client_encoding = 'UTF8';";
88
        $tz_query = qq(SET TIME ZONE = "$tz") if $tz;
89
    }
90
91
    my $schema = Koha::Schema->connect(
92
        {
93
            dsn => "dbi:$db_driver:database=$db_name;host=$db_host;port=$db_port".($tls_options? $tls_options : ""),
94
            user => $db_user,
95
            password => $db_passwd,
96
            %encoding_attr,
97
            RaiseError => 1,
98
            PrintError => 1,
99
            quote_names => 1,
100
            auto_savepoint => 1,
101
            on_connect_do => [
102
                $encoding_query || (),
103
                $tz_query || (),
104
                $sql_mode_query || (),
105
            ]
106
        }
107
    );
108
125
109
    my $dbh = $schema->storage->dbh;
126
    my $dbh = $schema->storage->dbh;
110
    eval {
127
    eval {
Lines 127-133 sub _new_schema { Link Here
127
144
128
=head2 schema
145
=head2 schema
129
146
130
    $schema = $database->schema;
147
    $schema = Koha::Database->schema;
148
    $schema = Koha::Database->schema({ new => 1 });
131
149
132
Returns a database handle connected to the Koha database for the
150
Returns a database handle connected to the Koha database for the
133
current context. If no connection has yet been made, this method
151
current context. If no connection has yet been made, this method
Lines 141-148 possibly C<&set_schema>. Link Here
141
=cut
159
=cut
142
160
143
sub schema {
161
sub schema {
144
    my $self = shift;
162
    my ($class, $params) = @_;
145
    my $params = shift;
146
163
147
    unless ( $params->{new} ) {
164
    unless ( $params->{new} ) {
148
        return $database->{schema} if defined $database->{schema};
165
        return $database->{schema} if defined $database->{schema};
Lines 243-248 sub flush_schema_cache { Link Here
243
    return 1;
260
    return 1;
244
}
261
}
245
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
246
=head2 EXPORT
279
=head2 EXPORT
247
280
248
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 / +60 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 235-237 subtest 'read_from_file() tests' => sub { Link Here
235
    like( $@, qr{.*Error reading file.*}, 'File failing to read raises warning');
235
    like( $@, qr{.*Error reading file.*}, 'File failing to read raises warning');
236
};
236
};
237
237
238
subtest 'get_instance' => sub {
239
    plan tests => 3;
240
241
    my $config = Koha::Config->get_instance($config_filepath);
242
    isa_ok($config, 'Koha::Config', 'get_instance returns a Koha::Config object');
243
    my $same_config = Koha::Config->get_instance($config_filepath);
244
    is($config, $same_config, '2nd call to get_instance returns the same object');
245
246
    local $ENV{KOHA_CONF} = $config_filepath;
247
    my $default_config = Koha::Config->get_instance;
248
    is($default_config, $config, 'get_instance without parameters reads $KOHA_CONF');
249
};
250
251
subtest 'get' => sub {
252
    plan tests => 7;
253
254
    my $config = Koha::Config->get_instance($config_filepath);
255
256
    is_deeply(
257
        $config->get('biblioserver', 'listen'),
258
        { content => 'unix:/home/koha/var/run/zebradb/bibliosocket' },
259
    );
260
261
    is_deeply(
262
        $config->get('biblioserver', 'server'),
263
        {
264
            'listenref' => 'biblioserver',
265
            'directory' => '/home/koha/var/lib/zebradb/biblios',
266
            'config' => '/home/koha/etc/zebradb/zebra-biblios-dom.cfg',
267
            'cql2rpn' => '/home/koha/etc/zebradb/pqf.properties',
268
            'xi:include' => [
269
                {
270
                    'href' => '/home/koha/etc/zebradb/retrieval-info-bib-dom.xml',
271
                    'xmlns:xi' => 'http://www.w3.org/2001/XInclude'
272
                },
273
                {
274
                    'xmlns:xi' => 'http://www.w3.org/2001/XInclude',
275
                    'href' => '/home/koha/etc/zebradb/explain-biblios.xml'
276
                }
277
            ],
278
        },
279
    );
280
281
    is_deeply(
282
        $config->get('biblioserver', 'serverinfo'),
283
        {
284
            'ccl2rpn' => '/home/koha/etc/zebradb/ccl.properties',
285
            'user' => 'kohauser',
286
            'password' => 'zebrastripes',
287
        },
288
    );
289
290
    is($config->get('db_scheme'), 'mysql');
291
    is($config->get('ca'), '');
292
293
    is($config->get('unicorn'), undef, 'returns undef if key does not exist');
294
    is_deeply([$config->get('unicorn')], [undef], 'returns undef even in list context');
295
};
296
(-)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 7-21 use Test::MockModule; Link Here
7
7
8
my %configs;
8
my %configs;
9
sub mock_config {
9
sub mock_config {
10
    my $context = Test::MockModule->new('C4::Context');
10
    my $koha_config = Test::MockModule->new('Koha::Config');
11
    my ( $conf, $value ) = @_;
11
    my ( $conf, $value ) = @_;
12
    $configs{$conf} = $value;
12
    $configs{$conf} = $value;
13
    $context->mock('config', sub {
13
    $koha_config->redefine('get', sub {
14
        my ( $self, $conf ) = @_;
14
        my ( $self, $conf ) = @_;
15
        if ( exists $configs{$conf} ) {
15
        if ( exists $configs{$conf} ) {
16
            return $configs{$conf}
16
            return $configs{$conf}
17
        } else {
17
        } else {
18
            my $method = $context->original('config');
18
            my $method = $koha_config->original('get');
19
            return $method->($self, $conf);
19
            return $method->($self, $conf);
20
        }
20
        }
21
    });
21
    });
(-)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