Bug 20287: generate_userid now set the userid

[koha.git] / Koha / Database.pm

diff --git a/Koha/Database.pm b/Koha/Database.pm
index 92e83ec..c92056c 100644 (file)
--- a/Koha/Database.pm
+++ b/Koha/Database.pm
@@ -35,9 +35,10 @@ 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( ));
 
 # _new_schema
@@ -46,11 +47,73 @@ __PACKAGE__->mk_accessors(qw( ));
 # returns it.
 sub _new_schema {
 
+    require Koha::Schema;
+
     my $context = C4::Context->new();
 
-    # we are letting C4::Context->dbh not set the RaiseError handle attribute
-    # for now for compatbility purposes
-    my $schema = Koha::Schema->connect( sub { C4::Context->dbh }, { unsafe => 1 } );
+    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 $tls = $context->config("tls");
+    my $tls_options;
+    if( $tls && $tls eq 'yes' ) {
+        my $ca = $context->config('ca');
+        my $cert = $context->config('cert');
+        my $key = $context->config('key');
+        $tls_options = ";mysql_ssl=1;mysql_ssl_client_key=".$key.";mysql_ssl_client_cert=".$cert.";mysql_ssl_ca_file=".$ca;
+    }
+
+
+
+    my ( %encoding_attr, $encoding_query, $tz_query, $sql_mode_query );
+    my $tz = C4::Context->timezone;
+    $tz = q{} if ( $tz eq 'local' );
+    if ( $db_driver eq 'mysql' ) {
+        %encoding_attr = ( mysql_enable_utf8 => 1 );
+        $encoding_query = "set NAMES 'utf8mb4'";
+        $tz_query = qq(SET time_zone = "$tz") if $tz;
+        $sql_mode_query = q{SET sql_mode = 'IGNORE_SPACE,NO_ZERO_IN_DATE,NO_ZERO_DATE,ERROR_FOR_DIVISION_BY_ZERO,NO_AUTO_CREATE_USER,NO_ENGINE_SUBSTITUTION'};
+    }
+    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".($tls_options? $tls_options : ""),
+            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 || (),
+                $sql_mode_query || (),
+            ]
+        }
+    );
+
+    my $dbh = $schema->storage->dbh;
+    eval {
+        $dbh->{RaiseError} = 1;
+        if ( $ENV{KOHA_DB_DO_NOT_RAISE_OR_PRINT_ERROR} ) {
+            $dbh->{RaiseError} = 0;
+            $dbh->{PrintError} = 0;
+        }
+        $dbh->do(q|
+            SELECT * FROM systempreferences WHERE 1 = 0 |
+        );
+        $dbh->{RaiseError} = $ENV{DEBUG} ? 1 : 0;
+    };
+    $dbh->{RaiseError} = 0 if $@;
+
     return $schema;
 }
 
@@ -71,15 +134,14 @@ possibly C<&set_schema>.
 
 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
@@ -127,8 +189,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,19 +205,36 @@ 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.
 }
 
+=head2 get_schema_cached
+
+=cut
+
+sub get_schema_cached {
+    return $database->{schema};
+}
+
+=head2 flush_schema_cache
+
+=cut
+
+sub flush_schema_cache {
+    delete $database->{schema};
+    return 1;
+}
+
 =head2 EXPORT
 
 None by default.