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