← Index
NYTProf Performance Profile   « line view »
For starman worker -M FindBin --max-requests 50 --workers 2 --user=kohadev-koha --group kohadev-koha --pid /var/run/koha/kohadev/plack.pid --daemonize --access-log /var/log/koha/kohadev/plack.log --error-log /var/log/koha/kohadev/plack-error.log -E deployment --socket /var/run/koha/kohadev/plack.sock /etc/koha/sites/kohadev/plack.psgi
  Run on Fri Jan 8 13:50:58 2016
Reported on Fri Jan 8 13:51:28 2016

Filename/home/vagrant/kohaclone/Koha/Database.pm
StatementsExecuted 0 statements in 11.3ms
Line State
ments
Time
on line
Calls Time
in subs
Code
1package 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
23Koha::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
35use Modern::Perl;
36use Carp;
37use C4::Context;
38use base qw(Class::Accessor);
39
40use 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.
48sub _new_schema {
49
50111.0ms require Koha::Schema;
51
52 my $context = C4::Context->new();
53
54 my $db_driver = $context->{db_driver};
55
56 my $db_name = $context->config("database");
57 my $db_host = $context->config("hostname");
58 my $db_port = $context->config("port") || '';
59 my $db_user = $context->config("user");
60 my $db_passwd = $context->config("pass");
61
62 my ( %encoding_attr, $encoding_query, $tz_query );
63 my $tz = $ENV{TZ};
64 if ( $db_driver eq 'mysql' ) {
65 %encoding_attr = ( mysql_enable_utf8 => 1 );
66 $encoding_query = "set NAMES 'utf8'";
67 $tz_query = qq(SET time_zone = "$tz") if $tz;
68 }
69 elsif ( $db_driver eq 'Pg' ) {
70 $encoding_query = "set client_encoding = 'UTF8';";
71 $tz_query = qq(SET TIME ZONE = "$tz") if $tz;
72 }
7313µs my $schema = Koha::Schema->connect(
74 {
75 dsn => "dbi:$db_driver:database=$db_name;host=$db_host;port=$db_port",
76 user => $db_user,
77 password => $db_passwd,
78 %encoding_attr,
79 RaiseError => $ENV{DEBUG} ? 1 : 0,
80 PrintError => 1,
81 unsafe => 1,
82 on_connect_do => [
83 $encoding_query || (),
84 $tz_query || (),
85 ]
86 }
87 );
88
891283µs my $dbh = $schema->storage->dbh;
90 eval {
9117µs $dbh->{RaiseError} = 1;
# spent 7µs making 1 call to DBI::common::STORE
92 $dbh->do(q|
93 SELECT * FROM systempreferences WHERE 1 = 0 |
94 );
9514µs $dbh->{RaiseError} = $ENV{DEBUG} ? 1 : 0;
# spent 4µs making 1 call to DBI::common::STORE
96 };
97 $dbh->{RaiseError} = 0 if $@;
98
99 return $schema;
100}
101
102=head2 schema
103
104 $schema = $database->schema;
105
106Returns a database handle connected to the Koha database for the
107current context. If no connection has yet been made, this method
108creates one, and connects to the database.
109
110This database handle is cached for future use: if you call
111C<$database-E<gt>schema> twice, you will get the same handle both
112times. If you need a second database handle, use C<&new_schema> and
113possibly C<&set_schema>.
114
115=cut
116
117sub schema {
118 my $self = shift;
119 my $params = shift;
120
121 unless ( $params->{new} ) {
122 return $database->{schema} if defined $database->{schema};
123 }
124
125 $database->{schema} = &_new_schema();
126 return $database->{schema};
127}
128
129=head2 new_schema
130
131 $schema = $database->new_schema;
132
133Creates a new connection to the Koha database for the current context,
134and returns the database handle (a C<DBI::db> object).
135
136The handle is not saved anywhere: this method is strictly a
137convenience function; the point is that it knows which database to
138connect to so that the caller doesn't have to know.
139
140=cut
141
142#'
143sub new_schema {
144 my $self = shift;
145
146 return &_new_schema();
147}
148
149=head2 set_schema
150
151 $my_schema = $database->new_schema;
152 $database->set_schema($my_schema);
153 ...
154 $database->restore_schema;
155
156C<&set_schema> and C<&restore_schema> work in a manner analogous to
157C<&set_context> and C<&restore_context>.
158
159C<&set_schema> saves the current database handle on a stack, then sets
160the current database handle to C<$my_schema>.
161
162C<$my_schema> is assumed to be a good database handle.
163
164=cut
165
166sub set_schema {
167 my $self = shift;
168 my $new_schema = shift;
169
170 # Save the current database handle on the handle stack.
171 # We assume that $new_schema is all good: if the caller wants to
172 # screw himself by passing an invalid handle, that's fine by
173 # us.
174 push @{ $database->{schema_stack} }, $database->{schema};
175 $database->{schema} = $new_schema;
176}
177
178=head2 restore_schema
179
180 $database->restore_schema;
181
182Restores the database handle saved by an earlier call to
183C<$database-E<gt>set_schema>.
184
185=cut
186
187sub restore_schema {
188 my $self = shift;
189
190 if ( $#{ $database->{schema_stack} } < 0 ) {
191
192 # Stack underflow
193 die "SCHEMA stack underflow";
194 }
195
196 # Pop the old database handle and set it.
197 $database->{schema} = pop @{ $database->{schema_stack} };
198
199 # FIXME - If it is determined that restore_context should
200 # return something, then this function should, too.
201}
202
203=head2 EXPORT
204
205None by default.
206
207
208=head1 AUTHOR
209
210Chris Cormack, E<lt>chrisc@catalyst.net.nzE<gt>
211
212=cut
213
2141;
215
216__END__