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