View | Details | Raw Unified | Return to bug 8798
Collapse All | Expand All

(-)a/C4/Context.pm (-127 lines)
Lines 19-25 package C4::Context; Link Here
19
use strict;
19
use strict;
20
use warnings;
20
use warnings;
21
use vars qw($VERSION $AUTOLOAD $context @context_stack $servers $memcached $ismemcached);
21
use vars qw($VERSION $AUTOLOAD $context @context_stack $servers $memcached $ismemcached);
22
$ENV{'DBIC_DONT_VALIDATE_RELS'} = 1; # FIXME once the DBIx schema has its schema adjusted we should remove this
23
BEGIN {
22
BEGIN {
24
	if ($ENV{'HTTP_USER_AGENT'})	{
23
	if ($ENV{'HTTP_USER_AGENT'})	{
25
		require CGI::Carp;
24
		require CGI::Carp;
Lines 99-105 BEGIN { Link Here
99
}
98
}
100
99
101
use DBI;
100
use DBI;
102
require Koha::Schema;
103
use ZOOM;
101
use ZOOM;
104
use XML::Simple;
102
use XML::Simple;
105
use C4::Boolean;
103
use C4::Boolean;
Lines 988-1118 sub _new_queryparser { Link Here
988
    return;
986
    return;
989
}
987
}
990
988
991
# _new_schema
992
# Internal helper function (not a method!). This creates a new
993
# database connection from the data given in the current context, and
994
# returns it.
995
sub _new_schema {
996
    my $db_driver;
997
    if ($context->config("db_scheme")){
998
        $db_driver=db_scheme2dbi($context->config("db_scheme"));
999
    }else{
1000
        $db_driver="mysql";
1001
    }
1002
1003
    my $db_name   = $context->config("database");
1004
    my $db_host   = $context->config("hostname");
1005
    my $db_port   = $context->config("port") || '';
1006
    my $db_user   = $context->config("user");
1007
    my $db_passwd = $context->config("pass");
1008
    my $schema = Koha::Schema->connect(
1009
        "DBI:$db_driver:dbname=$db_name;host=$db_host;port=$db_port",
1010
        $db_user, $db_passwd );
1011
    return $schema;
1012
}
1013
1014
=head2 schema
1015
1016
    $schema = C4::Context->schema;
1017
1018
Returns a database handle connected to the Koha database for the
1019
current context. If no connection has yet been made, this method
1020
creates one, and connects to the database.
1021
1022
This database handle is cached for future use: if you call
1023
C<C4::Context-E<gt>schema> twice, you will get the same handle both
1024
times. If you need a second database handle, use C<&new_schema> and
1025
possibly C<&set_schema>.
1026
1027
=cut
1028
1029
sub schema {
1030
    my $self = shift;
1031
    my $sth;
1032
1033
    if ( defined( $context->{"schema"} ) && $context->{"schema"}->ping() ) {
1034
        return $context->{"schema"};
1035
    }
1036
1037
    # No database handle or it died . Create one.
1038
    $context->{"schema"} = &_new_schema();
1039
1040
    return $context->{"schema"};
1041
}
1042
1043
=head2 new_schema
1044
1045
  $schema = C4::Context->new_schema;
1046
1047
Creates a new connection to the Koha database for the current context,
1048
and returns the database handle (a C<DBI::db> object).
1049
1050
The handle is not saved anywhere: this method is strictly a
1051
convenience function; the point is that it knows which database to
1052
connect to so that the caller doesn't have to know.
1053
1054
=cut
1055
1056
#'
1057
sub new_schema {
1058
    my $self = shift;
1059
1060
    return &_new_schema();
1061
}
1062
1063
=head2 set_schema
1064
1065
  $my_schema = C4::Connect->new_schema;
1066
  C4::Connect->set_schema($my_schema);
1067
  ...
1068
  C4::Connect->restore_schema;
1069
1070
C<&set_schema> and C<&restore_schema> work in a manner analogous to
1071
C<&set_context> and C<&restore_context>.
1072
1073
C<&set_schema> saves the current database handle on a stack, then sets
1074
the current database handle to C<$my_schema>.
1075
1076
C<$my_schema> is assumed to be a good database handle.
1077
1078
=cut
1079
1080
sub set_schema {
1081
    my $self = shift;
1082
    my $new_schema = shift;
1083
1084
    # Save the current database handle on the handle stack.
1085
    # We assume that $new_schema is all good: if the caller wants to
1086
    # screw himself by passing an invalid handle, that's fine by
1087
    # us.
1088
    push @{$context->{"schema_stack"}}, $context->{"schema"};
1089
    $context->{"schema"} = $new_schema;
1090
}
1091
1092
=head2 restore_schema
1093
1094
  C4::Context->restore_schema;
1095
1096
Restores the database handle saved by an earlier call to
1097
C<C4::Context-E<gt>set_schema>.
1098
1099
=cut
1100
1101
sub restore_schema {
1102
    my $self = shift;
1103
1104
    if ($#{$context->{"schema_stack"}} < 0) {
1105
        # Stack underflow
1106
        die "SCHEMA stack underflow";
1107
    }
1108
1109
    # Pop the old database handle and set it.
1110
    $context->{"schema"} = pop @{$context->{"schema_stack"}};
1111
1112
    # FIXME - If it is determined that restore_context should
1113
    # return something, then this function should, too.
1114
}
1115
1116
=head2 marcfromkohafield
989
=head2 marcfromkohafield
1117
990
1118
  $dbh = C4::Context->marcfromkohafield;
991
  $dbh = C4::Context->marcfromkohafield;
(-)a/Koha/Database.pm (+185 lines)
Line 0 Link Here
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
$ENV{'DBIC_DONT_VALIDATE_RELS'} = 1; # FIXME once the DBIx schema has its schema adjusted we should remove this
36
37
use Modern::Perl;
38
use Carp;
39
use C4::Context;
40
use Koha::Schema;
41
use base qw(Class::Accessor);
42
43
__PACKAGE__->mk_accessors(qw( ));
44
45
# _new_schema
46
# Internal helper function (not a method!). This creates a new
47
# database connection from the data given in the current context, and
48
# returns it.
49
sub _new_schema {
50
    my $db_driver;
51
    my $context = C4::Context->new();
52
    if ( $context->config("db_scheme") ) {
53
        $db_driver = $context->db_scheme2dbi( $context->config("db_scheme") );
54
    }
55
    else {
56
        $db_driver = "mysql";
57
    }
58
59
    my $db_name   = $context->config("database");
60
    my $db_host   = $context->config("hostname");
61
    my $db_port   = $context->config("port") || '';
62
    my $db_user   = $context->config("user");
63
    my $db_passwd = $context->config("pass");
64
    my $schema    = Koha::Schema->connect(
65
        "DBI:$db_driver:dbname=$db_name;host=$db_host;port=$db_port",
66
        $db_user, $db_passwd );
67
    return $schema;
68
}
69
70
=head2 schema
71
72
    $schema = $database->schema;
73
74
Returns a database handle connected to the Koha database for the
75
current context. If no connection has yet been made, this method
76
creates one, and connects to the database.
77
78
This database handle is cached for future use: if you call
79
C<$database-E<gt>schema> twice, you will get the same handle both
80
times. If you need a second database handle, use C<&new_schema> and
81
possibly C<&set_schema>.
82
83
=cut
84
85
sub schema {
86
    my $self = shift;
87
    my $sth;
88
    if ( defined( $self->{"schema"} ) && $self->{"schema"}->storage->connected() ) {
89
        return $self->{"schema"};
90
    }
91
92
    # No database handle or it died . Create one.
93
    $self->{"schema"} = &_new_schema();
94
95
    return $self->{"schema"};
96
}
97
98
=head2 new_schema
99
100
  $schema = $database->new_schema;
101
102
Creates a new connection to the Koha database for the current context,
103
and returns the database handle (a C<DBI::db> object).
104
105
The handle is not saved anywhere: this method is strictly a
106
convenience function; the point is that it knows which database to
107
connect to so that the caller doesn't have to know.
108
109
=cut
110
111
#'
112
sub new_schema {
113
    my $self = shift;
114
115
    return &_new_schema();
116
}
117
118
=head2 set_schema
119
120
  $my_schema = $database->new_schema;
121
  $database->set_schema($my_schema);
122
  ...
123
  $database->restore_schema;
124
125
C<&set_schema> and C<&restore_schema> work in a manner analogous to
126
C<&set_context> and C<&restore_context>.
127
128
C<&set_schema> saves the current database handle on a stack, then sets
129
the current database handle to C<$my_schema>.
130
131
C<$my_schema> is assumed to be a good database handle.
132
133
=cut
134
135
sub set_schema {
136
    my $self       = shift;
137
    my $new_schema = shift;
138
139
    # Save the current database handle on the handle stack.
140
    # We assume that $new_schema is all good: if the caller wants to
141
    # screw himself by passing an invalid handle, that's fine by
142
    # us.
143
    push @{ $self->{"schema_stack"} }, $self->{"schema"};
144
    $self->{"schema"} = $new_schema;
145
}
146
147
=head2 restore_schema
148
149
  $database->restore_schema;
150
151
Restores the database handle saved by an earlier call to
152
C<$database-E<gt>set_schema>.
153
154
=cut
155
156
sub restore_schema {
157
    my $self = shift;
158
159
    if ( $#{ $self->{"schema_stack"} } < 0 ) {
160
161
        # Stack underflow
162
        die "SCHEMA stack underflow";
163
    }
164
165
    # Pop the old database handle and set it.
166
    $self->{"schema"} = pop @{ $self->{"schema_stack"} };
167
168
    # FIXME - If it is determined that restore_context should
169
    # return something, then this function should, too.
170
}
171
172
=head2 EXPORT
173
174
None by default.
175
176
177
=head1 AUTHOR
178
179
Chris Cormack, E<lt>chrisc@catalyst.net.nzE<gt>
180
181
=cut
182
183
1;
184
185
__END__
(-)a/t/db_dependent/Koha_Database.t (-1 / +27 lines)
Line 0 Link Here
0
- 
1
#!/usr/bin/perl
2
#
3
4
use strict;
5
use warnings;
6
7
use Test::More tests => 9;
8
9
BEGIN {
10
    use_ok('Koha::Database');
11
}
12
13
my $database;
14
ok( $database = Koha::Database->new(), 'Created Koha::Database Object' );
15
16
my $schema;
17
ok( $schema = $database->schema(), 'Get a schema' );
18
my $dbh;
19
ok( $dbh = $schema->storage->dbh(), 'Get an old fashioned DBI dbh handle' );
20
ok( $schema->storage->connected(), 'Check our db connection is active' );
21
ok( $schema = $database->schema(), 'Try and get the same schema' );
22
23
my $new_schema;
24
ok( $new_schema = $database->new_schema(), 'Try to get a new schema' );
25
ok( $database->set_schema($new_schema), 'Switch to new schema' );
26
ok( $database->restore_schema(),        'Switch back' );
27

Return to bug 8798