Bug 9811: Remove useless orderby management

[koha_fer] / C4 / Context.pm

diff --git a/C4/Context.pm b/C4/Context.pm
index bf87efa..9a7b75d 100644 (file)
--- a/C4/Context.pm
+++ b/C4/Context.pm
@@ -293,7 +293,7 @@ sub memcached {
     }
 }
 
-=head2 db_schema2dbi
+=head2 db_scheme2dbi
 
     my $dbd_driver_name = C4::Context::db_schema2dbi($scheme);
 
@@ -401,6 +401,7 @@ sub new {
     $self->{tz} = undef; # local timezone object
 
     bless $self, $class;
+    $self->{db_driver} = db_scheme2dbi($self->config('db_scheme'));  # cache database driver
     return $self;
 }
 
@@ -687,14 +688,13 @@ C<$auth> whether this connection has rw access (1) or just r access (0 or NULL)
 =cut
 
 sub Zconn {
-    my $self=shift;
-    my $server=shift;
-    my $async=shift;
-    my $auth=shift;
-    my $piggyback=shift;
-    my $syntax=shift;
-    if ( defined($context->{"Zconn"}->{$server}) && (0 == $context->{"Zconn"}->{$server}->errcode()) ) {
-        return $context->{"Zconn"}->{$server};
+    my ($self, $server, $async, $auth, $piggyback, $syntax) = @_;
+    #TODO: We actually just ignore the auth and syntax parameter
+    #It also looks like we are not passing auth, piggyback, syntax anywhere
+
+    my $cache_key = join ('::', (map { $_ // '' } ($server, $async, $auth, $piggyback, $syntax)));
+    if ( defined($context->{"Zconn"}->{$cache_key}) && (0 == $context->{"Zconn"}->{$cache_key}->errcode()) ) {
+        return $context->{"Zconn"}->{$cache_key};
     # No connection object or it died. Create one.
     }else {
         # release resources if we're closing a connection and making a new one
@@ -703,10 +703,10 @@ sub Zconn {
         # and make a new one, particularly for a batch job.  However, at
         # first glance it does not look like there's a way to easily check
         # the basic health of a ZOOM::Connection
-        $context->{"Zconn"}->{$server}->destroy() if defined($context->{"Zconn"}->{$server});
+        $context->{"Zconn"}->{$cache_key}->destroy() if defined($context->{"Zconn"}->{$cache_key});
 
-        $context->{"Zconn"}->{$server} = &_new_Zconn($server,$async,$auth,$piggyback,$syntax);
-        return $context->{"Zconn"}->{$server};
+        $context->{"Zconn"}->{$cache_key} = &_new_Zconn( $server, $async, $piggyback );
+        return $context->{"Zconn"}->{$cache_key};
     }
 }
 
@@ -725,15 +725,15 @@ C<$auth> whether this connection has rw access (1) or just r access (0 or NULL)
 =cut
 
 sub _new_Zconn {
-    my ($server,$async,$auth,$piggyback,$syntax) = @_;
+    my ( $server, $async, $piggyback ) = @_;
 
     my $tried=0; # first attempt
     my $Zconn; # connection object
     my $elementSetName;
     my $index_mode;
+    my $syntax;
 
     $server //= "biblioserver";
-    $syntax //= "XML";
 
     if ( $server eq 'biblioserver' ) {
         $index_mode = $context->{'config'}->{'zebra_bib_index_mode'} // 'grs1';
@@ -742,36 +742,31 @@ sub _new_Zconn {
     }
 
     if ( $index_mode eq 'grs1' ) {
-
         $elementSetName = 'F';
         $syntax = ( $context->preference("marcflavour") eq 'UNIMARC' )
                 ? 'unimarc'
                 : 'usmarc';
 
-    } else {
-
+    } else { # $index_mode eq 'dom'
+        $syntax = 'xml';
         $elementSetName = 'marcxml';
-        $syntax = 'XML';
     }
 
     my $host = $context->{'listen'}->{$server}->{'content'};
-    my $servername = $context->{"config"}->{$server};
     my $user = $context->{"serverinfo"}->{$server}->{"user"};
     my $password = $context->{"serverinfo"}->{$server}->{"password"};
-    $auth = 1 if($user && $password);
-    retry:
     eval {
         # set options
         my $o = new ZOOM::Options();
-        $o->option(user=>$user) if $auth;
-        $o->option(password=>$password) if $auth;
+        $o->option(user => $user) if $user && $password;
+        $o->option(password => $password) if $user && $password;
         $o->option(async => 1) if $async;
         $o->option(count => $piggyback) if $piggyback;
         $o->option(cqlfile=> $context->{"server"}->{$server}->{"cql2rpn"});
         $o->option(cclfile=> $context->{"serverinfo"}->{$server}->{"ccl2rpn"});
         $o->option(preferredRecordSyntax => $syntax);
-        $o->option(elementSetName => $elementSetName);
-        $o->option(databaseName => ($servername?$servername:"biblios"));
+        $o->option(elementSetName => $elementSetName) if $elementSetName;
+        $o->option(databaseName => $context->{"config"}->{$server}||"biblios");
 
         # create a new connection object
         $Zconn= create ZOOM::Connection($o);
@@ -783,9 +778,7 @@ sub _new_Zconn {
         if ($Zconn->errcode() !=0) {
             warn "something wrong with the connection: ". $Zconn->errmsg();
         }
-
     };
-
     return $Zconn;
 }
 
@@ -797,8 +790,8 @@ sub _new_dbh
 {
 
     ## $context
-    ## correct name for db_schme        
-    my $db_driver = db_scheme2dbi($context->config("db_scheme"));
+    ## correct name for db_scheme
+    my $db_driver = $context->{db_driver};
 
     my $db_name   = $context->config("database");
     my $db_host   = $context->config("hostname");
@@ -823,6 +816,10 @@ sub _new_dbh
         $dbh->{RaiseError} = 0;
     }
 
+    if ( $db_driver eq 'mysql' ) {
+        $dbh->{mysql_auto_reconnect} = 1;
+    }
+
        my $tz = $ENV{TZ};
     if ( $db_driver eq 'mysql' ) { 
         # Koha 3.0 is utf-8, so force utf8 communication between mySQL and koha, whatever the mysql default config.
@@ -857,10 +854,15 @@ possibly C<&set_dbh>.
 sub dbh
 {
     my $self = shift;
+    my $params = shift;
     my $sth;
 
-    if (defined($context->{"dbh"}) && $context->{"dbh"}->ping()) {
-       return $context->{"dbh"};
+    unless ( $params->{new} ) {
+        if ( defined($context->{db_driver}) && $context->{db_driver} eq 'mysql' && $context->{"dbh"} ) {
+            return $context->{"dbh"};
+        } elsif ( defined($context->{"dbh"}) && $context->{"dbh"}->ping() ) {
+            return $context->{"dbh"};
+        }
     }
 
     # No database handle or it died . Create one.
@@ -1254,6 +1256,31 @@ sub IsSuperLibrarian {
     return ($userenv->{flags}//0) % 2;
 }
 
+=head2 interface
+
+Sets the current interface for later retrieval in any Perl module
+
+    C4::Context->interface('opac');
+    C4::Context->interface('intranet');
+    my $interface = C4::Context->interface;
+
+=cut
+
+sub interface {
+    my ($class, $interface) = @_;
+
+    if (defined $interface) {
+        $interface = lc $interface;
+        if ($interface eq 'opac' || $interface eq 'intranet') {
+            $context->{interface} = $interface;
+        } else {
+            warn "invalid interface : '$interface'";
+        }
+    }
+
+    return $context->{interface} // 'opac';
+}
+
 1;
 __END__