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