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