Koha/Database.pm

   1 package Koha::Database;
   2
   3 # Copyright 2013 Catalyst IT
   4 # chrisc@catalyst.net.nz
   5 #
   6 # This file is part of Koha.
   7 #
   8 # Koha is free software; you can redistribute it and/or modify it
   9 # under the terms of the GNU General Public License as published by
  10 # the Free Software Foundation; either version 3 of the License, or
  11 # (at your option) any later version.
  12 #
  13 # Koha is distributed in the hope that it will be useful, but
  14 # WITHOUT ANY WARRANTY; without even the implied warranty of
  15 # MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
  16 # GNU General Public License for more details.
  17 #
  18 # You should have received a copy of the GNU General Public License
  19 # along with Koha; if not, see <http://www.gnu.org/licenses>.
  20
  21 =head1 NAME
  22
  23 Koha::Database
  24
  25 =head1 SYNOPSIS
  26
  27   use Koha::Database;
  28   my $schema = Koha::Database->schema();
  29
  30 =head1 FUNCTIONS
  31
  32 =cut
  33
  34 use Modern::Perl;
  35 use DBI;
  36 use Koha::Config;
  37
  38 our $database;
  39
  40 =head2 new
  41
  42     $schema = Koha::Database->new->schema;
  43
  44     FIXME: It is useless to have a Koha::Database object since all methods
  45     below act as class methods
  46     Koha::Database->new->schema is exactly the same as Koha::Database->schema
  47     We should use Koha::Database->schema everywhere and remove the `new` method
  48
  49 =cut
  50
  51 sub new { bless {}, shift }
  52
  53 =head2 dbh
  54
  55     Returns a database handler without loading the DBIx::Class schema.
  56
  57 =cut
  58
  59 sub dbh {
  60     my $config = Koha::Config->get_instance;
  61     my $driver = db_scheme2dbi($config->get('db_scheme'));
  62     my $user = $config->get("user"),
  63     my $pass = $config->get("pass"),
  64     my $dsn = sprintf(
  65         'dbi:%s:database=%s;host=%s;port=%s',
  66         $driver,
  67         $config->get("database_test") || $config->get("database"),
  68         $config->get("hostname"),
  69         $config->get("port") || '',
  70     );
  71
  72     my $attr = {
  73         RaiseError => 1,
  74         PrintError => 1,
  75     };
  76
  77     if ($driver eq 'mysql') {
  78         my $tls = $config->get("tls");
  79         if ($tls && $tls eq 'yes') {
  80             $dsn .= sprintf(
  81                 ';mysql_ssl=1;mysql_ssl_client_key=%s;mysql_ssl_client_cert=%s;mysql_ssl_ca_file=%s',
  82                 $config->get('key'),
  83                 $config->get('cert'),
  84                 $config->get('ca'),
  85             );
  86         }
  87
  88         $attr->{mysql_enable_utf8} = 1;
  89     }
  90
  91     my $dbh = DBI->connect($dsn, $user, $pass, $attr);
  92
  93     if ($dbh) {
  94         my @queries;
  95         my $tz = $config->timezone;
  96         $tz = '' if $tz eq 'local';
  97
  98         if ($driver eq 'mysql') {
  99             push @queries, "SET NAMES 'utf8mb4'";
 100             push @queries, qq{SET time_zone = "$tz"} if $tz;
 101             if (   $config->get('strict_sql_modes')
 102                 || ( exists $ENV{_} && $ENV{_} =~ m|prove| )
 103                 || $ENV{KOHA_TESTING}
 104             ) {
 105                 push @queries, q{
 106                     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'
 107                 };
 108             } else {
 109                 push @queries, q{SET sql_mode = 'IGNORE_SPACE,NO_ZERO_IN_DATE,NO_ZERO_DATE,ERROR_FOR_DIVISION_BY_ZERO,NO_ENGINE_SUBSTITUTION'}
 110             }
 111         } elsif ($driver eq 'Pg') {
 112             push @queries, qq{SET TIME ZONE = "$tz"} if $tz;
 113             push @queries, q{set client_encoding = 'UTF8'};
 114         }
 115
 116         foreach my $query (@queries) {
 117             $dbh->do($query);
 118         }
 119     }
 120
 121     return $dbh;
 122 }
 123
 124
 125 # _new_schema
 126 # Internal helper function (not a method!). This creates a new
 127 # database connection from the data given in the current context, and
 128 # returns it.
 129 sub _new_schema {
 130
 131     require Koha::Schema;
 132
 133     my $schema = Koha::Schema->connect({
 134         dbh_maker => \&Koha::Database::dbh,
 135         quote_names => 1,
 136         auto_savepoint => 1,
 137     });
 138
 139     my $dbh = $schema->storage->dbh;
 140     eval {
 141         my $HandleError = $dbh->{HandleError};
 142         if ( $ENV{KOHA_DB_DO_NOT_RAISE_OR_PRINT_ERROR} ) {
 143             $dbh->{HandleError} = sub { return 1 };
 144         }
 145         $dbh->do(q|
 146             SELECT * FROM systempreferences WHERE 1 = 0 |
 147         );
 148         $dbh->{HandleError} = $HandleError;
 149     };
 150
 151     if ( $@ ) {
 152         $dbh->{HandleError} = sub { warn $_[0]; return 1 };
 153     }
 154
 155     return $schema;
 156 }
 157
 158 =head2 schema
 159
 160     $schema = Koha::Database->schema;
 161     $schema = Koha::Database->schema({ new => 1 });
 162
 163 Returns a database handle connected to the Koha database for the
 164 current context. If no connection has yet been made, this method
 165 creates one, and connects to the database.
 166
 167 This database handle is cached for future use: if you call
 168 C<$database-E<gt>schema> twice, you will get the same handle both
 169 times.
 170
 171 =cut
 172
 173 sub schema {
 174     my ($class, $params) = @_;
 175
 176     unless ( $params->{new} ) {
 177         return $database->{schema} if defined $database->{schema};
 178     }
 179
 180     $database->{schema} = &_new_schema();
 181     return $database->{schema};
 182 }
 183
 184 =head2 db_scheme2dbi
 185
 186     my $dbd_driver_name = Koha::Database::db_scheme2dbi($scheme);
 187
 188 This routines translates a database type to part of the name
 189 of the appropriate DBD driver to use when establishing a new
 190 database connection.  It recognizes 'mysql' and 'Pg'; if any
 191 other scheme is supplied it defaults to 'mysql'.
 192
 193 =cut
 194
 195 sub db_scheme2dbi {
 196     my $scheme = shift // '';
 197     return $scheme eq 'Pg' ? $scheme : 'mysql';
 198 }
 199
 200 =head2 EXPORT
 201
 202 None by default.
 203
 204
 205 =head1 AUTHOR
 206
 207 Chris Cormack, E<lt>chrisc@catalyst.net.nzE<gt>
 208
 209 =cut
 210
 211 1;
 212
 213 __END__