From 398b9dfdbd6f0bba6f001c44e6d2576b3b5a29ec Mon Sep 17 00:00:00 2001 From: Chris Cormack Date: Wed, 19 Jun 2013 10:17:21 +1200 Subject: [PATCH] Bug 8798: moving code to Koha::Database and adding tests - Fixing a bug .. ping does not exist we need to use connected Signed-off-by: Galen Charlton --- C4/Context.pm | 127 ---------------------- Koha/Database.pm | 185 +++++++++++++++++++++++++++++++++ t/db_dependent/Koha_Database.t | 27 +++++ 3 files changed, 212 insertions(+), 127 deletions(-) create mode 100644 Koha/Database.pm create mode 100644 t/db_dependent/Koha_Database.t diff --git a/C4/Context.pm b/C4/Context.pm index db09a86c23..39927d4c3d 100644 --- a/C4/Context.pm +++ b/C4/Context.pm @@ -19,7 +19,6 @@ package C4::Context; use strict; use warnings; use vars qw($VERSION $AUTOLOAD $context @context_stack $servers $memcached $ismemcached); -$ENV{'DBIC_DONT_VALIDATE_RELS'} = 1; # FIXME once the DBIx schema has its schema adjusted we should remove this BEGIN { if ($ENV{'HTTP_USER_AGENT'}) { require CGI::Carp; @@ -99,7 +98,6 @@ BEGIN { } use DBI; -require Koha::Schema; use ZOOM; use XML::Simple; use C4::Boolean; @@ -995,131 +993,6 @@ sub _new_queryparser { return; } -# _new_schema -# Internal helper function (not a method!). This creates a new -# database connection from the data given in the current context, and -# returns it. -sub _new_schema { - my $db_driver; - if ($context->config("db_scheme")){ - $db_driver=db_scheme2dbi($context->config("db_scheme")); - }else{ - $db_driver="mysql"; - } - - my $db_name = $context->config("database"); - my $db_host = $context->config("hostname"); - my $db_port = $context->config("port") || ''; - my $db_user = $context->config("user"); - my $db_passwd = $context->config("pass"); - my $schema = Koha::Schema->connect( - "DBI:$db_driver:dbname=$db_name;host=$db_host;port=$db_port", - $db_user, $db_passwd ); - return $schema; -} - -=head2 schema - - $schema = C4::Context->schema; - -Returns a database handle connected to the Koha database for the -current context. If no connection has yet been made, this method -creates one, and connects to the database. - -This database handle is cached for future use: if you call -Cschema> twice, you will get the same handle both -times. If you need a second database handle, use C<&new_schema> and -possibly C<&set_schema>. - -=cut - -sub schema { - my $self = shift; - my $sth; - - if ( defined( $context->{"schema"} ) && $context->{"schema"}->ping() ) { - return $context->{"schema"}; - } - - # No database handle or it died . Create one. - $context->{"schema"} = &_new_schema(); - - return $context->{"schema"}; -} - -=head2 new_schema - - $schema = C4::Context->new_schema; - -Creates a new connection to the Koha database for the current context, -and returns the database handle (a C object). - -The handle is not saved anywhere: this method is strictly a -convenience function; the point is that it knows which database to -connect to so that the caller doesn't have to know. - -=cut - -#' -sub new_schema { - my $self = shift; - - return &_new_schema(); -} - -=head2 set_schema - - $my_schema = C4::Connect->new_schema; - C4::Connect->set_schema($my_schema); - ... - C4::Connect->restore_schema; - -C<&set_schema> and C<&restore_schema> work in a manner analogous to -C<&set_context> and C<&restore_context>. - -C<&set_schema> saves the current database handle on a stack, then sets -the current database handle to C<$my_schema>. - -C<$my_schema> is assumed to be a good database handle. - -=cut - -sub set_schema { - my $self = shift; - my $new_schema = shift; - - # Save the current database handle on the handle stack. - # 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 @{$context->{"schema_stack"}}, $context->{"schema"}; - $context->{"schema"} = $new_schema; -} - -=head2 restore_schema - - C4::Context->restore_schema; - -Restores the database handle saved by an earlier call to -Cset_schema>. - -=cut - -sub restore_schema { - my $self = shift; - - if ($#{$context->{"schema_stack"}} < 0) { - # Stack underflow - die "SCHEMA stack underflow"; - } - - # Pop the old database handle and set it. - $context->{"schema"} = pop @{$context->{"schema_stack"}}; - - # FIXME - If it is determined that restore_context should - # return something, then this function should, too. -} - =head2 marcfromkohafield $dbh = C4::Context->marcfromkohafield; diff --git a/Koha/Database.pm b/Koha/Database.pm new file mode 100644 index 0000000000..c10a61aa3b --- /dev/null +++ b/Koha/Database.pm @@ -0,0 +1,185 @@ +package Koha::Database; + +# Copyright 2013 Catalyst IT +# chrisc@catalyst.net.nz +# +# This file is part of Koha. +# +# Koha is free software; you can redistribute it and/or modify it under the +# terms of the GNU General Public License as published by the Free Software +# Foundation; either version 3 of the License, or (at your option) any later +# version. +# +# Koha is distributed in the hope that it will be useful, but WITHOUT ANY +# WARRANTY; without even the implied warranty of MERCHANTABILITY or FITNESS FOR +# A PARTICULAR PURPOSE. See the GNU General Public License for more details. +# +# You should have received a copy of the GNU General Public License along +# with Koha; if not, write to the Free Software Foundation, Inc., +# 51 Franklin Street, Fifth Floor, Boston, MA 02110-1301 USA. + +=head1 NAME + +Koha::Database + +=head1 SYNOPSIS + + use Koha::Database; + my $database = Koha::Database->new(); + my $schema = $database->schema(); + +=head1 FUNCTIONS + +=cut + +$ENV{'DBIC_DONT_VALIDATE_RELS'} = 1; # FIXME once the DBIx schema has its schema adjusted we should remove this + +use Modern::Perl; +use Carp; +use C4::Context; +use Koha::Schema; +use base qw(Class::Accessor); + +__PACKAGE__->mk_accessors(qw( )); + +# _new_schema +# Internal helper function (not a method!). This creates a new +# database connection from the data given in the current context, and +# returns it. +sub _new_schema { + my $db_driver; + my $context = C4::Context->new(); + if ( $context->config("db_scheme") ) { + $db_driver = $context->db_scheme2dbi( $context->config("db_scheme") ); + } + else { + $db_driver = "mysql"; + } + + my $db_name = $context->config("database"); + my $db_host = $context->config("hostname"); + my $db_port = $context->config("port") || ''; + my $db_user = $context->config("user"); + my $db_passwd = $context->config("pass"); + my $schema = Koha::Schema->connect( + "DBI:$db_driver:dbname=$db_name;host=$db_host;port=$db_port", + $db_user, $db_passwd ); + return $schema; +} + +=head2 schema + + $schema = $database->schema; + +Returns a database handle connected to the Koha database for the +current context. If no connection has yet been made, this method +creates one, and connects to the database. + +This database handle is cached for future use: if you call +C<$database-Eschema> twice, you will get the same handle both +times. If you need a second database handle, use C<&new_schema> and +possibly C<&set_schema>. + +=cut + +sub schema { + my $self = shift; + my $sth; + if ( defined( $self->{"schema"} ) && $self->{"schema"}->storage->connected() ) { + return $self->{"schema"}; + } + + # No database handle or it died . Create one. + $self->{"schema"} = &_new_schema(); + + return $self->{"schema"}; +} + +=head2 new_schema + + $schema = $database->new_schema; + +Creates a new connection to the Koha database for the current context, +and returns the database handle (a C object). + +The handle is not saved anywhere: this method is strictly a +convenience function; the point is that it knows which database to +connect to so that the caller doesn't have to know. + +=cut + +#' +sub new_schema { + my $self = shift; + + return &_new_schema(); +} + +=head2 set_schema + + $my_schema = $database->new_schema; + $database->set_schema($my_schema); + ... + $database->restore_schema; + +C<&set_schema> and C<&restore_schema> work in a manner analogous to +C<&set_context> and C<&restore_context>. + +C<&set_schema> saves the current database handle on a stack, then sets +the current database handle to C<$my_schema>. + +C<$my_schema> is assumed to be a good database handle. + +=cut + +sub set_schema { + my $self = shift; + my $new_schema = shift; + + # Save the current database handle on the handle stack. + # 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; +} + +=head2 restore_schema + + $database->restore_schema; + +Restores the database handle saved by an earlier call to +C<$database-Eset_schema>. + +=cut + +sub restore_schema { + my $self = shift; + + if ( $#{ $self->{"schema_stack"} } < 0 ) { + + # Stack underflow + die "SCHEMA stack underflow"; + } + + # Pop the old database handle and set it. + $self->{"schema"} = pop @{ $self->{"schema_stack"} }; + + # FIXME - If it is determined that restore_context should + # return something, then this function should, too. +} + +=head2 EXPORT + +None by default. + + +=head1 AUTHOR + +Chris Cormack, Echrisc@catalyst.net.nzE + +=cut + +1; + +__END__ diff --git a/t/db_dependent/Koha_Database.t b/t/db_dependent/Koha_Database.t new file mode 100644 index 0000000000..a03007858f --- /dev/null +++ b/t/db_dependent/Koha_Database.t @@ -0,0 +1,27 @@ +#!/usr/bin/perl +# + +use strict; +use warnings; + +use Test::More tests => 9; + +BEGIN { + use_ok('Koha::Database'); +} + +my $database; +ok( $database = Koha::Database->new(), 'Created Koha::Database Object' ); + +my $schema; +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' ); + +my $new_schema; +ok( $new_schema = $database->new_schema(), 'Try to get a new schema' ); +ok( $database->set_schema($new_schema), 'Switch to new schema' ); +ok( $database->restore_schema(), 'Switch back' ); + -- 2.39.5