Bug 13645: Cache the DBIx connection

We don't want to recreate a new connection to the DB every time we want
a new schema.

This patch creates a $database package level variable on the same way
it's done in C4::Context for $dbh.

Signed-off-by: Jacek Ablewicz <abl@biblos.pk.edu.pl>
Signed-off-by: Kyle M Hall <kyle@bywatersolutions.com>
Signed-off-by: Tomas Cohen Arazi <tomascohen@gmail.com>
Signed-off-by: Kyle M Hall <kyle@bywatersolutions.com>

diff --git a/Koha/Database.pm b/Koha/Database.pm
index ee2cc91..5587570 100644 (file)
--- a/Koha/Database.pm
+++ b/Koha/Database.pm
@@ -37,6 +37,8 @@ use Carp;
 use C4::Context;
 use base qw(Class::Accessor);
 
+use vars qw($database);
+
 __PACKAGE__->mk_accessors(qw( ));
 
 # _new_schema
@@ -72,14 +74,14 @@ possibly C<&set_schema>.
 sub schema {
     my $self = shift;
     my $sth;
-    if ( defined( $self->{"schema"} ) && $self->{"schema"}->storage->connected() ) {
-        return $self->{"schema"};
+
+    if ( defined( $database->{schema} ) and $database->{schema}->storage->connected() ) {
+        return $database->{schema};
     }
 
     # No database handle or it died . Create one.
-    $self->{"schema"} = &_new_schema();
-
-    return $self->{"schema"};
+    $database->{schema} = &_new_schema();
+    return $database->{schema};
 }
 
 =head2 new_schema
@@ -127,8 +129,8 @@ sub set_schema {
     # We assume that $new_schema is all good: if the caller wants to
     # screw himself by passing an invalid handle, that's fine by
     # us.
-    push @{ $self->{"schema_stack"} }, $self->{"schema"};
-    $self->{"schema"} = $new_schema;
+    push @{ $database->{schema_stack} }, $database->{schema};
+    $database->{schema} = $new_schema;
 }
 
 =head2 restore_schema
@@ -143,14 +145,14 @@ C<$database-E<gt>set_schema>.
 sub restore_schema {
     my $self = shift;
 
-    if ( $#{ $self->{"schema_stack"} } < 0 ) {
+    if ( $#{ $database->{schema_stack} } < 0 ) {
 
         # Stack underflow
         die "SCHEMA stack underflow";
     }
 
     # Pop the old database handle and set it.
-    $self->{"schema"} = pop @{ $self->{"schema_stack"} };
+    $database->{schema} = pop @{ $database->{schema_stack} };
 
     # FIXME - If it is determined that restore_context should
     # return something, then this function should, too.

diff --git a/t/db_dependent/Koha_Database.t b/t/db_dependent/Koha_Database.t
index 8e78e12..d950cb9 100644 (file)
--- a/t/db_dependent/Koha_Database.t
+++ b/t/db_dependent/Koha_Database.t
@@ -4,7 +4,7 @@
 use Modern::Perl;
 use utf8;
 
-use Test::More tests => 10;
+use Test::More tests => 12;
 
 BEGIN {
     use_ok('Koha::Database');
@@ -18,7 +18,11 @@ ok( $schema = $database->schema(), 'Get a schema' );
 my $dbh;
 ok( $dbh = $schema->storage->dbh(), 'Get an old fashioned DBI dbh handle' );
 ok( $schema->storage->connected(), 'Check our db connection is active' );
-ok( $schema = $database->schema(), 'Try and get the same schema' );
+is( ref($schema), 'Koha::Schema', 'Koha::Database->new->schema should return a Koha::Schema' );
+my $another_schema = $database->schema();
+is( $another_schema->storage->_conn_pid, $schema->storage->_conn_pid, 'Getting another schema should return the same one, it has correctly been cached' );
+$another_schema = Koha::Database->new->schema();
+is( $another_schema->storage->_conn_pid, $schema->storage->_conn_pid, 'Getting another schema should return the same one, it has correctly been cached' );
 
 my $new_schema;
 ok( $new_schema = $database->new_schema(), 'Try to get a new schema' );