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