Bug 12478: working on authority results

[koha-ffzg.git] / Koha / Database.pm

diff --git a/Koha/Database.pm b/Koha/Database.pm
index 12758bf..ff289c2 100644 (file)
--- a/Koha/Database.pm
+++ b/Koha/Database.pm
@@ -35,27 +35,70 @@ Koha::Database
 use Modern::Perl;
 use Carp;
 use C4::Context;
-use Koha::Schema;
 use base qw(Class::Accessor);
 
+use vars qw($database);
+
 __PACKAGE__->mk_accessors(qw( ));
 
+our $schema; # the schema is a singleton
+
 # _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 {
+
+    require Koha::Schema;
+
     my $context = C4::Context->new();
-    my $db_driver = C4::Context::db_scheme2dbi($context->config("db_scheme"));
+
+    my $db_driver = $context->{db_driver};
 
     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 );
+
+    my ( %encoding_attr, $encoding_query, $tz_query );
+    my $tz = $ENV{TZ};
+    if ( $db_driver eq 'mysql' ) {
+        %encoding_attr = ( mysql_enable_utf8 => 1 );
+        $encoding_query = "set NAMES 'utf8'";
+        $tz_query = qq(SET time_zone = "$tz") if $tz;
+    }
+    elsif ( $db_driver eq 'Pg' ) {
+        $encoding_query = "set client_encoding = 'UTF8';";
+        $tz_query = qq(SET TIME ZONE = "$tz") if $tz;
+    }
+    my $schema = Koha::Schema->connect(
+        {
+            dsn => "dbi:$db_driver:database=$db_name;host=$db_host;port=$db_port",
+            user => $db_user,
+            password => $db_passwd,
+            %encoding_attr,
+            RaiseError => $ENV{DEBUG} ? 1 : 0,
+            PrintError => 1,
+            unsafe => 1,
+            quote_names => 1,
+            on_connect_do => [
+                $encoding_query || (),
+                $tz_query || (),
+            ]
+        }
+    );
+
+    my $dbh = $schema->storage->dbh;
+    eval {
+        $dbh->{RaiseError} = 1;
+        $dbh->do(q|
+            SELECT * FROM systempreferences WHERE 1 = 0 |
+        );
+        $dbh->{RaiseError} = $ENV{DEBUG} ? 1 : 0;
+    };
+    $dbh->{RaiseError} = 0 if $@;
+
     return $schema;
 }
 
@@ -69,22 +112,20 @@ creates one, and connects to the database.
 
 This database handle is cached for future use: if you call
 C<$database-E<gt>schema> 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>.
+times. If you need a second database handle, use C<&new_schema>.
 
 =cut
 
 sub schema {
     my $self = shift;
-    my $sth;
-    if ( defined( $self->{"schema"} ) && $self->{"schema"}->storage->connected() ) {
-        return $self->{"schema"};
-    }
+    my $params = shift;
 
-    # No database handle or it died . Create one.
-    $self->{"schema"} = &_new_schema();
+    unless ( $params->{new} ) {
+        return $database->{schema} if defined $database->{schema};
+    }
 
-    return $self->{"schema"};
+    $database->{schema} = &_new_schema();
+    return $database->{schema};
 }
 
 =head2 new_schema
@@ -132,8 +173,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
@@ -148,14 +189,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.