use strict;
use warnings;
use vars qw($VERSION $AUTOLOAD $context @context_stack $servers $memcached $ismemcached);
-use Koha::Cache;
-use Carp;
-
BEGIN {
if ($ENV{'HTTP_USER_AGENT'}) {
require CGI::Carp;
use POSIX ();
use DateTime::TimeZone;
use Module::Load::Conditional qw(can_load);
+use Carp;
=head1 NAME
}
}
-# 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 {
# FIXME: running this under mod_perl will require a means of
# flushing the caching mechanism.
-my $sysprefs;
+my %sysprefs;
my $use_syspref_cache = 1;
-my $cache;
sub preference {
my $self = shift;
- my $var = lc(shift); # The system preference to return
+ my $var = shift; # The system preference to return
- unless (defined $sysprefs) {
- unless ($cache) {
- $cache = Koha::Cache->new();
- }
- $sysprefs = $cache->create_hash(
- {
- 'key' => 'syspref',
- 'allowupdate' => 1,
- 'cache_type' => $use_syspref_cache ? '' : 'null',
- 'preload' => sub {
- my $dbh = C4::Context->dbh or return {};
- my $vars = $dbh->selectall_arrayref("SELECT variable, value FROM systempreferences");
- my %sysprefs = ();
- foreach my $row (@$vars) {
- $sysprefs{$row->[0]} = $row->[1];
- }
- return \%sysprefs;
- },
- 'constructor' => sub {
-
- # Look up systempreferences.variable==$var
- my $var = pop;
- my $sysprefs = pop || {};
- my $dbh = C4::Context->dbh or return 0;
- my $sql =
-"SELECT value FROM systempreferences WHERE variable=? LIMIT 1";
- $ENV{DEBUG} && carp "Retrieving syspref $var from database";
- my $sth = $dbh->prepare_cached($sql);
- $sth->execute($var);
- my $res = $sth->fetchrow_hashref;
- if ($res && $res->{'value'}) {
- $sysprefs->{$var} = $res->{'value'};
- } else {
- $sysprefs->{$var} = '';
- }
- return $sysprefs;
- },
- }
- );
+ if ($use_syspref_cache && exists $sysprefs{lc $var}) {
+ return $sysprefs{lc $var};
+ }
+
+ my $dbh = C4::Context->dbh or return 0;
+
+ my $value;
+ if ( defined $ENV{"OVERRIDE_SYSPREF_$var"} ) {
+ $value = $ENV{"OVERRIDE_SYSPREF_$var"};
+ } else {
+ # Look up systempreferences.variable==$var
+ my $sql = q{
+ SELECT value
+ FROM systempreferences
+ WHERE variable = ?
+ LIMIT 1
+ };
+ $value = $dbh->selectrow_array( $sql, {}, lc $var );
}
- return $sysprefs->{$var};
+
+ $sysprefs{lc $var} = $value;
+ return $value;
}
sub boolean_preference {
sub disable_syspref_cache {
my ($self) = @_;
$use_syspref_cache = 0;
- $self->clear_syspref_cache() if defined($sysprefs);
+ $self->clear_syspref_cache();
}
=head2 clear_syspref_cache
=cut
sub clear_syspref_cache {
- %{$sysprefs} = ();
- return;
+ %sysprefs = ();
}
=head2 set_preference
" );
if($sth->execute( $var, $value )) {
- $sysprefs->{$var} = $value;
+ $sysprefs{$var} = $value;
}
$sth->finish;
}
$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};
}
}
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
$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
}
};
-# 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;
}
## $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");
}
+=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__
projects / koha-ffzg.git / blobdiff