Bug 31893: Use checkauth and do not fetch about.tt template
[koha.git] / 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__