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 Koha::Schema;
  39 use base qw(Class::Accessor);
  40
  41 __PACKAGE__->mk_accessors(qw( ));
  42
  43 # _new_schema
  44 # Internal helper function (not a method!). This creates a new
  45 # database connection from the data given in the current context, and
  46 # returns it.
  47 sub _new_schema {
  48     my $context = C4::Context->new();
  49     my $db_driver = C4::Context::db_scheme2dbi($context->config("db_scheme"));
  50
  51     my $db_name   = $context->config("database");
  52     my $db_host   = $context->config("hostname");
  53     my $db_port   = $context->config("port") || '';
  54     my $db_user   = $context->config("user");
  55     my $db_passwd = $context->config("pass");
  56
  57     my $db_opts = ($db_driver eq 'mysql') ? { mysql_enable_utf8 => 1 } :
  58                   ($db_driver eq 'Pg')    ? { pg_enable_utf8    => 1 } :
  59                                             { };
  60     my $schema    = Koha::Schema->connect(
  61         "DBI:$db_driver:dbname=$db_name;host=$db_host;port=$db_port",
  62         $db_user, $db_passwd, $db_opts );
  63     return $schema;
  64 }
  65
  66 =head2 schema
  67
  68     $schema = $database->schema;
  69
  70 Returns a database handle connected to the Koha database for the
  71 current context. If no connection has yet been made, this method
  72 creates one, and connects to the database.
  73
  74 This database handle is cached for future use: if you call
  75 C<$database-E<gt>schema> twice, you will get the same handle both
  76 times. If you need a second database handle, use C<&new_schema> and
  77 possibly C<&set_schema>.
  78
  79 =cut
  80
  81 sub schema {
  82     my $self = shift;
  83     my $sth;
  84     if ( defined( $self->{"schema"} ) && $self->{"schema"}->storage->connected() ) {
  85         return $self->{"schema"};
  86     }
  87
  88     # No database handle or it died . Create one.
  89     $self->{"schema"} = &_new_schema();
  90
  91     return $self->{"schema"};
  92 }
  93
  94 =head2 new_schema
  95
  96   $schema = $database->new_schema;
  97
  98 Creates a new connection to the Koha database for the current context,
  99 and returns the database handle (a C<DBI::db> object).
 100
 101 The handle is not saved anywhere: this method is strictly a
 102 convenience function; the point is that it knows which database to
 103 connect to so that the caller doesn't have to know.
 104
 105 =cut
 106
 107 #'
 108 sub new_schema {
 109     my $self = shift;
 110
 111     return &_new_schema();
 112 }
 113
 114 =head2 set_schema
 115
 116   $my_schema = $database->new_schema;
 117   $database->set_schema($my_schema);
 118   ...
 119   $database->restore_schema;
 120
 121 C<&set_schema> and C<&restore_schema> work in a manner analogous to
 122 C<&set_context> and C<&restore_context>.
 123
 124 C<&set_schema> saves the current database handle on a stack, then sets
 125 the current database handle to C<$my_schema>.
 126
 127 C<$my_schema> is assumed to be a good database handle.
 128
 129 =cut
 130
 131 sub set_schema {
 132     my $self       = shift;
 133     my $new_schema = shift;
 134
 135     # Save the current database handle on the handle stack.
 136     # We assume that $new_schema is all good: if the caller wants to
 137     # screw himself by passing an invalid handle, that's fine by
 138     # us.
 139     push @{ $self->{"schema_stack"} }, $self->{"schema"};
 140     $self->{"schema"} = $new_schema;
 141 }
 142
 143 =head2 restore_schema
 144
 145   $database->restore_schema;
 146
 147 Restores the database handle saved by an earlier call to
 148 C<$database-E<gt>set_schema>.
 149
 150 =cut
 151
 152 sub restore_schema {
 153     my $self = shift;
 154
 155     if ( $#{ $self->{"schema_stack"} } < 0 ) {
 156
 157         # Stack underflow
 158         die "SCHEMA stack underflow";
 159     }
 160
 161     # Pop the old database handle and set it.
 162     $self->{"schema"} = pop @{ $self->{"schema_stack"} };
 163
 164     # FIXME - If it is determined that restore_context should
 165     # return something, then this function should, too.
 166 }
 167
 168 =head2 EXPORT
 169
 170 None by default.
 171
 172
 173 =head1 AUTHOR
 174
 175 Chris Cormack, E<lt>chrisc@catalyst.net.nzE<gt>
 176
 177 =cut
 178
 179 1;
 180
 181 __END__