Bug 10955 - Add ability to skip deletions in zebraqueue
[koha_fer] / C4 / Context.pm
index 35afb38..bf87efa 100644 (file)
@@ -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;
@@ -107,6 +105,7 @@ use C4::Debug;
 use POSIX ();
 use DateTime::TimeZone;
 use Module::Load::Conditional qw(can_load);
+use Carp;
 
 =head1 NAME
 
@@ -294,20 +293,20 @@ sub memcached {
     }
 }
 
-# db_scheme2dbi
-# Translates the full text name of a database into de appropiate dbi name
-# 
+=head2 db_schema2dbi
+
+    my $dbd_driver_name = C4::Context::db_schema2dbi($scheme);
+
+This routines translates a database type to part of the name
+of the appropriate DBD driver to use when establishing a new
+database connection.  It recognizes 'mysql' and 'Pg'; if any
+other scheme is supplied it defaults to 'mysql'.
+
+=cut
+
 sub db_scheme2dbi {
-    my $name = shift;
-    # for instance, we support only mysql, so don't care checking
-    return "mysql";
-    for ($name) {
-# FIXME - Should have other databases. 
-        if (/mysql/) { return("mysql"); }
-        if (/Postgres|Pg|PostgresSQL/) { return("Pg"); }
-        if (/oracle/) { return("Oracle"); }
-    }
-    return;         # Just in case
+    my $scheme = shift // '';
+    return $scheme eq 'Pg' ? $scheme : 'mysql';
 }
 
 sub import {
@@ -707,8 +706,6 @@ sub Zconn {
         $context->{"Zconn"}->{$server}->destroy() if defined($context->{"Zconn"}->{$server});
 
         $context->{"Zconn"}->{$server} = &_new_Zconn($server,$async,$auth,$piggyback,$syntax);
-        $context->{ Zconn }->{ $server }->option(
-            preferredRecordSyntax => C4::Context->preference("marcflavour") );
         return $context->{"Zconn"}->{$server};
     }
 }
@@ -732,14 +729,36 @@ sub _new_Zconn {
 
     my $tried=0; # first attempt
     my $Zconn; # connection object
-    $server = "biblioserver" unless $server;
-    $syntax = "usmarc" unless $syntax;
+    my $elementSetName;
+    my $index_mode;
+
+    $server //= "biblioserver";
+    $syntax //= "XML";
+
+    if ( $server eq 'biblioserver' ) {
+        $index_mode = $context->{'config'}->{'zebra_bib_index_mode'} // 'grs1';
+    } elsif ( $server eq 'authorityserver' ) {
+        $index_mode = $context->{'config'}->{'zebra_auth_index_mode'} // 'dom';
+    }
+
+    if ( $index_mode eq 'grs1' ) {
+
+        $elementSetName = 'F';
+        $syntax = ( $context->preference("marcflavour") eq 'UNIMARC' )
+                ? 'unimarc'
+                : 'usmarc';
+
+    } else {
+
+        $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);   
+    $auth = 1 if($user && $password);
     retry:
     eval {
         # set options
@@ -751,7 +770,7 @@ sub _new_Zconn {
         $o->option(cqlfile=> $context->{"server"}->{$server}->{"cql2rpn"});
         $o->option(cclfile=> $context->{"serverinfo"}->{$server}->{"ccl2rpn"});
         $o->option(preferredRecordSyntax => $syntax);
-        $o->option(elementSetName => "F"); # F for 'full' as opposed to B for 'brief'
+        $o->option(elementSetName => $elementSetName);
         $o->option(databaseName => ($servername?$servername:"biblios"));
 
         # create a new connection object
@@ -766,23 +785,7 @@ sub _new_Zconn {
         }
 
     };
-#     if ($@) {
-#         # Koha manages the Zebra server -- this doesn't work currently for me because of permissions issues
-#         # Also, I'm skeptical about whether it's the best approach
-#         warn "problem with Zebra";
-#         if ( C4::Context->preference("ManageZebra") ) {
-#             if ($@->code==10000 && $tried==0) { ##No connection try restarting Zebra
-#                 $tried=1;
-#                 warn "trying to restart Zebra";
-#                 my $res=system("zebrasrv -f $ENV{'KOHA_CONF'} >/koha/log/zebra-error.log");
-#                 goto "retry";
-#             } else {
-#                 warn "Error ", $@->code(), ": ", $@->message(), "\n";
-#                 $Zconn="error";
-#                 return $Zconn;
-#             }
-#         }
-#     }
+
     return $Zconn;
 }
 
@@ -795,12 +798,7 @@ sub _new_dbh
 
     ## $context
     ## correct name for db_schme        
-    my $db_driver;
-    if ($context->config("db_scheme")){
-        $db_driver=db_scheme2dbi($context->config("db_scheme"));
-    }else{
-        $db_driver="mysql";
-    }
+    my $db_driver = db_scheme2dbi($context->config("db_scheme"));
 
     my $db_name   = $context->config("database");
     my $db_host   = $context->config("hostname");
@@ -995,130 +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
-C<C4::Context-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>.
-
-=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<DBI::db> 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
-C<C4::Context-E<gt>set_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;
@@ -1360,6 +1234,25 @@ sub tz {
 }
 
 
+=head2 IsSuperLibrarian
+
+    C4::Context->IsSuperlibrarian();
+
+=cut
+
+sub IsSuperLibrarian {
+    my $userenv = C4::Context->userenv;
+
+    unless ( $userenv and exists $userenv->{flags} ) {
+        # If we reach this without a user environment,
+        # assume that we're running from a command-line script,
+        # and act as a superlibrarian.
+        carp("C4::Context->userenv not defined!");
+        return 1;
+    }
+
+    return ($userenv->{flags}//0) % 2;
+}
 
 1;
 __END__