1 package Koha::Database;
3 # Copyright 2013 Catalyst IT
4 # chrisc@catalyst.net.nz
6 # This file is part of Koha.
8 # Koha is free software; you can redistribute it and/or modify it under the
9 # terms of the GNU General Public License as published by the Free Software
10 # Foundation; either version 3 of the License, or (at your option) any later
13 # Koha is distributed in the hope that it will be useful, but WITHOUT ANY
14 # WARRANTY; without even the implied warranty of MERCHANTABILITY or FITNESS FOR
15 # A PARTICULAR PURPOSE. See the GNU General Public License for more details.
17 # You should have received a copy of the GNU General Public License along
18 # with Koha; if not, write to the Free Software Foundation, Inc.,
19 # 51 Franklin Street, Fifth Floor, Boston, MA 02110-1301 USA.
28 my $database = Koha::Database->new();
29 my $schema = $database->schema();
38 use base qw(Class::Accessor);
40 use vars qw($database);
42 __PACKAGE__->mk_accessors(qw( ));
45 # Internal helper function (not a method!). This creates a new
46 # database connection from the data given in the current context, and
52 my $context = C4::Context->new();
54 my $db_driver = $context->{db_driver};
56 my $db_name = $context->config("database");
57 my $db_host = $context->config("hostname");
58 my $db_port = $context->config("port") || '';
59 my $db_user = $context->config("user");
60 my $db_passwd = $context->config("pass");
61 my $tls = $context->config("tls");
63 if( $tls && $tls eq 'yes' ) {
64 my $ca = $context->config('ca');
65 my $cert = $context->config('cert');
66 my $key = $context->config('key');
67 $tls_options = ";mysql_ssl=1;mysql_ssl_client_key=".$key.";mysql_ssl_client_cert=".$cert.";mysql_ssl_ca_file=".$ca;
72 my ( %encoding_attr, $encoding_query, $tz_query, $sql_mode_query );
73 my $tz = C4::Context->timezone;
74 $tz = q{} if ( $tz eq 'local' );
75 if ( $db_driver eq 'mysql' ) {
76 %encoding_attr = ( mysql_enable_utf8 => 1 );
77 $encoding_query = "set NAMES 'utf8mb4'";
78 $tz_query = qq(SET time_zone = "$tz") if $tz;
79 if ( ( exists $ENV{_} && $ENV{_} =~ m|prove| ) or C4::Context->config('strict_sql_modes') ) {
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'};
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'};
85 elsif ( $db_driver eq 'Pg' ) {
86 $encoding_query = "set client_encoding = 'UTF8';";
87 $tz_query = qq(SET TIME ZONE = "$tz") if $tz;
89 my $schema = Koha::Schema->connect(
91 dsn => "dbi:$db_driver:database=$db_name;host=$db_host;port=$db_port".($tls_options? $tls_options : ""),
93 password => $db_passwd,
95 RaiseError => $ENV{DEBUG} ? 1 : 0,
101 $encoding_query || (),
103 $sql_mode_query || (),
108 my $dbh = $schema->storage->dbh;
110 $dbh->{RaiseError} = 1;
111 if ( $ENV{KOHA_DB_DO_NOT_RAISE_OR_PRINT_ERROR} ) {
112 $dbh->{RaiseError} = 0;
113 $dbh->{PrintError} = 0;
116 SELECT * FROM systempreferences WHERE 1 = 0 |
118 $dbh->{RaiseError} = $ENV{DEBUG} ? 1 : 0;
120 $dbh->{RaiseError} = 0 if $@;
127 $schema = $database->schema;
129 Returns a database handle connected to the Koha database for the
130 current context. If no connection has yet been made, this method
131 creates one, and connects to the database.
133 This database handle is cached for future use: if you call
134 C<$database-E<gt>schema> twice, you will get the same handle both
135 times. If you need a second database handle, use C<&new_schema> and
136 possibly C<&set_schema>.
144 unless ( $params->{new} ) {
145 return $database->{schema} if defined $database->{schema};
148 $database->{schema} = &_new_schema();
149 return $database->{schema};
154 $schema = $database->new_schema;
156 Creates a new connection to the Koha database for the current context,
157 and returns the database handle (a C<DBI::db> object).
159 The handle is not saved anywhere: this method is strictly a
160 convenience function; the point is that it knows which database to
161 connect to so that the caller doesn't have to know.
169 return &_new_schema();
174 $my_schema = $database->new_schema;
175 $database->set_schema($my_schema);
177 $database->restore_schema;
179 C<&set_schema> and C<&restore_schema> work in a manner analogous to
180 C<&set_context> and C<&restore_context>.
182 C<&set_schema> saves the current database handle on a stack, then sets
183 the current database handle to C<$my_schema>.
185 C<$my_schema> is assumed to be a good database handle.
191 my $new_schema = shift;
193 # Save the current database handle on the handle stack.
194 # We assume that $new_schema is all good: if the caller wants to
195 # screw himself by passing an invalid handle, that's fine by
197 push @{ $database->{schema_stack} }, $database->{schema};
198 $database->{schema} = $new_schema;
201 =head2 restore_schema
203 $database->restore_schema;
205 Restores the database handle saved by an earlier call to
206 C<$database-E<gt>set_schema>.
213 if ( $#{ $database->{schema_stack} } < 0 ) {
216 die "SCHEMA stack underflow";
219 # Pop the old database handle and set it.
220 $database->{schema} = pop @{ $database->{schema_stack} };
222 # FIXME - If it is determined that restore_context should
223 # return something, then this function should, too.
226 =head2 get_schema_cached
230 sub get_schema_cached {
231 return $database->{schema};
234 =head2 flush_schema_cache
238 sub flush_schema_cache {
239 delete $database->{schema};
250 Chris Cormack, E<lt>chrisc@catalyst.net.nzE<gt>