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