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 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.
  12 #
  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.
  16 #
  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.
  20
  21 =head1 NAME
  22
  23 Koha::Database
  24
  25 =head1 SYNOPSIS
  26
  27   use Koha::Database;
  28   my $database = Koha::Database->new();
  29   my $schema = $database->schema();
  30
  31 =head1 FUNCTIONS
  32
  33 =cut
  34
  35 use Modern::Perl;
  36 use Carp;
  37 use C4::Context;
  38 use base qw(Class::Accessor);
  39
  40 use vars qw($database);
  41
  42 __PACKAGE__->mk_accessors(qw( ));
  43
  44 our $schema; # the schema is a singleton
  45
  46 # _new_schema
  47 # Internal helper function (not a method!). This creates a new
  48 # database connection from the data given in the current context, and
  49 # returns it.
  50 sub _new_schema {
  51
  52     require Koha::Schema;
  53
  54     my $context = C4::Context->new();
  55
  56     my $db_driver = $context->{db_driver};
  57
  58     my $db_name   = $context->config("database");
  59     my $db_host   = $context->config("hostname");
  60     my $db_port   = $context->config("port") || '';
  61     my $db_user   = $context->config("user");
  62     my $db_passwd = $context->config("pass");
  63
  64     my ( %encoding_attr, $encoding_query, $tz_query );
  65     my $tz = $ENV{TZ};
  66     if ( $db_driver eq 'mysql' ) {
  67         %encoding_attr = ( mysql_enable_utf8 => 1 );
  68         $encoding_query = "set NAMES 'utf8'";
  69         $tz_query = qq(SET time_zone = "$tz") if $tz;
  70     }
  71     elsif ( $db_driver eq 'Pg' ) {
  72         $encoding_query = "set client_encoding = 'UTF8';";
  73         $tz_query = qq(SET TIME ZONE = "$tz") if $tz;
  74     }
  75     my $schema = Koha::Schema->connect(
  76         {
  77             dsn => "dbi:$db_driver:database=$db_name;host=$db_host;port=$db_port",
  78             user => $db_user,
  79             password => $db_passwd,
  80             %encoding_attr,
  81             RaiseError => $ENV{DEBUG} ? 1 : 0,
  82             PrintError => 1,
  83             unsafe => 1,
  84             quote_names => 1,
  85             on_connect_do => [
  86                 $encoding_query || (),
  87                 $tz_query || (),
  88             ]
  89         }
  90     );
  91
  92     my $dbh = $schema->storage->dbh;
  93     eval {
  94         $dbh->{RaiseError} = 1;
  95         $dbh->do(q|
  96             SELECT * FROM systempreferences WHERE 1 = 0 |
  97         );
  98         $dbh->{RaiseError} = $ENV{DEBUG} ? 1 : 0;
  99     };
 100     $dbh->{RaiseError} = 0 if $@;
 101
 102     return $schema;
 103 }
 104
 105 =head2 schema
 106
 107     $schema = $database->schema;
 108
 109 Returns a database handle connected to the Koha database for the
 110 current context. If no connection has yet been made, this method
 111 creates one, and connects to the database.
 112
 113 This database handle is cached for future use: if you call
 114 C<$database-E<gt>schema> twice, you will get the same handle both
 115 times. If you need a second database handle, use C<&new_schema>.
 116
 117 =cut
 118
 119 sub schema {
 120     my $self = shift;
 121     my $params = shift;
 122
 123     unless ( $params->{new} ) {
 124         return $database->{schema} if defined $database->{schema};
 125     }
 126
 127     $database->{schema} = &_new_schema();
 128     return $database->{schema};
 129 }
 130
 131 =head2 new_schema
 132
 133   $schema = $database->new_schema;
 134
 135 Creates a new connection to the Koha database for the current context,
 136 and returns the database handle (a C<DBI::db> object).
 137
 138 The handle is not saved anywhere: this method is strictly a
 139 convenience function; the point is that it knows which database to
 140 connect to so that the caller doesn't have to know.
 141
 142 =cut
 143
 144 #'
 145 sub new_schema {
 146     my $self = shift;
 147
 148     return &_new_schema();
 149 }
 150
 151 =head2 set_schema
 152
 153   $my_schema = $database->new_schema;
 154   $database->set_schema($my_schema);
 155   ...
 156   $database->restore_schema;
 157
 158 C<&set_schema> and C<&restore_schema> work in a manner analogous to
 159 C<&set_context> and C<&restore_context>.
 160
 161 C<&set_schema> saves the current database handle on a stack, then sets
 162 the current database handle to C<$my_schema>.
 163
 164 C<$my_schema> is assumed to be a good database handle.
 165
 166 =cut
 167
 168 sub set_schema {
 169     my $self       = shift;
 170     my $new_schema = shift;
 171
 172     # Save the current database handle on the handle stack.
 173     # We assume that $new_schema is all good: if the caller wants to
 174     # screw himself by passing an invalid handle, that's fine by
 175     # us.
 176     push @{ $database->{schema_stack} }, $database->{schema};
 177     $database->{schema} = $new_schema;
 178 }
 179
 180 =head2 restore_schema
 181
 182   $database->restore_schema;
 183
 184 Restores the database handle saved by an earlier call to
 185 C<$database-E<gt>set_schema>.
 186
 187 =cut
 188
 189 sub restore_schema {
 190     my $self = shift;
 191
 192     if ( $#{ $database->{schema_stack} } < 0 ) {
 193
 194         # Stack underflow
 195         die "SCHEMA stack underflow";
 196     }
 197
 198     # Pop the old database handle and set it.
 199     $database->{schema} = pop @{ $database->{schema_stack} };
 200
 201     # FIXME - If it is determined that restore_context should
 202     # return something, then this function should, too.
 203 }
 204
 205 =head2 EXPORT
 206
 207 None by default.
 208
 209
 210 =head1 AUTHOR
 211
 212 Chris Cormack, E<lt>chrisc@catalyst.net.nzE<gt>
 213
 214 =cut
 215
 216 1;
 217
 218 __END__