[Koha-patches] [PATCH] bug_15562: Multi-host helper for plack installations
Srdjan
srdjan at catalyst.net.nz
Tue Apr 26 05:53:38 CEST 2016
Sort of an apocalypse
* C4::Context->new() must be called with at least config file param.
If you want current context, call C4::Context->current().
C4::Context->some_method() will still work as is.
* Koha::Database->new_schema() now takes optional context param.
* C4::Context->set_context() and restore_context() are synched with
database set_schema() and restore_schema().
Created run_within_context() that wraps set_context() and
restore_context() around code.
* Created Koha::Handler::Plack* to facilitate running same code within
different (database) contexts.
* This initial version does not run with memcached turned on. Next patch
will correct that.
https://bugs.koha-community.org/show_bug.cgi?id=15562
---
C4/Auth_with_cas.pm | 2 +-
C4/Auth_with_ldap.pm | 2 +-
C4/Context.pm | 352 ++++++++++++++---------------
Koha/Cache.pm | 14 +-
Koha/Database.pm | 38 +++-
Koha/Handler/Plack.pm | 163 +++++++++++++
Koha/Handler/Plack/CGI.pm | 228 +++++++++++++++++++
about.pl | 2 +-
admin/systempreferences.pl | 2 +-
misc/cronjobs/check-url.pl | 2 +-
misc/plack/koha-multi.psgi | 29 +++
misc/translator/LangInstaller.pm | 4 +-
t/Koha_Handler_Plack.t | 136 +++++++++++
t/conf/dummy/koha-conf.xml | 7 +
t/conf/koha1/koha-conf.xml | 7 +
t/conf/koha2/koha-conf.xml | 5 +
t/db_dependent/Amazon.t | 2 +-
t/db_dependent/Context.t | 2 +-
t/db_dependent/Template/Plugin/KohaDates.t | 2 +-
t/db_dependent/XISBN.t | 2 +-
t/db_dependent/sysprefs.t | 13 +-
21 files changed, 802 insertions(+), 212 deletions(-)
create mode 100644 Koha/Handler/Plack.pm
create mode 100644 Koha/Handler/Plack/CGI.pm
create mode 100644 misc/plack/koha-multi.psgi
create mode 100644 t/Koha_Handler_Plack.t
create mode 100644 t/conf/dummy/koha-conf.xml
create mode 100644 t/conf/koha1/koha-conf.xml
create mode 100644 t/conf/koha2/koha-conf.xml
diff --git a/C4/Auth_with_cas.pm b/C4/Auth_with_cas.pm
index c9174da..f78e3b5 100644
--- a/C4/Auth_with_cas.pm
+++ b/C4/Auth_with_cas.pm
@@ -36,7 +36,7 @@ BEGIN {
@ISA = qw(Exporter);
@EXPORT = qw(check_api_auth_cas checkpw_cas login_cas logout_cas login_cas_url);
}
-my $context = C4::Context->new() or die 'C4::Context->new failed';
+my $context = C4::Context->current() or die 'No current context';
my $defaultcasserver;
my $casservers;
my $yamlauthfile = C4::Context->config('intranetdir') . "/C4/Auth_cas_servers.yaml";
diff --git a/C4/Auth_with_ldap.pm b/C4/Auth_with_ldap.pm
index c50df76..0f7a174 100644
--- a/C4/Auth_with_ldap.pm
+++ b/C4/Auth_with_ldap.pm
@@ -53,7 +53,7 @@ sub ldapserver_error {
}
use vars qw($mapping @ldaphosts $base $ldapname $ldappassword);
-my $context = C4::Context->new() or die 'C4::Context->new failed';
+my $context = C4::Context->current() or die 'No current context';
my $ldap = C4::Context->config("ldapserver") or die 'No "ldapserver" in server hash from KOHA_CONF: ' . $ENV{KOHA_CONF};
my $prefhost = $ldap->{hostname} or die ldapserver_error('hostname');
my $base = $ldap->{base} or die ldapserver_error('base');
diff --git a/C4/Context.pm b/C4/Context.pm
index c80647a..63a71d6 100644
--- a/C4/Context.pm
+++ b/C4/Context.pm
@@ -31,7 +31,7 @@ BEGIN {
eval {C4::Context->dbh();};
if ($@){
$debug_level = 1;
- }
+ }
else {
$debug_level = C4::Context->preference("DebugLevel");
}
@@ -49,7 +49,7 @@ BEGIN {
# a little example table with various version info";
print "
<h1>Koha error</h1>
- <p>The following fatal error has occurred:</p>
+ <p>The following fatal error has occurred:</p>
<pre><code>$msg</code></pre>
<table>
<tr><th>Apache</th><td> $versions{apacheVersion}</td></tr>
@@ -63,11 +63,11 @@ BEGIN {
} elsif ($debug_level eq "1"){
print "
<h1>Koha error</h1>
- <p>The following fatal error has occurred:</p>
+ <p>The following fatal error has occurred:</p>
<pre><code>$msg</code></pre>";
} else {
print "<p>production mode - trapped fatal error</p>";
- }
+ }
print "</body></html>";
}
#CGI::Carp::set_message(\&handle_errors);
@@ -112,6 +112,7 @@ use Koha::Cache;
use POSIX ();
use DateTime::TimeZone;
use Module::Load::Conditional qw(can_load);
+use Data::Dumper;
use Carp;
use C4::Boolean;
@@ -179,10 +180,6 @@ environment variable to the pathname of a configuration file to use.
# file (/etc/koha/koha-conf.xml).
# dbh
# A handle to the appropriate database for this context.
-# dbh_stack
-# Used by &set_dbh and &restore_dbh to hold other database
-# handles for this context.
-# Zconn
# A connection object for the Zebra server
# Koha's main configuration file koha-conf.xml
@@ -191,7 +188,7 @@ environment variable to the pathname of a configuration file to use.
# 1. Path supplied via use C4::Context '/path/to/koha-conf.xml'
# 2. Path supplied in KOHA_CONF environment variable.
# 3. Path supplied in INSTALLED_CONFIG_FNAME, as long
-# as value has changed from its default of
+# as value has changed from its default of
# '__KOHA_CONF_DIR__/koha-conf.xml', as happens
# when Koha is installed in 'standard' or 'single'
# mode.
@@ -201,52 +198,25 @@ environment variable to the pathname of a configuration file to use.
use constant CONFIG_FNAME => "/etc/koha/koha-conf.xml";
# Default config file, if none is specified
-
+
my $INSTALLED_CONFIG_FNAME = '__KOHA_CONF_DIR__/koha-conf.xml';
# path to config file set by installer
# __KOHA_CONF_DIR__ is set by rewrite-confg.PL
# when Koha is installed in 'standard' or 'single'
- # mode. If Koha was installed in 'dev' mode,
+ # mode. If Koha was installed in 'dev' mode,
# __KOHA_CONF_DIR__ is *not* rewritten; instead
- # developers should set the KOHA_CONF environment variable
-
-$context = undef; # Initially, no context is set
- at context_stack = (); # Initially, no saved contexts
-
-
-=head2 read_config_file
-
-Reads the specified Koha config file.
-
-Returns an object containing the configuration variables. The object's
-structure is a bit complex to the uninitiated ... take a look at the
-koha-conf.xml file as well as the XML::Simple documentation for details. Or,
-here are a few examples that may give you what you need:
+ # developers should set the KOHA_CONF environment variable
-The simple elements nested within the <config> element:
+ at context_stack = (); # Initially, no saved contexts
- my $pass = $koha->{'config'}->{'pass'};
+=head2 current
-The <listen> elements:
-
- my $listen = $koha->{'listen'}->{'biblioserver'}->{'content'};
-
-The elements nested within the <server> element:
-
- my $ccl2rpn = $koha->{'server'}->{'biblioserver'}->{'cql2rpn'};
-
-Returns undef in case of error.
+Returns the current context
=cut
-sub read_config_file { # Pass argument naming config file to read
- my $koha = XMLin(shift, keyattr => ['id'], forcearray => ['listen', 'server', 'serverinfo'], suppressempty => '');
-
- if ($ismemcached) {
- $memcached->set('kohaconf',$koha);
- }
-
- return $koha; # Return value: ref-to-hash holding the configuration
+sub current {
+ return $context;
}
=head2 ismemcached
@@ -274,6 +244,15 @@ sub memcached {
}
}
+sub db_driver {
+ my $self = shift;
+
+ $self = $context unless ref ($self);
+ return unless $self;
+
+ return $self->{db_driver};
+}
+
=head2 db_scheme2dbi
my $dbd_driver_name = C4::Context::db_schema2dbi($scheme);
@@ -294,32 +273,85 @@ sub import {
# Create the default context ($C4::Context::Context)
# the first time the module is called
# (a config file can be optionaly passed)
+ # If ":no_config" is passed, no config load will be attempted
+ # Config file defaults to either the file given by the $KOHA_CONF
+ # environment variable, or /etc/koha/koha-conf.xml.
+ # It saves the context values in the declared memcached server(s)
+ # if currently available and uses those values until them expire and
+ # re-reads them.
+
+ my ($pkg,$config_file) = @_ ;
# default context already exists?
return if $context;
+ if ($ismemcached) {
+ # retrieve from memcached
+ if (my $self = $memcached->get('kohaconf')) {
+ $context = $self;
+ return;
+ }
+ }
+
+ # check that the specified config file exists and is not empty
+ undef $config_file if defined $config_file &&
+ !( ref($config_file) || openhandle($config_file) || -s $config_file );
+ # Figure out a good config file to load if none was specified.
+ if (!defined($config_file))
+ {
+ # If the $KOHA_CONF environment variable is set, use
+ # that. Otherwise, use the built-in default.
+ if ($ENV{'KOHA_CONF'} and ref($ENV{'KOHA_CONF'}) || -s $ENV{"KOHA_CONF"}) {
+ $config_file = $ENV{"KOHA_CONF"};
+ } elsif ($INSTALLED_CONFIG_FNAME !~ /__KOHA_CONF_DIR/ and -s $INSTALLED_CONFIG_FNAME) {
+ # NOTE: be careful -- don't change __KOHA_CONF_DIR in the above
+ # regex to anything else -- don't want installer to rewrite it
+ $config_file = $INSTALLED_CONFIG_FNAME;
+ } elsif (-s CONFIG_FNAME) {
+ $config_file = CONFIG_FNAME;
+ } else {
+ die "unable to locate Koha configuration file koha-conf.xml";
+ }
+ }
+
# no ? so load it!
- my ($pkg,$config_file) = @_ ;
+ return if $config_file && $config_file eq ":no_config";
my $new_ctx = __PACKAGE__->new($config_file);
return unless $new_ctx;
# if successfully loaded, use it by default
- $new_ctx->set_context;
- 1;
+ $context = $new_ctx;
+
+ if ($ismemcached) {
+ $memcached->set('kohaconf',$new_ctx);
+ }
}
+use Scalar::Util qw(openhandle);
=head2 new
- $context = new C4::Context;
$context = new C4::Context("/path/to/koha-conf.xml");
Allocates a new context. Initializes the context from the specified
-file, which defaults to either the file given by the C<$KOHA_CONF>
-environment variable, or F</etc/koha/koha-conf.xml>.
+file.
-It saves the koha-conf.xml values in the declared memcached server(s)
-if currently available and uses those values until them expire and
-re-reads them.
+XML structure is a bit complex to the uninitiated ... take a look at the
+koha-conf.xml file as well as the XML::Simple documentation for details. Or,
+here are a few examples that may give you what you need:
+
+The simple elements nested within the <config> element:
+
+ my $pass = $koha->{'config'}->{'pass'};
+
+The <listen> elements:
+
+ my $listen = $koha->{'listen'}->{'biblioserver'}->{'content'};
+
+The elements nested within the <server> element:
+
+ my $ccl2rpn = $koha->{'server'}->{'biblioserver'}->{'cql2rpn'};
+
+Returns undef in case of error.
C<&new> does not set this context as the new default context; for
that, use C<&set_context>.
@@ -331,46 +363,22 @@ that, use C<&set_context>.
# 2004-08-10 A. Tarallo: Added check if the conf file is not empty
sub new {
my $class = shift;
- my $conf_fname = shift; # Config file to load
- my $self = {};
-
- # check that the specified config file exists and is not empty
- undef $conf_fname unless
- (defined $conf_fname && -s $conf_fname);
- # Figure out a good config file to load if none was specified.
- if (!defined($conf_fname))
- {
- # If the $KOHA_CONF environment variable is set, use
- # that. Otherwise, use the built-in default.
- if (exists $ENV{"KOHA_CONF"} and $ENV{'KOHA_CONF'} and -s $ENV{"KOHA_CONF"}) {
- $conf_fname = $ENV{"KOHA_CONF"};
- } elsif ($INSTALLED_CONFIG_FNAME !~ /__KOHA_CONF_DIR/ and -s $INSTALLED_CONFIG_FNAME) {
- # NOTE: be careful -- don't change __KOHA_CONF_DIR in the above
- # regex to anything else -- don't want installer to rewrite it
- $conf_fname = $INSTALLED_CONFIG_FNAME;
- } elsif (-s CONFIG_FNAME) {
- $conf_fname = CONFIG_FNAME;
- } else {
- warn "unable to locate Koha configuration file koha-conf.xml";
- return;
- }
- }
-
- if ($ismemcached) {
- # retrieve from memcached
- $self = $memcached->get('kohaconf');
- if (not defined $self) {
- # not in memcached yet
- $self = read_config_file($conf_fname);
- }
- } else {
- # non-memcached env, read from file
- $self = read_config_file($conf_fname);
- }
-
- $self->{"config_file"} = $conf_fname;
- warn "read_config_file($conf_fname) returned undef" if !defined($self->{"config"});
- return if !defined($self->{"config"});
+ my $conf_fname = shift or croak "No conf";
+ my $namespace = shift;
+
+ my $self = XMLin(
+ $conf_fname,
+ keyattr => ['id'],
+ forcearray => ['listen', 'server', 'serverinfo'],
+ suppressempty => '',
+ );
+ die "Invalid config ".(ref($conf_fname) ? $$conf_fname : $conf_fname).": ".Dumper($self)
+ unless ref($self) && $self->{"config"};
+
+ $self->{config_file} = $conf_fname;
+ $self->{namespace} = $namespace;
+ $self->{use_syspref_cache} = 1;
+ $self->{syspref_cache} = Koha::Cache->new({namespace => $namespace});
$self->{"Zconn"} = undef; # Zebra Connections
$self->{"marcfromkohafield"} = undef; # the hash with relations between koha table fields and MARC field/subfield
@@ -386,7 +394,6 @@ sub new {
=head2 set_context
- $context = new C4::Context;
$context->set_context();
or
set_context C4::Context $context;
@@ -419,17 +426,21 @@ sub set_context
if (ref($self) eq "")
{
# Class method. The new context is the next argument.
- $new_context = shift;
+ $new_context = shift or croak "No new context";
} else {
# Instance method. The new context is $self.
$new_context = $self;
}
- # Save the old context, if any, on the stack
- push @context_stack, $context if defined($context);
+ # undef $new_context->{schema} if $new_context->{schema} && !$new_context->{schema}->ping
+ my $schema = $new_context->{schema} ||= Koha::Database->new_schema($new_context);
+
+ # Save the old context on the stack
+ push @context_stack, $context;
# Set the new context
$context = $new_context;
+ Koha::Database->set_schema($schema);
}
=head2 restore_context
@@ -445,19 +456,38 @@ sub restore_context
{
my $self = shift;
- if ($#context_stack < 0)
- {
- # Stack underflow.
- die "Context stack underflow";
- }
-
# Pop the old context and set it.
$context = pop @context_stack;
+ Koha::Database->restore_schema();
# FIXME - Should this return something, like maybe the context
# that was current when this was called?
}
+=head2 run_within_context
+
+ $context->run_within_context(sub {...});
+
+Runs code within context
+
+=cut
+
+#'
+sub run_within_context
+{
+ my $self = shift;
+ my $code = shift or croak "No code";
+
+ $self->set_context;
+
+ local $@;
+ my $ret = eval { $code->(@_) };
+ my $died = $@;
+ $self->restore_context;
+ die $died if $died;
+ return $ret;
+}
+
=head2 config
$value = C4::Context->config("config_variable");
@@ -474,26 +504,32 @@ C<C4::Config-E<gt>new> will not return it.
=cut
sub _common_config {
- my $var = shift;
- my $term = shift;
- return if !defined($context->{$term});
+ my $self = shift;
+ my $var = shift;
+ my $term = shift;
+
+ $self = $context unless ref $self;
+ return if !defined($self->{$term});
# Presumably $self->{$term} might be
# undefined if the config file given to &new
# didn't exist, and the caller didn't bother
# to check the return value.
# Return the value of the requested config variable
- return $context->{$term}->{$var};
+ return $self->{$term}->{$var};
}
sub config {
- return _common_config($_[1],'config');
+ my $self = shift;
+ return $self->_common_config($_[0],'config');
}
sub zebraconfig {
- return _common_config($_[1],'server');
+ my $self = shift;
+ return $self->_common_config($_[0],'server');
}
sub ModZebrations {
- return _common_config($_[1],'serverinfo');
+ my $self = shift;
+ return $self->_common_config($_[0],'serverinfo');
}
=head2 preference
@@ -512,10 +548,9 @@ with this method.
=cut
-my $syspref_cache = Koha::Cache->get_instance();
-my $use_syspref_cache = 1;
sub preference {
my $self = shift;
+ $self = $context unless ref $self;
my $var = shift; # The system preference to return
$var = lc $var;
@@ -523,8 +558,8 @@ sub preference {
return $ENV{"OVERRIDE_SYSPREF_$var"}
if defined $ENV{"OVERRIDE_SYSPREF_$var"};
- my $cached_var = $use_syspref_cache
- ? $syspref_cache->get_from_cache("syspref_$var")
+ my $cached_var = $self->{use_syspref_cache}
+ ? $self->{syspref_cache}->get_from_cache("syspref_$var")
: undef;
return $cached_var if defined $cached_var;
@@ -532,8 +567,8 @@ sub preference {
eval { $syspref = Koha::Config::SysPrefs->find( lc $var ) };
my $value = $syspref ? $syspref->value() : undef;
- if ( $use_syspref_cache ) {
- $syspref_cache->set_in_cache("syspref_$var", $value);
+ if ( $self->{use_syspref_cache} ) {
+ $self->{syspref_cache}->set_in_cache("syspref_$var", $value);
}
return $value;
}
@@ -556,7 +591,8 @@ default behavior.
sub enable_syspref_cache {
my ($self) = @_;
- $use_syspref_cache = 1;
+ $self = $context unless ref $self;
+ $self->{use_syspref_cache} = 1;
# We need to clear the cache to have it up-to-date
$self->clear_syspref_cache();
}
@@ -572,7 +608,8 @@ used with Plack and other persistent environments.
sub disable_syspref_cache {
my ($self) = @_;
- $use_syspref_cache = 0;
+ $self = $context unless ref $self;
+ $self->{use_syspref_cache} = 0;
$self->clear_syspref_cache();
}
@@ -587,8 +624,10 @@ will not be seen by this process.
=cut
sub clear_syspref_cache {
- return unless $use_syspref_cache;
- $syspref_cache->flush_all;
+ my ($self) = @_;
+ $self = $context unless ref $self;
+ return unless $self->{use_syspref_cache};
+ $self->{syspref_cache}->flush_all;
}
=head2 set_preference
@@ -604,6 +643,7 @@ preference.
sub set_preference {
my ( $self, $variable, $value, $explanation, $type, $options ) = @_;
+ $self = $context unless ref $self;
$variable = lc $variable;
@@ -639,8 +679,8 @@ sub set_preference {
)->store();
}
- if ( $use_syspref_cache ) {
- $syspref_cache->set_in_cache( "syspref_$variable", $value );
+ if ( $self->{use_syspref_cache} ) {
+ $self->{syspref_cache}->set_in_cache( "syspref_$variable", $value );
}
return $syspref;
@@ -658,10 +698,11 @@ was no syspref of the name.
sub delete_preference {
my ( $self, $var ) = @_;
+ $self = $context unless ref $self;
if ( Koha::Config::SysPrefs->find( $var )->delete ) {
- if ( $use_syspref_cache ) {
- $syspref_cache->clear_from_cache("syspref_$var");
+ if ( $self->{use_syspref_cache} ) {
+ $self->{syspref_cache}->clear_from_cache("syspref_$var");
}
return 1;
@@ -675,7 +716,7 @@ sub delete_preference {
Returns a connection to the Zebra database
-C<$self>
+C<$self>
C<$server> one of the servers defined in the koha-conf.xml file
@@ -786,8 +827,7 @@ creates one, and connects to the database.
This database handle is cached for future use: if you call
C<C4::Context-E<gt>dbh> twice, you will get the same handle both
-times. If you need a second database handle, use C<&new_dbh> and
-possibly C<&set_dbh>.
+times. If you need a second database handle, use C<&new_dbh>.
=cut
@@ -826,64 +866,6 @@ sub new_dbh
return &dbh({ new => 1 });
}
-=head2 set_dbh
-
- $my_dbh = C4::Connect->new_dbh;
- C4::Connect->set_dbh($my_dbh);
- ...
- C4::Connect->restore_dbh;
-
-C<&set_dbh> and C<&restore_dbh> work in a manner analogous to
-C<&set_context> and C<&restore_context>.
-
-C<&set_dbh> saves the current database handle on a stack, then sets
-the current database handle to C<$my_dbh>.
-
-C<$my_dbh> is assumed to be a good database handle.
-
-=cut
-
-#'
-sub set_dbh
-{
- my $self = shift;
- my $new_dbh = shift;
-
- # Save the current database handle on the handle stack.
- # We assume that $new_dbh is all good: if the caller wants to
- # screw himself by passing an invalid handle, that's fine by
- # us.
- push @{$context->{"dbh_stack"}}, $context->{"dbh"};
- $context->{"dbh"} = $new_dbh;
-}
-
-=head2 restore_dbh
-
- C4::Context->restore_dbh;
-
-Restores the database handle saved by an earlier call to
-C<C4::Context-E<gt>set_dbh>.
-
-=cut
-
-#'
-sub restore_dbh
-{
- my $self = shift;
-
- if ($#{$context->{"dbh_stack"}} < 0)
- {
- # Stack underflow
- die "DBH stack underflow";
- }
-
- # Pop the old database handle and set it.
- $context->{"dbh"} = pop @{$context->{"dbh_stack"}};
-
- # FIXME - If it is determined that restore_context should
- # return something, then this function should, too.
-}
-
=head2 queryparser
$queryparser = C4::Context->queryparser
diff --git a/Koha/Cache.pm b/Koha/Cache.pm
index eeb2723..a403836 100644
--- a/Koha/Cache.pm
+++ b/Koha/Cache.pm
@@ -286,7 +286,7 @@ sub set_in_cache {
$value = clone( $value ) if ref($value) and not $unsafe;
# Set in L1 cache
- $L1_cache{ $key } = $value;
+ $L1_cache{ $self->{namespace} }{ $key } = $value;
# We consider an expiry of 0 to be inifinite
if ( $expiry ) {
@@ -337,12 +337,12 @@ sub get_from_cache {
return unless ( $self->{$cache} && ref( $self->{$cache} ) =~ m/^Cache::/ );
# Return L1 cache value if exists
- if ( exists $L1_cache{$key} ) {
+ if ( exists $L1_cache{ $self->{namespace} }{ $key } ) {
# No need to deep copy if it's a scalar
# Or if we do not need to deep copy
- return $L1_cache{$key}
- if not ref $L1_cache{$key} or $unsafe;
- return clone $L1_cache{$key};
+ return $L1_cache{ $self->{namespace} }{ $key }
+ if not ref $L1_cache{ $self->{namespace} }{ $key } or $unsafe;
+ return clone $L1_cache{ $self->{namespace} }{ $key };
}
my $get_sub = $self->{ref($self->{$cache}) . "_get"};
@@ -373,7 +373,7 @@ sub clear_from_cache {
return unless ( $self->{$cache} && ref( $self->{$cache} ) =~ m/^Cache::/ );
# Clear from L1 cache
- delete $L1_cache{$key};
+ delete $L1_cache{ $self->{namespace} }{ $key };
return $self->{$cache}->delete($key)
if ( ref( $self->{$cache} ) =~ m'^Cache::Memcached' );
@@ -402,7 +402,7 @@ sub flush_all {
sub flush_L1_cache {
my( $self ) = @_;
- %L1_cache = ();
+ delete $L1_cache{ $self->{namespace} };
}
=head1 TIED INTERFACE
diff --git a/Koha/Database.pm b/Koha/Database.pm
index d40eb52..959c00d 100644
--- a/Koha/Database.pm
+++ b/Koha/Database.pm
@@ -47,10 +47,9 @@ __PACKAGE__->mk_accessors(qw( ));
# database connection from the data given in the current context, and
# returns it.
sub _new_schema {
+ my $context = shift || C4::Context->current();
- my $context = C4::Context->new();
-
- my $db_driver = $context->{db_driver};
+ my $db_driver = $context->db_driver;
my $db_name = $context->config("database");
my $db_host = $context->config("hostname");
@@ -122,16 +121,16 @@ sub schema {
return $database->{schema} if defined $database->{schema};
}
- $database->{schema} = &_new_schema();
+ $database->{schema} = &_new_schema($params->{context});
return $database->{schema};
}
=head2 new_schema
- $schema = $database->new_schema;
+ $schema = $database->new_schema($context);
-Creates a new connection to the Koha database for the current context,
-and returns the database handle (a C<DBI::db> object).
+Creates a new connection to the Koha database for the context
+(current is default), 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
@@ -143,7 +142,7 @@ connect to so that the caller doesn't have to know.
sub new_schema {
my $self = shift;
- return &_new_schema();
+ return &_new_schema(@_);
}
=head2 set_schema
@@ -200,6 +199,29 @@ sub restore_schema {
# return something, then this function should, too.
}
+=head2 run_with_schema
+
+ $database->run_with_schema( $schema, sub {...} );
+
+Restores the database handle saved by an earlier call to
+C<$database-E<gt>set_schema> C<$database-E<gt>restore_schema> wrapper.
+
+=cut
+
+sub run_with_schema {
+ my $self = shift;
+ my $schema = shift or croak "No schema";
+ my $code = shift or croak "No sub";
+
+ $self->set_schema;
+ local $@;
+ my $ret = eval { $code->(@_) };
+ my $died = $@;
+ $self->restore_schema;
+ die $died if $died;
+ return $ret;
+}
+
=head2 EXPORT
None by default.
diff --git a/Koha/Handler/Plack.pm b/Koha/Handler/Plack.pm
new file mode 100644
index 0000000..af3f6cb
--- /dev/null
+++ b/Koha/Handler/Plack.pm
@@ -0,0 +1,163 @@
+package Koha::Handler::Plack;
+
+# Copyright (c) 2016 Catalyst IT
+#
+# This file is part of Koha.
+#
+# Koha is free software; you can redistribute it and/or modify it under the
+# terms of the GNU General Public License as published by the Free Software
+# Foundation; either version 2 of the License, or (at your option) any later
+# version.
+#
+# Koha is distributed in the hope that it will be useful, but WITHOUT ANY
+# WARRANTY; without even the implied warranty of MERCHANTABILITY or FITNESS FOR
+# A PARTICULAR PURPOSE. See the GNU General Public License for more details.
+#
+# You should have received a copy of the GNU General Public License along with
+# Koha; if not, write to the Free Software Foundation, Inc.,
+# 51 Franklin Street, Fifth Floor, Boston, MA 02110-1301 USA.
+
+=head1 NAME
+
+ Koha::Handler::Plack - Plack helper
+
+=head1 SYNOPSIS
+
+ koha.psgi:
+ use Koha::Handler::Plack;
+
+ my %HOST_CONF = (
+ 'koha1.com' => { ... },
+ 'koha2.com' => { ... },
+ ...
+ );
+ # last line
+ Koha::Handler::Plack->app_per_host(\%HOST_CONF);
+
+ See C<app_per_host()> below
+
+=head1 DESCRIPTION
+
+ Some handy function to help with Koha/Plack in a multi-host situation.
+
+ The problem:
+ Koha app relies on env vars. This should be changed, ie C4::Context should
+ be upgraded to Koha::App, but until then we need a gap filler. That's
+ because once up, there's no way to pass on new env to a psgi container.
+ In Apache, for instance, we can specify env vars per virtual host. Plack
+ has no such concept.
+
+ Solution:
+ We need to modify the environment in situ, per virtual host - app_per_host().
+ We specify env for each hostname, and apply.
+
+=cut
+
+use Modern::Perl;
+use Carp;
+
+use Plack::App::URLMap;
+
+=head1 CLASS METHODS
+
+=head2 app_per_host($host_apps)
+
+ App wrapper for per virtual host scenario.
+
+ C<$host_apps>:
+ {
+ hostname => 'koha1.com',
+ app => $app1,
+ context => $context1,
+ },
+ {
+ hostname => ['koha2.com', 'www.koha2.com'],
+ app => $app2,
+ context => $context2,
+ },
+ ...
+
+ C<hostname> is mandatory.
+
+ koha.psgi:
+
+ use Plack::Builder;
+ use Plack::App::CGIBin;
+
+ use C4::Context;
+
+ my $opac_app = builder {
+ enable "Plack::Middleware::Static",
+ path => qr{^/opac-tmpl/}, root => '/usr/share/koha/opac/htdocs/';
+
+ enable 'StackTrace';
+ mount "/cgi-bin/koha" => Plack::App::CGIBin->new(root => "/usr/share/koha/opac/cgi-bin/opac");
+ };
+ my $intranet_app = builder {
+ enable "Plack::Middleware::Static",
+ path => qr{^/intranet-tmpl/}, root => '/usr/share/koha/intranet/htdocs/';
+
+ enable 'StackTrace';
+ mount "/cgi-bin/koha" => Plack::App::CGIBin->new(root => "/usr/share/koha/cgi-bin");
+ };
+
+ my @host_def;
+
+ my $conf_file_1 = "/etc/koha/site-1/koha_conf.xml";
+ my $context_1 = C4::Context->new($conf_file_1);
+ push @host_def,
+ {
+ hostname => [ "public.host.for.site-1", "www.public.host.for.site-1" ],
+ app => $opac_app,
+ context => $context_1,
+ },
+ {
+ hostname => "intranet.host.for.site-1",
+ app => $intranet_app,
+ context => $context_1,
+ };
+
+ my $conf_file_2 = "/etc/koha/site-1/koha_conf.xml";
+ my $context_2 = C4::Context->new($conf_file_2);
+ push @host_def,
+ {
+ hostname => "public.host.for.site-2",
+ app => $opac_app,
+ context => $context_2,
+ },
+ {
+ hostname => "intranet.host.for.site-2",
+ app => $intranet_app,
+ context => $context_2,
+ };
+
+ ...
+
+ Koha::Handler::Plack->app_per_host( \@host_def );
+
+=cut
+
+sub app_per_host {
+ my $class = shift;
+ my $sites = shift or die "No sites spec";
+
+ my $map = Plack::App::URLMap->new;
+ foreach my $site_params ( @$sites ) {
+ my $hosts = $site_params->{hostname} or croak "No hostname";
+ $hosts = [$hosts] unless ref $hosts;
+
+ my $app = $site_params->{app} or croak "No app";
+ my $context = $site_params->{context} or croak "No Koha Context";
+
+ foreach my $host (@$hosts) {
+ $map->map("http://$host/" => sub {
+ my $env = shift;
+
+ return $context->run_within_context(sub { $app->($env) });
+ });
+ }
+ }
+ return $map->to_app;
+}
+
+1;
diff --git a/Koha/Handler/Plack/CGI.pm b/Koha/Handler/Plack/CGI.pm
new file mode 100644
index 0000000..36c6907
--- /dev/null
+++ b/Koha/Handler/Plack/CGI.pm
@@ -0,0 +1,228 @@
+package Koha::Handler::Plack::CGI;
+
+# Copyright (c) 2016 Catalyst IT
+#
+# This file is part of Koha.
+#
+# Koha is free software; you can redistribute it and/or modify it under the
+# terms of the GNU General Public License as published by the Free Software
+# Foundation; either version 2 of the License, or (at your option) any later
+# version.
+#
+# Koha is distributed in the hope that it will be useful, but WITHOUT ANY
+# WARRANTY; without even the implied warranty of MERCHANTABILITY or FITNESS FOR
+# A PARTICULAR PURPOSE. See the GNU General Public License for more details.
+#
+# You should have received a copy of the GNU General Public License along with
+# Koha; if not, write to the Free Software Foundation, Inc.,
+# 51 Franklin Street, Fifth Floor, Boston, MA 02110-1301 USA.
+
+=head1 NAME
+
+ Koha::Handler::Plack::CGI - Plack helper for CGI scripts
+
+=head1 SYNOPSIS
+
+ koha.psgi:
+ use Koha::Handler::Plack::CGI;
+
+ my %koha_env = (
+ opac => {
+ static_root => '/usr/share/koha/opac/htdocs',
+ script_root => '/usr/share/koha/opac',
+ },
+ intranet => {
+ static_root => '/usr/share/koha/intranet/htdocs',
+ script_root => '/usr/share/koha/intranet'
+ }
+ );
+ my @sites = (
+ {
+ opac_hostname => 'koha1-opac.com',
+ intranet_hostname => 'koha1-intranet.com',
+ config = '/etc/koha/koha1/koha-conf.xml'
+ },
+ {
+ opac_hostname => ['opac.koha2.com', 'www.opackoha2.com'],
+ intranet_hostname => ['intranet.koha2.com', 'www.intranetkoha2.com'],
+ config = '/etc/koha/koha2/koha-conf.xml'
+ },
+ );
+
+ # last line
+ Koha::Handler::Plack::CGI->app_per_host(\%HOST_CONF);
+
+ See C<app_per_host()> below
+
+=head1 DESCRIPTION
+
+ CGI script runner.
+
+ One beautiful day wiwill move away from that and have proper App module
+ with router and handlers</dream>
+
+ See C<Koha::Handler::Plack>
+
+=cut
+
+use Modern::Perl;
+use Carp;
+
+use Plack::Builder;
+use Plack::App::CGIBin;
+
+use parent "Koha::Handler::Plack";
+
+use C4::Context;
+
+=head1 CLASS METHODS
+
+=head2 app($context, $env)
+
+ Plack app builder fora CGI app
+
+ C<$context>: "opac" or "intranet"
+ C<$env>:
+ {
+ static_root => '...',
+ script_root => '...',
+ pugins => [
+ [ 'StackTrace' ],
+ ...
+ ],
+ }
+
+ koha.psgi:
+
+ Koha::Handler::Plack::CGI->app( "opac", \%opac_app_env );
+
+=cut
+
+sub app {
+ my $class = shift;
+ my $context = shift;
+ croak "Invalid app context '$context' - must be 'opac' or 'intranet'"
+ unless $context =~ m/^(opac|intranet)$/;
+ my $env = shift or croak "No $context env details";
+
+ my $static_root = $env->{static_root} or croak "No $context static_root";
+ $static_root = "$static_root/" unless $static_root =~ m!/$!;
+ my $script_root = $env->{script_root} or croak "No $context script_root";
+ $script_root =~ s!/$!!;
+ my $plugins = $env->{plugins} || [];
+ my $is_intranet = $context eq "intranet";
+
+ builder {
+ enable "Plack::Middleware::Static",
+ path => qr{^/$context-tmpl/}, root => $static_root;
+
+ map enable(@$_), @$plugins;
+
+ mount "/cgi-bin/koha" => Plack::App::CGIBin->new(root => $script_root)->to_app;
+ mount "/" => sub {
+ return [ 302, [ Location => '/cgi-bin/koha/' . ( $is_intranet ? 'mainpage.pl' : 'opac-main.pl' ) ], [] ];
+ };
+ };
+}
+
+=head2 multi_site($env, $sites)
+
+ App wrapper for per virtual host scenario.
+
+ C<$env>:
+ {
+ opac => {
+ static_root => '/usr/share/koha/opac/htdocs',
+ script_root => '/usr/share/koha/opac/cgi-bin/opac',
+ pugins => [
+ [ 'StackTrace' ],
+ ],
+ },
+ intranet => {
+ static_root => '/usr/share/koha/intranet/htdocs',
+ script_root => '/usr/share/koha/cgi-bin'
+ }
+ }
+ C<$sites>:
+ {
+ namespace => 'koha1',
+ opac_hostname => 'koha1-opac.com',
+ intranet_hostname => 'koha1-intranet.com',
+ config => '/etc/koha/sites/koha1/koha-conf.xml',
+ shared_config => 1
+ },
+ {
+ namespace => 'koha2',
+ opac_hostname => ['opac.koha2.com', 'www.opackoha2.com'],
+ intranet_hostname => ['intranet.koha2.com', 'www.intranetkoha2.com'],
+ config => '/etc/koha/sites/koha2/koha-conf.xml'
+ },
+ ...
+
+ koha.psgi:
+
+ Koha::Handler::Plack::CGI->multi_site( \%koha_app_env, \@sites );
+
+=cut
+
+my $DUMMY_KOHA_CONF = "<yazgfs><config>DUMMY</config></yazgfs>";
+sub multi_site {
+ my $class = shift;
+ my $env = shift or croak "No Koha env details";
+ my $sites = shift or croak "No sites spec";
+
+ my ($opac_app, $intranet_app);
+
+ if (my $opac = $env->{opac}) {
+ $opac_app = $class->app('opac', $opac);
+ }
+
+ if (my $intranet = $env->{intranet}) {
+ $intranet_app = $class->app('intranet', $intranet);
+ }
+
+ my @host_def = map {
+ my $namespace = $_->{namespace} or croak "No namespace";
+ my $config = $_->{config} or croak "Site without config";
+ my $shared_context = $_->{shared_context};
+
+ my $context = C4::Context->new($config, $namespace);
+
+ my @hd;
+ if (my $hostname = $_->{opac_hostname}) {
+ croak "You have OPAC hosts without OPAC env details" unless $opac_app;
+ push @hd, {
+ hostname => $hostname,
+ app => sub {
+ # XXX this may need some rethinking
+ local $ENV{KOHA_CONF} = \$DUMMY_KOHA_CONF;
+ local $ENV{MEMCACHED_NAMESPACE} = $namespace;
+
+ $opac_app->(@_);
+ },
+ context => $context,
+ shared_context => $shared_context,
+ };
+ }
+ if (my $hostname = $_->{intranet_hostname}) {
+ croak "You have Intranet hosts without Intranet env details" unless $intranet_app;
+ push @hd, {
+ hostname => $hostname,
+ app => sub {
+ # XXX this may need some rethinking
+ local $ENV{KOHA_CONF} = \$DUMMY_KOHA_CONF;
+ local $ENV{MEMCACHED_NAMESPACE} = $namespace;
+
+ $intranet_app->(@_);
+ },
+ context => $context,
+ shared_context => $shared_context,
+ };
+ }
+ @hd;
+ } @$sites;
+
+ return $class->app_per_host( \@host_def );
+}
+
+1;
diff --git a/about.pl b/about.pl
index 6b77677..a1469c1 100755
--- a/about.pl
+++ b/about.pl
@@ -92,7 +92,7 @@ my $warnIsRootUser = (! $loggedinuser);
my $warnNoActiveCurrency = (! defined Koha::Acquisition::Currencies->get_active);
my @xml_config_warnings;
-my $context = new C4::Context;
+my $context = C4::Context->current;
if ( ! defined C4::Context->config('zebra_bib_index_mode') ) {
push @xml_config_warnings, {
diff --git a/admin/systempreferences.pl b/admin/systempreferences.pl
index 67e0638..861508f 100755
--- a/admin/systempreferences.pl
+++ b/admin/systempreferences.pl
@@ -387,7 +387,7 @@ output_html_with_http_headers $input, $cookie, $template->output;
# .pref files.
sub get_prefs_from_files {
- my $context = C4::Context->new();
+ my $context = C4::Context->current();
my $path_pref_en = $context->config('intrahtdocs') .
'/prog/en/modules/admin/preferences';
# Get all .pref file names
diff --git a/misc/cronjobs/check-url.pl b/misc/cronjobs/check-url.pl
index 71885ab..2869446 100755
--- a/misc/cronjobs/check-url.pl
+++ b/misc/cronjobs/check-url.pl
@@ -190,7 +190,7 @@ sub check_all_url {
my $checker = C4::URL::Checker->new($timeout,$agent);
$checker->{ host_default } = $host;
- my $context = new C4::Context( );
+ my $context = C4::Context->current();
my $dbh = $context->dbh;
my $sth = $dbh->prepare(
"SELECT biblionumber FROM biblioitems WHERE url <> ''" );
diff --git a/misc/plack/koha-multi.psgi b/misc/plack/koha-multi.psgi
new file mode 100644
index 0000000..e897f02
--- /dev/null
+++ b/misc/plack/koha-multi.psgi
@@ -0,0 +1,29 @@
+#!/usr/bin/perl
+
+# This is a minimal example. You can include all frills from koha.psgi
+# To try it:
+# plackup -I /usr/share/koha/lib --port 5010 koha-multi.psgi
+
+my %KOHA_ENV = (
+ opac => {
+ static_root => '/usr/share/koha/opac/htdocs',
+ script_root => '/usr/share/koha/opac/cgi-bin/opac',
+ pugins => [
+ # don't enable this plugin in production, since stack traces reveal too much information
+ # about system to potential attackers!
+ [ 'StackTrace' ],
+ ],
+ },
+ intranet => {
+ static_root => '/usr/share/koha/intranet/htdocs',
+ script_root => '/usr/share/koha/intranet/cgi-bin',
+ }
+);
+my @SITES = map {
+ namespace => $_,
+ opac_hostname => "opac.$_.my-koha-multisite.net",
+ intranet_hostname => "intranet.$_.my-koha-multisite.net",
+ config => "/etc/koha/sites/$_/koha-conf.xml"
+}, qw(koha1 koha2 koha3);
+
+Koha::Handler::Plack::CGI->multi_site( \%KOHA_ENV, \@SITES );
diff --git a/misc/translator/LangInstaller.pm b/misc/translator/LangInstaller.pm
index 683897d..14a21c7 100644
--- a/misc/translator/LangInstaller.pm
+++ b/misc/translator/LangInstaller.pm
@@ -56,7 +56,7 @@ sub new {
my $self = { };
- my $context = C4::Context->new();
+ my $context = C4::Context->current();
$self->{context} = $context;
$self->{path_pref_en} = $context->config('intrahtdocs') .
'/prog/en/modules/admin/preferences';
@@ -140,7 +140,7 @@ sub new {
sub po_filename {
my $self = shift;
- my $context = C4::Context->new;
+ my $context = C4::Context->current();
my $trans_path = $Bin . '/po';
my $trans_file = "$trans_path/" . $self->{lang} . "-pref.po";
return $trans_file;
diff --git a/t/Koha_Handler_Plack.t b/t/Koha_Handler_Plack.t
new file mode 100644
index 0000000..8172940
--- /dev/null
+++ b/t/Koha_Handler_Plack.t
@@ -0,0 +1,136 @@
+#!/usr/bin/perl
+
+use Test::More tests => 15;
+use Plack::Test;
+use Plack::Test::MockHTTP;
+use Test::Mock::LWP::Dispatch;
+use Test::MockModule;
+use HTTP::Request::Common;
+use FindBin qw($Bin);
+use Data::Dumper;
+
+use_ok("Koha::Handler::Plack");
+use_ok("Koha::Handler::Plack::CGI");
+
+use C4::Context;
+
+my $db = Test::MockModule->new('Koha::Database');
+$db->mock(
+ _new_schema => sub {
+ return $_[0];
+ }
+);
+
+sub make_response {
+ return join ";", map defined($_) ? $_ : "", @_;
+}
+sub dummy_val {
+ return C4::Context->config("dummy");
+}
+sub check_context {
+ my $dummy_val = dummy_val();
+ is $dummy_val, undef, "context preserved"
+ or diag("dummy val: $dummy_val");
+}
+
+my $app = sub {
+ return [
+ 200,
+ [ 'Content-Type' => 'text/plain' ],
+ [ make_response(dummy_val()) ]
+ ];
+};
+my $generic_url = "http://dummyhost.com/";
+
+my $KOHA_CONF_XML = <<EOS;
+<yazgfs>
+ <config>
+ <kohasite>test</kohasite>
+ <dummy>XML</dummy>
+ <intrahtdocs>.</intrahtdocs>
+ </config>
+</yazgfs>
+EOS
+
+my @HOST_CONF = (
+ {
+ hostname => ['koha-file.com', 'www.koha-file.com'],
+ app => $app,
+ context => C4::Context->new("$Bin/conf/koha1/koha-conf.xml"),
+ _dummy => "KOHA1"
+ },
+ {
+ hostname => ['koha-xml.com', 'www.koha-xml.com'],
+ app => $app,
+ context => C4::Context->new(\$KOHA_CONF_XML),
+ _dummy => "XML"
+ },
+);
+test_psgi
+ app => Koha::Handler::Plack->app_per_host(\@HOST_CONF),
+ client => sub {
+ my $cb = shift;
+
+ foreach my $site_params ( @HOST_CONF ) {
+ my $valid_response = make_response(
+ $site_params->{_dummy}
+ );
+ foreach (@{$site_params->{hostname}}) {
+ my $res = $cb->(GET "http://$_/");
+ is $res->content, $valid_response, $_
+ or diag(Dumper($site_params, $_, $res->as_string));
+ check_context();
+ }
+ }
+
+ $res = $cb->(GET $generic_url);
+ is $res->code, 404, "app_per_host unknown host"
+ or diag($res->as_string);
+ };
+
+my %MULTI_HOST_ENV = (
+ opac => {
+ static_root => "$Bin/../koha-tmpl/opac-tmpl/bootstrap",
+ script_root => "$Bin/../opac",
+ },
+ intranet => {
+ static_root => "$Bin/../koha-tmpl/intranet-tmpl/bootstrap",
+ script_root => "$Bin/.."
+ }
+);
+my @MULTI_HOST_SITES = (
+ {
+ namespace => 'koha1',
+ opac_hostname => ['opac.koha1.com', 'www.opac.koha1.com'],
+ intranet_hostname => ['intranet.koha1.com', 'www.intranet.koha1.com'],
+ config => "$Bin/conf/koha1/koha-conf.xml",
+ },
+ {
+ namespace => 'koha2',
+ opac_hostname => ['opac.koha2.com', 'www.opac.koha2.com'],
+ intranet_hostname => ['intranet.koha2.com', 'www.intranet.koha2.com'],
+ config => "$Bin/conf/koha2/koha-conf.xml",
+ shared_context => 1,
+ },
+);
+test_psgi
+ app => Koha::Handler::Plack::CGI->multi_site(\%MULTI_HOST_ENV, \@MULTI_HOST_SITES),
+ client => sub {
+ my $cb = shift;
+
+ foreach my $site (@MULTI_HOST_SITES) {
+ my $opac = $site->{opac_hostname};
+ foreach my $host (@$opac) {
+# this is not really a test, but cannot do any better atm
+# TODO: a complex test involving two database connections
+ my $res = $cb->(GET "http://$host/");
+ # A future implementation may not redirect
+ if ($res->is_redirect) {
+ my $loc = $res->header("Location");
+ $res = $cb->(GET "http://$host$loc");
+ }
+ is $res->code, 500, "multi_site() $host"
+ or diag($res->as_string);
+ }
+ }
+ };
diff --git a/t/conf/dummy/koha-conf.xml b/t/conf/dummy/koha-conf.xml
new file mode 100644
index 0000000..d4c96b0
--- /dev/null
+++ b/t/conf/dummy/koha-conf.xml
@@ -0,0 +1,7 @@
+<yazgfs>
+ <config>
+ <kohasite>dummy</kohasite>
+ <dummy>DUMMY</dummy>
+ <intrahtdocs>.</intrahtdocs>
+ </config>
+</yazgfs>
diff --git a/t/conf/koha1/koha-conf.xml b/t/conf/koha1/koha-conf.xml
new file mode 100644
index 0000000..371d039
--- /dev/null
+++ b/t/conf/koha1/koha-conf.xml
@@ -0,0 +1,7 @@
+<yazgfs>
+ <config>
+ <kohasite>koha1</kohasite>
+ <dummy>KOHA1</dummy>
+ <intrahtdocs>.</intrahtdocs>
+ </config>
+</yazgfs>
diff --git a/t/conf/koha2/koha-conf.xml b/t/conf/koha2/koha-conf.xml
new file mode 100644
index 0000000..437e772
--- /dev/null
+++ b/t/conf/koha2/koha-conf.xml
@@ -0,0 +1,5 @@
+<yazgfs>
+ <config>
+ <dummy>KOHA2</dummy>
+ </config>
+</yazgfs>
diff --git a/t/db_dependent/Amazon.t b/t/db_dependent/Amazon.t
index 2304073..a5b316f 100755
--- a/t/db_dependent/Amazon.t
+++ b/t/db_dependent/Amazon.t
@@ -14,7 +14,7 @@ BEGIN {
use_ok('C4::External::Amazon');
}
-my $context = C4::Context->new();
+my $context = C4::Context->current();
my $locale = $context->preference('AmazonLocale');
diff --git a/t/db_dependent/Context.t b/t/db_dependent/Context.t
index b5a050f..c3f6066 100755
--- a/t/db_dependent/Context.t
+++ b/t/db_dependent/Context.t
@@ -47,7 +47,7 @@ C4::Context->clear_syspref_cache();
C4::Context->enable_syspref_cache();
$dbh->rollback;
-ok($koha = C4::Context->new, 'C4::Context->new');
+ok($koha = C4::Context->current, 'C4::Context->current');
my @keys = keys %$koha;
my $width = 0;
if (ok(@keys)) {
diff --git a/t/db_dependent/Template/Plugin/KohaDates.t b/t/db_dependent/Template/Plugin/KohaDates.t
index fe18836..2088347 100644
--- a/t/db_dependent/Template/Plugin/KohaDates.t
+++ b/t/db_dependent/Template/Plugin/KohaDates.t
@@ -14,7 +14,7 @@ BEGIN {
my $module_context = new Test::MockModule('C4::Context');
my $date = "1973-05-21";
-my $context = C4::Context->new();
+my $context = C4::Context->current();
my $filter = Koha::Template::Plugin::KohaDates->new();
ok ($filter, "new()");
diff --git a/t/db_dependent/XISBN.t b/t/db_dependent/XISBN.t
index 2f6d63b..45e01dd 100755
--- a/t/db_dependent/XISBN.t
+++ b/t/db_dependent/XISBN.t
@@ -26,7 +26,7 @@ my $search_module = new Test::MockModule('C4::Search');
$search_module->mock('SimpleSearch', \&Mock_SimpleSearch );
-my $context = C4::Context->new;
+my $context = C4::Context->current;
my ( $biblionumber_tag, $biblionumber_subfield ) =
GetMarcFromKohaField( 'biblio.biblionumber', '' );
diff --git a/t/db_dependent/sysprefs.t b/t/db_dependent/sysprefs.t
index 340e89a..07552f1 100755
--- a/t/db_dependent/sysprefs.t
+++ b/t/db_dependent/sysprefs.t
@@ -19,7 +19,7 @@
# along with Koha; if not, see <http://www.gnu.org/licenses>.
use Modern::Perl;
-use Test::More tests => 8;
+use Test::More tests => 11;
use C4::Context;
# Start transaction
@@ -60,4 +60,15 @@ is(C4::Context->preference('testpreference'), 'def', 'caching preferences');
C4::Context->clear_syspref_cache();
is(C4::Context->preference('testpreference'), undef, 'clearing preference cache');
+delete $ENV{OVERRIDE_SYSPREF_opacheader};
+
+my $DUMMY_KOHA_CONF = "<yazgfs><config><dummy>DUMMY</dummy></config></yazgfs>";
+my $context1 = C4::Context->new($DUMMY_KOHA_CONF, "context1");
+is( $context1->preference('opacheader'), $opacheader, 'context1 "opacheader"');
+
+my $context2 = C4::Context->new($DUMMY_KOHA_CONF, "context2");
+$context2->set_preference( 'opacheader', $newopacheader );
+is( $context1->preference('opacheader'), $opacheader, 'context1 "opacheader"');
+is( $context2->preference('opacheader'), $newopacheader, 'context2 "opacheader"');
+
$dbh->rollback;
--
2.5.0
More information about the Koha-patches
mailing list