Bug 20538: Fix copyright notice in Asset.pm
[koha.git] / Koha / Database.pm
blobc92056c170aadcbd0b906ee299e8b4e9b4af8e36
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
11 # version.
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.
21 =head1 NAME
23 Koha::Database
25 =head1 SYNOPSIS
27 use Koha::Database;
28 my $database = Koha::Database->new();
29 my $schema = $database->schema();
31 =head1 FUNCTIONS
33 =cut
35 use Modern::Perl;
36 use Carp;
37 use C4::Context;
38 use base qw(Class::Accessor);
40 use vars qw($database);
42 __PACKAGE__->mk_accessors(qw( ));
44 # _new_schema
45 # Internal helper function (not a method!). This creates a new
46 # database connection from the data given in the current context, and
47 # returns it.
48 sub _new_schema {
50 require Koha::Schema;
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");
62 my $tls_options;
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 $sql_mode_query = q{SET sql_mode = 'IGNORE_SPACE,NO_ZERO_IN_DATE,NO_ZERO_DATE,ERROR_FOR_DIVISION_BY_ZERO,NO_AUTO_CREATE_USER,NO_ENGINE_SUBSTITUTION'};
81 elsif ( $db_driver eq 'Pg' ) {
82 $encoding_query = "set client_encoding = 'UTF8';";
83 $tz_query = qq(SET TIME ZONE = "$tz") if $tz;
85 my $schema = Koha::Schema->connect(
87 dsn => "dbi:$db_driver:database=$db_name;host=$db_host;port=$db_port".($tls_options? $tls_options : ""),
88 user => $db_user,
89 password => $db_passwd,
90 %encoding_attr,
91 RaiseError => $ENV{DEBUG} ? 1 : 0,
92 PrintError => 1,
93 unsafe => 1,
94 quote_names => 1,
95 on_connect_do => [
96 $encoding_query || (),
97 $tz_query || (),
98 $sql_mode_query || (),
103 my $dbh = $schema->storage->dbh;
104 eval {
105 $dbh->{RaiseError} = 1;
106 if ( $ENV{KOHA_DB_DO_NOT_RAISE_OR_PRINT_ERROR} ) {
107 $dbh->{RaiseError} = 0;
108 $dbh->{PrintError} = 0;
110 $dbh->do(q|
111 SELECT * FROM systempreferences WHERE 1 = 0 |
113 $dbh->{RaiseError} = $ENV{DEBUG} ? 1 : 0;
115 $dbh->{RaiseError} = 0 if $@;
117 return $schema;
120 =head2 schema
122 $schema = $database->schema;
124 Returns a database handle connected to the Koha database for the
125 current context. If no connection has yet been made, this method
126 creates one, and connects to the database.
128 This database handle is cached for future use: if you call
129 C<$database-E<gt>schema> twice, you will get the same handle both
130 times. If you need a second database handle, use C<&new_schema> and
131 possibly C<&set_schema>.
133 =cut
135 sub schema {
136 my $self = shift;
137 my $params = shift;
139 unless ( $params->{new} ) {
140 return $database->{schema} if defined $database->{schema};
143 $database->{schema} = &_new_schema();
144 return $database->{schema};
147 =head2 new_schema
149 $schema = $database->new_schema;
151 Creates a new connection to the Koha database for the current context,
152 and returns the database handle (a C<DBI::db> object).
154 The handle is not saved anywhere: this method is strictly a
155 convenience function; the point is that it knows which database to
156 connect to so that the caller doesn't have to know.
158 =cut
161 sub new_schema {
162 my $self = shift;
164 return &_new_schema();
167 =head2 set_schema
169 $my_schema = $database->new_schema;
170 $database->set_schema($my_schema);
172 $database->restore_schema;
174 C<&set_schema> and C<&restore_schema> work in a manner analogous to
175 C<&set_context> and C<&restore_context>.
177 C<&set_schema> saves the current database handle on a stack, then sets
178 the current database handle to C<$my_schema>.
180 C<$my_schema> is assumed to be a good database handle.
182 =cut
184 sub set_schema {
185 my $self = shift;
186 my $new_schema = shift;
188 # Save the current database handle on the handle stack.
189 # We assume that $new_schema is all good: if the caller wants to
190 # screw himself by passing an invalid handle, that's fine by
191 # us.
192 push @{ $database->{schema_stack} }, $database->{schema};
193 $database->{schema} = $new_schema;
196 =head2 restore_schema
198 $database->restore_schema;
200 Restores the database handle saved by an earlier call to
201 C<$database-E<gt>set_schema>.
203 =cut
205 sub restore_schema {
206 my $self = shift;
208 if ( $#{ $database->{schema_stack} } < 0 ) {
210 # Stack underflow
211 die "SCHEMA stack underflow";
214 # Pop the old database handle and set it.
215 $database->{schema} = pop @{ $database->{schema_stack} };
217 # FIXME - If it is determined that restore_context should
218 # return something, then this function should, too.
221 =head2 get_schema_cached
223 =cut
225 sub get_schema_cached {
226 return $database->{schema};
229 =head2 flush_schema_cache
231 =cut
233 sub flush_schema_cache {
234 delete $database->{schema};
235 return 1;
238 =head2 EXPORT
240 None by default.
243 =head1 AUTHOR
245 Chris Cormack, E<lt>chrisc@catalyst.net.nzE<gt>
247 =cut
251 __END__