diff --git a/C4/Auth.pm b/C4/Auth.pm index 04584a9..9295b58 100644 --- a/C4/Auth.pm +++ b/C4/Auth.pm @@ -31,7 +31,6 @@ use C4::Templates; # to get the template use C4::Languages; use C4::Search::History; use Koha; -use Koha::Caches; use Koha::AuthUtils qw(get_script_name hash_password); use Koha::DateUtils qw(dt_from_string); use Koha::Library::Groups; @@ -1734,9 +1733,10 @@ sub _get_session_params { my $dbh = C4::Context->dbh; return { dsn => "driver:PostgreSQL;serializer:yaml;id:md5", dsn_args => { Handle => $dbh } }; } - elsif ( $storage_method eq 'memcached' && Koha::Caches->get_instance->memcached_cache ) { - my $memcached = Koha::Caches->get_instance()->memcached_cache; - return { dsn => "driver:memcached;serializer:yaml;id:md5", dsn_args => { Memcached => $memcached } }; + elsif ( $storage_method eq 'memcached' ) { + if ( my $memcached = C4::Context->cache->memcached_cache ) { + return { dsn => "driver:memcached;serializer:yaml;id:md5", dsn_args => { Memcached => $memcached } }; + } } else { # catch all defaults to tmp should work on all systems diff --git a/C4/Auth_with_ldap.pm b/C4/Auth_with_ldap.pm index bbb1094..bb21ad1 100644 --- a/C4/Auth_with_ldap.pm +++ b/C4/Auth_with_ldap.pm @@ -54,7 +54,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/Biblio.pm b/C4/Biblio.pm index eaff256..16a4b23 100644 --- a/C4/Biblio.pm +++ b/C4/Biblio.pm @@ -38,8 +38,8 @@ use C4::Charset; use C4::Linker; use C4::OAI::Sets; use C4::Debug; +use C4::Context; -use Koha::Caches; use Koha::Authority::Types; use Koha::Acquisition::Currencies; use Koha::Biblio::Metadata; @@ -899,7 +899,7 @@ sub GetMarcStructure { $forlibrarian = $forlibrarian ? 1 : 0; my $unsafe = ($params && $params->{unsafe})? 1: 0; - my $cache = Koha::Caches->get_instance(); + my $cache = C4::Context->cache; my $cache_key = "MarcStructure-$forlibrarian-$frameworkcode"; my $cached = $cache->get_from_cache($cache_key, { unsafe => $unsafe }); return $cached if $cached; @@ -1009,7 +1009,7 @@ sub GetMarcSubfieldStructure { $frameworkcode //= ''; - my $cache = Koha::Caches->get_instance(); + my $cache = C4::Context->cache; my $cache_key = "MarcSubfieldStructure-$frameworkcode"; my $cached = $cache->get_from_cache($cache_key); return $cached if $cached; diff --git a/C4/Calendar.pm b/C4/Calendar.pm index 321aad7..42fe20b 100644 --- a/C4/Calendar.pm +++ b/C4/Calendar.pm @@ -23,7 +23,6 @@ use Carp; use Date::Calc qw( Date_to_Days Today); use C4::Context; -use Koha::Caches; use constant ISO_DATE_FORMAT => "%04d-%02d-%02d"; @@ -276,7 +275,7 @@ sub insert_single_holiday { # changed the 'single_holidays' table, lets force/reset its cache - my $cache = Koha::Caches->get_instance(); + my $cache = C4::Context->cache; $cache->clear_from_cache( 'single_holidays') ; $cache->clear_from_cache( 'exception_holidays') ; @@ -321,7 +320,7 @@ sub insert_exception_holiday { $self->{'exception_holidays'}->{"$options{year}/$options{month}/$options{day}"}{description} = $options{description}; # changed the 'single_holidays' table, lets force/reset its cache - my $cache = Koha::Caches->get_instance(); + my $cache = C4::Context->cache; $cache->clear_from_cache( 'single_holidays') ; $cache->clear_from_cache( 'exception_holidays') ; @@ -422,7 +421,7 @@ UPDATE special_holidays SET title = ?, description = ? $self->{'single_holidays'}->{"$options{year}/$options{month}/$options{day}"}{description} = $options{description}; # changed the 'single_holidays' table, lets force/reset its cache - my $cache = Koha::Caches->get_instance(); + my $cache = C4::Context->cache; $cache->clear_from_cache( 'single_holidays') ; $cache->clear_from_cache( 'exception_holidays') ; @@ -465,7 +464,7 @@ UPDATE special_holidays SET title = ?, description = ? $self->{'exception_holidays'}->{"$options{year}/$options{month}/$options{day}"}{description} = $options{description}; # changed the 'single_holidays' table, lets force/reset its cache - my $cache = Koha::Caches->get_instance(); + my $cache = C4::Context->cache; $cache->clear_from_cache( 'single_holidays') ; $cache->clear_from_cache( 'exception_holidays') ; @@ -546,7 +545,7 @@ sub delete_holiday { } # changed the 'single_holidays' table, lets force/reset its cache - my $cache = Koha::Caches->get_instance(); + my $cache = C4::Context->cache; $cache->clear_from_cache( 'single_holidays') ; $cache->clear_from_cache( 'exception_holidays') ; @@ -577,7 +576,7 @@ sub delete_holiday_range { $sth->execute($self->{branchcode}, $options{day}, $options{month}, $options{year}); # changed the 'single_holidays' table, lets force/reset its cache - my $cache = Koha::Caches->get_instance(); + my $cache = C4::Context->cache; $cache->clear_from_cache( 'single_holidays') ; $cache->clear_from_cache( 'exception_holidays') ; @@ -631,7 +630,7 @@ sub delete_exception_holiday_range { $sth->execute($self->{branchcode}, $options{day}, $options{month}, $options{year}); # changed the 'single_holidays' table, lets force/reset its cache - my $cache = Koha::Caches->get_instance(); + my $cache = C4::Context->cache; $cache->clear_from_cache( 'single_holidays') ; $cache->clear_from_cache( 'exception_holidays') ; } diff --git a/C4/Context.pm b/C4/Context.pm index 7ce91b6..2dba0ee 100644 --- a/C4/Context.pm +++ b/C4/Context.pm @@ -32,7 +32,7 @@ BEGIN { eval {C4::Context->dbh();}; if ($@){ $debug_level = 1; - } + } else { $debug_level = C4::Context->preference("DebugLevel"); } @@ -50,7 +50,7 @@ BEGIN { # a little example table with various version info"; print "

Koha error

-

The following fatal error has occurred:

+

The following fatal error has occurred:

$msg
@@ -64,11 +64,11 @@ BEGIN { } elsif ($debug_level eq "1"){ print "

Koha error

-

The following fatal error has occurred:

+

The following fatal error has occurred:

$msg
"; } else { print "

production mode - trapped fatal error

"; - } + } print ""; } #CGI::Carp::set_message(\&handle_errors); @@ -96,6 +96,7 @@ use Koha::Caches; use POSIX (); use DateTime::TimeZone; use Module::Load::Conditional qw(can_load); +use Data::Dumper; use Carp; use DateTime::TimeZone; @@ -165,14 +166,55 @@ 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 -$context = undef; # Initially, no context is set -@context_stack = (); # Initially, no saved contexts +@context_stack = (); # Initially, no saved contexts + +=head2 current + +Returns the current context + +=cut + +sub current { + return $context; +} + +=head2 cache + +Returns the cache object or undef + +=cut + +sub cache { + my $self = shift; + $self = $context unless ref ($self); + + return Koha::Caches->get_instance($self->{namespace}); +} + +=head2 memcached + +Returns the cache object if it is memcached or undef + +=cut + +sub memcached { + my $self = shift; + my $cache = $self->cache; + return $cache if $cache->memcached_cache; + + return; +} + +sub db_driver { + my $self = shift; + + $self = $context unless ref ($self); + return unless $self; + + return $self->{db_driver}; +} =head2 db_scheme2dbi @@ -194,32 +236,44 @@ 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 + # 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; - # no ? so load it! - my ($pkg,$config_file) = @_ ; - my $new_ctx = __PACKAGE__->new($config_file); - return unless $new_ctx; + # multihost, we don't want/have one default config + return if $config_file && $config_file eq ":no_config"; - # if successfully loaded, use it by default - $new_ctx->set_context; - 1; + my $conf_cache = Koha::Caches->get_instance('config'); + if ( $conf_cache->cache ) { + if ( $context = $conf_cache->get_from_cache('koha_conf') ) { + return; + } + } + + undef $config_file if $config_file && !-s $config_file; + $config_file ||= Koha::Config->guess_koha_conf(); + $context = __PACKAGE__->new($config_file); + return unless $context; + + if ( $conf_cache->memcached_cache ) { + # FIXME it may be better to use the memcached servers from the config file + # to cache it + $conf_cache->set_in_cache('koha_conf', $context) + } } =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. - -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. +file. C<&new> does not set this context as the new default context; for that, use C<&set_context>. @@ -231,38 +285,17 @@ 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. - unless ( defined $conf_fname ) { - $conf_fname = Koha::Config->guess_koha_conf; - unless ( $conf_fname ) { - warn "unable to locate Koha configuration file koha-conf.xml"; - return; - } - } + my $conf_fname = shift or croak "No conf"; + my $namespace = shift; - my $conf_cache = Koha::Caches->get_instance('config'); - my $config_from_cache; - if ( $conf_cache->cache ) { - $self = $conf_cache->get_from_cache('koha_conf'); - } - unless ( $self and %$self ) { - $self = Koha::Config->read_from_file($conf_fname); - if ( $conf_cache->memcached_cache ) { - # FIXME it may be better to use the memcached servers from the config file - # to cache it - $conf_cache->set_in_cache('koha_conf', $self) - } - } - unless ( exists $self->{config} or defined $self->{config} ) { - warn "The config file ($conf_fname) has not been parsed correctly"; - return; - } + my $self = Koha::Config->read_from_file($conf_fname); + 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::Caches->get_instance('syspref', $namespace); $self->{"Zconn"} = undef; # Zebra Connections $self->{"userenv"} = undef; # User env @@ -277,7 +310,6 @@ sub new { =head2 set_context - $context = new C4::Context; $context->set_context(); or set_context C4::Context $context; @@ -310,17 +342,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 @@ -336,19 +372,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"); @@ -365,26 +420,32 @@ Cnew> 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 @@ -403,29 +464,27 @@ with this method. =cut -my $syspref_cache = Koha::Caches->get_instance('syspref'); -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; + return $ENV{"OVERRIDE_SYSPREF_$var"} if defined $ENV{"OVERRIDE_SYSPREF_$var"}; - $var = lc $var; - - if ($use_syspref_cache) { - $syspref_cache = Koha::Caches->get_instance('syspref') unless $syspref_cache; - my $cached_var = $syspref_cache->get_from_cache("syspref_$var"); - return $cached_var if defined $cached_var; - } + my $cached_var = $self->{use_syspref_cache} + ? $self->{syspref_cache}->get_from_cache("syspref_$var") + : undef; + return $cached_var if defined $cached_var; my $syspref; 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; } @@ -448,7 +507,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(); } @@ -464,8 +524,9 @@ used with Plack and other persistent environments. sub disable_syspref_cache { my ($self) = @_; - $use_syspref_cache = 0; + $self = $context unless ref $self; $self->clear_syspref_cache(); + $self->{use_syspref_cache} = 0; } =head2 clear_syspref_cache @@ -479,8 +540,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 @@ -496,6 +559,7 @@ preference. sub set_preference { my ( $self, $variable, $value, $explanation, $type, $options ) = @_; + $self = $context unless ref $self; my $variable_case = $variable; $variable = lc $variable; @@ -532,8 +596,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; @@ -551,10 +615,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; @@ -568,7 +633,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 @@ -679,8 +744,7 @@ creates one, and connects to the database. This database handle is cached for future use: if you call Cdbh> 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 @@ -719,64 +783,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 -Cset_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/C4/External/OverDrive.pm b/C4/External/OverDrive.pm index 9044169..0e71707 100644 --- a/C4/External/OverDrive.pm +++ b/C4/External/OverDrive.pm @@ -22,7 +22,7 @@ use warnings; use Koha; use JSON; -use Koha::Caches; +use C4::Context; use HTTP::Request; use HTTP::Request::Common; use LWP::Authen::Basic; @@ -97,9 +97,7 @@ sub GetOverDriveToken { return unless ( $key && $secret ) ; - my $cache; - - eval { $cache = Koha::Caches->get_instance() }; + my $cache = C4::Context->cache; my $token; $cache and $token = $cache->get_from_cache( "overdrive_token" ) and return $token; diff --git a/C4/Installer/PerlDependencies.pm b/C4/Installer/PerlDependencies.pm index 130740c..357220e 100644 --- a/C4/Installer/PerlDependencies.pm +++ b/C4/Installer/PerlDependencies.pm @@ -362,6 +362,11 @@ our $PERL_DEPS = { 'required' => '1', 'min_ver' => '0.46' }, + 'Capture::Tiny' => { + 'usage' => 'Core', + 'required' => '1', + 'min_ver' => '0.08' + }, 'HTTP::Cookies' => { 'usage' => 'Core', 'required' => '1', diff --git a/C4/Items.pm b/C4/Items.pm index e7279ff..73a7ba4 100644 --- a/C4/Items.pm +++ b/C4/Items.pm @@ -444,7 +444,7 @@ sub _build_default_values_for_mod_marc { # Has no framework parameter anymore, since Default is authoritative # for Koha to MARC mappings. - my $cache = Koha::Caches->get_instance(); + my $cache = C4::Context->cache; my $cache_key = "default_value_for_mod_marc-"; my $cached = $cache->get_from_cache($cache_key); return $cached if $cached; diff --git a/C4/Koha.pm b/C4/Koha.pm index 42c8af1..00129e6 100644 --- a/C4/Koha.pm +++ b/C4/Koha.pm @@ -24,7 +24,6 @@ use strict; #use warnings; FIXME - Bug 2505 use C4::Context; -use Koha::Caches; use Koha::DateUtils qw(dt_from_string); use Koha::AuthorisedValues; use Koha::Libraries; @@ -533,7 +532,7 @@ sub GetAuthorisedValues { C4::Context->userenv ? C4::Context->userenv->{"branch"} : ""; my $cache_key = "AuthorisedValues-$category-$opac-$branch_limit"; - my $cache = Koha::Caches->get_instance(); + my $cache = C4::Context->cache; my $result = $cache->get_from_cache($cache_key); return $result if $result; diff --git a/C4/Utils/DataTables/ColumnsSettings.pm b/C4/Utils/DataTables/ColumnsSettings.pm index 8713489..31068b4 100644 --- a/C4/Utils/DataTables/ColumnsSettings.pm +++ b/C4/Utils/DataTables/ColumnsSettings.pm @@ -5,11 +5,10 @@ use List::Util qw( first ); use YAML; use C4::Context; use Koha::Database; -use Koha::Caches; sub get_yaml { my $yml_path = C4::Context->config('intranetdir') . '/admin/columns_settings.yml'; - my $cache = Koha::Caches->get_instance(); + my $cache = C4::Context->cache; my $yaml = $cache->get_from_cache('ColumnsSettingsYaml'); unless ($yaml) { diff --git a/Koha/Cache.pm b/Koha/Cache.pm index be478fa..8e90b26 100644 --- a/Koha/Cache.pm +++ b/Koha/Cache.pm @@ -64,34 +64,35 @@ Create a new Koha::Cache object. This is required for all cache-related function =cut sub new { - my ( $class, $self, $params ) = @_; + my ( $class, $self ) = @_; $self->{'default_type'} = $self->{cache_type} || $ENV{CACHING_SYSTEM} # DELME What about this? || 'memcached'; - my $subnamespace = $params->{subnamespace} // ''; + $self->{namespace} //= ''; $ENV{DEBUG} && carp "Default caching system: $self->{'default_type'}"; $self->{'timeout'} ||= 0; - # Should we continue to support MEMCACHED ENV vars? - $self->{'namespace'} ||= $ENV{MEMCACHED_NAMESPACE}; - my @servers = split /,/, $ENV{MEMCACHED_SERVERS} || ''; - unless ( $self->{namespace} and @servers ) { - my $koha_config = Koha::Config->read_from_file( Koha::Config->guess_koha_conf() ); - $self->{namespace} ||= $koha_config->{config}{memcached_namespace} || 'koha'; - @servers = split /,/, $koha_config->{config}{memcached_servers} // '' - unless @servers; - } - $self->{namespace} .= ":$subnamespace:"; if ( $self->{'default_type'} eq 'memcached' - && can_load( modules => { 'Cache::Memcached::Fast' => undef } ) - && _initialize_memcached($self, @servers) - && defined( $self->{'memcached_cache'} ) ) + && can_load( modules => { 'Cache::Memcached::Fast' => undef } ) ) { - $self->{'cache'} = $self->{'memcached_cache'}; + # Should we continue to support MEMCACHED ENV vars? + $self->{'namespace'} ||= $ENV{MEMCACHED_NAMESPACE}; + my @servers = split /,/, $ENV{MEMCACHED_SERVERS} || ''; + unless ( $self->{namespace} && @servers ) { + my $koha_config = Koha::Config->read_from_file( Koha::Config->guess_koha_conf() ); + $self->{namespace} ||= $koha_config->{config}{memcached_namespace} || 'koha'; + @servers = split /,/, $koha_config->{config}{memcached_servers} // '' + unless @servers; + } + if ( _initialize_memcached($self, @servers) + && defined( $self->{'memcached_cache'} ) ) + { + $self->{'cache'} = $self->{'memcached_cache'}; + } } if ( $self->{'default_type'} eq 'fastmmap' diff --git a/Koha/Caches.pm b/Koha/Caches.pm index 8940925..190e315 100644 --- a/Koha/Caches.pm +++ b/Koha/Caches.pm @@ -46,11 +46,11 @@ persistent across multiple instances. =cut sub get_instance { - my ($class, $subnamespace) = @_; + my ($class, $subnamespace, $namespace) = @_; $subnamespace //= ''; - $singleton_caches->{$subnamespace} = Koha::Cache->new({}, { subnamespace => $subnamespace } ) - unless $singleton_caches->{$subnamespace}; - return $singleton_caches->{$subnamespace}; + $namespace //= ''; + return $singleton_caches->{$namespace}{$subnamespace} + ||= Koha::Cache->new({ namespace => $namespace }, { subnamespace => $subnamespace }); } =head2 flush_L1_caches @@ -58,8 +58,11 @@ sub get_instance { =cut sub flush_L1_caches { + my ($class, $namespace) = @_; + $namespace //= ''; + return unless $singleton_caches; - for my $cache ( values %$singleton_caches ) { + for my $cache ( values %{$singleton_caches->{$namespace}} ) { $cache->flush_L1_cache; } } diff --git a/Koha/Calendar.pm b/Koha/Calendar.pm index fc63572..f439413 100644 --- a/Koha/Calendar.pm +++ b/Koha/Calendar.pm @@ -7,7 +7,6 @@ use DateTime; use DateTime::Set; use DateTime::Duration; use C4::Context; -use Koha::Caches; use Carp; sub new { @@ -55,7 +54,7 @@ sub _init { sub exception_holidays { my ( $self ) = @_; - my $cache = Koha::Caches->get_instance(); + my $cache = C4::Context->cache; my $cached = $cache->get_from_cache('exception_holidays'); return $cached if $cached; @@ -84,7 +83,7 @@ sub exception_holidays { sub single_holidays { my ( $self, $date ) = @_; my $branchcode = $self->{branchcode}; - my $cache = Koha::Caches->get_instance(); + my $cache = C4::Context->cache; my $single_holidays = $cache->get_from_cache('single_holidays'); # $single_holidays looks like: diff --git a/Koha/Database.pm b/Koha/Database.pm index c92056c..b9fc151 100644 --- a/Koha/Database.pm +++ b/Koha/Database.pm @@ -35,6 +35,7 @@ Koha::Database use Modern::Perl; use Carp; use C4::Context; +use Koha::Schema; use base qw(Class::Accessor); use vars qw($database); @@ -46,12 +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(); - require Koha::Schema; - - 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"); @@ -140,16 +138,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 object). +Creates a new connection to the Koha database for the context +(current is default), and returns the database handle (a C object). The handle is not saved anywhere: this method is strictly a convenience function; the point is that it knows which database to @@ -161,7 +159,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 @@ -235,6 +233,29 @@ sub flush_schema_cache { return 1; } +=head2 run_with_schema + + $database->run_with_schema( $schema, sub {...} ); + +Restores the database handle saved by an earlier call to +C<$database-Eset_schema> C<$database-Erestore_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..3760679 --- /dev/null +++ b/Koha/Handler/Plack.pm @@ -0,0 +1,200 @@ +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 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, + shared_context => 1 + }, + { + hostname => ['koha2.com', 'www.koha2.com'], + app => $app2, + context => $context2, + }, + ... + + C is mandatory. + If C is set to true, some Context properties will be preserved across + forked processes. Useful if both OPAC and Intranet apps are served here, so no restart + is needed when Context cached properties cnamge values. Needs memcached. + + koha.psgi: + + use Plack::Builder; + use Plack::App::CGIBin; + + use C4::Context ":no_config"; + + 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 + +# We cannot store whole Context object, may contain non-serializable things +my @CONTEXT_UNSAFE_PROPERTIES = qw(sysprefs); +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"; + my $shared_context = $site_params->{shared_context}; + my $cache = $context->memcached; + if ($shared_context) { + if ($cache) { + foreach (@CONTEXT_UNSAFE_PROPERTIES) { + # Clean slate + $cache->clear_from_cache($_); + } + } + else { + warn "shared_context works only with memcached"; + } + } + + foreach my $host (@$hosts) { + $map->map("http://$host/" => sub { + my $env = shift; + + # may have stopped meanwhile or whatever + my $cache = $context->memcached; + if ($shared_context && $cache) { + foreach (@CONTEXT_UNSAFE_PROPERTIES) { + if (my $shared = $cache->get($_)) { + $context->{$_} = $shared; + } + } + } + + my $ret = $context->run_within_context(sub { $app->($env) }); + + if ($shared_context && $cache) { + foreach (@CONTEXT_UNSAFE_PROPERTIES) { + $cache->set($_, $context->{$_}); + } + } + + $ret; + }); + } + } + 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..9892562 --- /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 below + +=head1 DESCRIPTION + + CGI script runner. + + One beautiful day wiwill move away from that and have proper App module + with router and handlers + + See C + +=cut + +use Modern::Perl; +use Carp; + +use Plack::Builder; +use Plack::App::CGIBin; + +use parent "Koha::Handler::Plack"; + +use C4::Context ":no_config"; + +=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 = "DUMMY"; +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/Koha/MetaSearcher.pm b/Koha/MetaSearcher.pm index 65f7239..73c78ae 100644 --- a/Koha/MetaSearcher.pm +++ b/Koha/MetaSearcher.pm @@ -25,7 +25,7 @@ use C4::Charset qw( MarcToUTF8Record ); use C4::Search qw(); # Purely for new_record_from_zebra use DBIx::Class::ResultClass::HashRefInflator; use IO::Select; -use Koha::Caches; +use C4::Context; use Koha::Database; use Koha::MetadataRecord; use MARC::File::XML; @@ -91,7 +91,7 @@ sub search { my $resultset_expiry = 300; - my $cache = Koha::Caches->get_instance(); + my $cache = C4::Context->cache; my $schema = Koha::Database->new->schema; my $stats = { num_fetched => { diff --git a/Koha/Template/Plugin/Cache.pm b/Koha/Template/Plugin/Cache.pm index 5e3f8f7..4c88b80 100644 --- a/Koha/Template/Plugin/Cache.pm +++ b/Koha/Template/Plugin/Cache.pm @@ -21,7 +21,6 @@ use strict; use warnings; use base qw( Template::Plugin ); use Template::Plugin; -use C4::Context; #------------------------------------------------------------------------ # new(\%options) @@ -34,8 +33,7 @@ sub new { $cache = delete $params->{cache}; } else { - require Koha::Cache; - $cache = Koha::Caches->get_instance(); + $cache = $context->cache; } my $self = bless { CACHE => $cache, diff --git a/about.pl b/about.pl index 70900dd..445cdd0 100755 --- a/about.pl +++ b/about.pl @@ -43,7 +43,6 @@ use Koha::DateUtils qw(dt_from_string output_pref); use Koha::Acquisition::Currencies; use Koha::Patron::Categories; use Koha::Patrons; -use Koha::Caches; use Koha::Config::SysPrefs; use Koha::Illrequest::Config; use Koha::SearchEngine::Elasticsearch; @@ -119,7 +118,7 @@ if ( any { /(^psgi\.|^plack\.)/i } keys %ENV ) { my $memcached_servers = $ENV{MEMCACHED_SERVERS} || C4::Context->config('memcached_servers'); my $memcached_namespace = $ENV{MEMCACHED_NAMESPACE} || C4::Context->config('memcached_namespace') // 'koha'; -my $cache = Koha::Caches->get_instance; +my $cache = C4::Context->cache; my $effective_caching_method = ref($cache->cache); # Memcached may have been running when plack has been initialized but could have been stopped since # FIXME What are the consequences of that?? @@ -175,7 +174,7 @@ 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/biblio_framework.pl b/admin/biblio_framework.pl index d99351b..3554486 100755 --- a/admin/biblio_framework.pl +++ b/admin/biblio_framework.pl @@ -26,12 +26,11 @@ use C4::Output; use Koha::Biblios; use Koha::BiblioFramework; use Koha::BiblioFrameworks; -use Koha::Caches; my $input = new CGI; my $frameworkcode = $input->param('frameworkcode') || q||; my $op = $input->param('op') || q|list|; -my $cache = Koha::Caches->get_instance(); +my $cache = C4::Context->cache; my @messages; my ( $template, $borrowernumber, $cookie ) = get_template_and_user( diff --git a/admin/koha2marclinks.pl b/admin/koha2marclinks.pl index b337a3c..ff97157 100755 --- a/admin/koha2marclinks.pl +++ b/admin/koha2marclinks.pl @@ -43,7 +43,7 @@ my ( $template, $borrowernumber, $cookie ) = get_template_and_user ( ); my $schema = Koha::Database->new->schema; -my $cache = Koha::Caches->get_instance(); +my $cache = C4::Context->cache; # Update data before showing the form my $no_upd; diff --git a/admin/marc_subfields_structure.pl b/admin/marc_subfields_structure.pl index eeef468..ba286d1 100755 --- a/admin/marc_subfields_structure.pl +++ b/admin/marc_subfields_structure.pl @@ -79,7 +79,7 @@ my ( $template, $borrowernumber, $cookie ) = get_template_and_user( debug => 1, } ); -my $cache = Koha::Caches->get_instance(); +my $cache = C4::Context->cache; my $op = $input->param('op') || ""; $tagfield =~ s/\,//g; diff --git a/admin/marctagstructure.pl b/admin/marctagstructure.pl index 43de4fb..1820ce2 100755 --- a/admin/marctagstructure.pl +++ b/admin/marctagstructure.pl @@ -24,11 +24,6 @@ use C4::Auth; use C4::Koha; use C4::Context; use C4::Output; -use C4::Context; - -use Koha::Caches; -use Koha::AuthorisedValues; -use Koha::BiblioFrameworks; # retrieve parameters my $input = new CGI; @@ -45,7 +40,7 @@ my $pagesize = 20; my $script_name = "/cgi-bin/koha/admin/marctagstructure.pl"; my $dbh = C4::Context->dbh; -my $cache = Koha::Caches->get_instance(); +my $cache = C4::Context->cache; # open template my ($template, $loggedinuser, $cookie) diff --git a/admin/systempreferences.pl b/admin/systempreferences.pl index b16143f..bc42d90 100755 --- a/admin/systempreferences.pl +++ b/admin/systempreferences.pl @@ -385,7 +385,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/installer/install.pl b/installer/install.pl index a7aaa28..d7ae181 100755 --- a/installer/install.pl +++ b/installer/install.pl @@ -24,6 +24,7 @@ use diagnostics; use C4::InstallAuth; use CGI qw ( -utf8 ); use POSIX qw(strftime); +use Capture::Tiny qw(capture); use C4::Context; use C4::Output; @@ -389,40 +390,40 @@ elsif ( $step && $step == 3 ) { chk_log( $logdir, "updatedatabase-error_$filename_suffix" ) ); - my $cmd = C4::Context->config("intranetdir") - . "/installer/data/$info{dbms}/updatedatabase.pl >> $logfilepath 2>> $logfilepath_errors"; + my $script = C4::Context->config("intranetdir") . "/installer/data/$info{dbms}/updatedatabase.pl"; + my ($stdout, $stderr, $exit) = capture { do( $script ) }; + warn "Cannot execute $script: ".($@ || $!) if $@ || $!; - system($cmd ); - - my $fh; - open( $fh, "<:encoding(utf-8)", $logfilepath ) - or die "Cannot open log file $logfilepath: $!"; - my @report = <$fh>; - close $fh; - if (@report) { - $template->param( update_report => - [ map { { line => $_ } } split( /\n/, join( '', @report ) ) ] - ); + if ($stdout) { + if ( open( my $fh, ">>", $logfilepath ) ) { + print $fh $stdout; + close $fh; + } + else { + warn "Cannot open log file $logfilepath: $!"; + } + $template->param( update_report => [ map { line => $_ }, split( /\n/, $stdout ) ] ); $template->param( has_update_succeeds => 1 ); } else { - eval { `rm $logfilepath` }; +# eval { `rm $logfilepath` }; } - open( $fh, "<:encoding(utf-8)", $logfilepath_errors ) - or die "Cannot open log file $logfilepath_errors: $!"; - @report = <$fh>; - close $fh; - if (@report) { - $template->param( update_errors => - [ map { { line => $_ } } split( /\n/, join( '', @report ) ) ] - ); + if ($stderr) { + if ( open( my $fh, ">>", $logfilepath_errors ) ) { + print $fh $stderr; + close $fh; + } + else { + warn "Cannot open log file $logfilepath_errors: $!"; + } + my @errors = split( /\n/, $stderr ); + $template->param( update_errors => [ map { line => $_ }, @errors ] ); $template->param( has_update_errors => 1 ); - warn -"The following errors were returned while attempting to run the updatedatabase.pl script:\n"; - foreach my $line (@report) { warn "$line\n"; } + warn "The following errors were returned while attempting to run the updatedatabase.pl script:\n"; + warn $_ foreach @errors; } else { - eval { `rm $logfilepath_errors` }; +# eval { `rm $logfilepath_errors` }; } $template->param( $op => 1 ); } diff --git a/misc/cronjobs/check-url.pl b/misc/cronjobs/check-url.pl index 5c0957b..5fd6cb2 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..dbf09e6 --- /dev/null +++ b/misc/plack/koha-multi.psgi @@ -0,0 +1,34 @@ +#!/usr/bin/perl + +use Koha::Handler::Plack::CGI; + +# If modules are not in a standard location +# use lib '/usr/share/koha/lib' or set PERL5LIB or plackup -I + +# This is a minimal example. You can include all frills from koha.psgi +# To try it: +# plackup --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 cd947fc..78c5821 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/opac/svc/report b/opac/svc/report index f83b12e..3d44027 100755 --- a/opac/svc/report +++ b/opac/svc/report @@ -23,12 +23,11 @@ use Modern::Perl; +use C4::Context; use C4::Reports::Guided; use JSON; use CGI qw ( -utf8 ); -use Koha::Caches; - my $query = CGI->new(); my $report_id = $query->param('id'); my $report_name = $query->param('name'); @@ -41,7 +40,7 @@ die "Sorry this report is not public\n" unless $report_rec->{public}; my @sql_params = $query->param('sql_params'); -my $cache = Koha::Caches->get_instance(); +my $cache = C4::Context->cache; my $cache_active = $cache->is_cache_active; my ($cache_key, $json_text); if ($cache_active) { diff --git a/reports/guided_reports.pl b/reports/guided_reports.pl index 2273f1c..1b3f612 100755 --- a/reports/guided_reports.pl +++ b/reports/guided_reports.pl @@ -29,7 +29,6 @@ use C4::Auth qw/:DEFAULT get_session/; use C4::Output; use C4::Debug; use C4::Context; -use Koha::Caches; use C4::Log; use Koha::DateUtils qw/dt_from_string output_pref/; use Koha::AuthorisedValue; @@ -49,7 +48,7 @@ Script to control the guided report creation =cut my $input = new CGI; -my $usecache = Koha::Caches->get_instance->memcached_cache; +my $usecache = C4::Context->cache->memcached_cache; my $phase = $input->param('phase') // ''; my $flagsrequired; diff --git a/svc/report b/svc/report index 0188eaa..4e872c3 100755 --- a/svc/report +++ b/svc/report @@ -25,7 +25,7 @@ use C4::Reports::Guided; use JSON; use CGI qw ( -utf8 ); -use Koha::Caches; +use C4::Context; my $query = CGI->new(); @@ -48,7 +48,7 @@ my ( $template, $loggedinuser, $cookie ) = get_template_and_user( } ); -my $cache = Koha::Caches->get_instance(); +my $cache = C4::Context->cache; my $cache_active = $cache->is_cache_active; my ($cache_key, $json_text); if ($cache_active) { diff --git a/t/Calendar.t b/t/Calendar.t index e390696..e3091bc 100755 --- a/t/Calendar.t +++ b/t/Calendar.t @@ -22,7 +22,7 @@ use Test::MockModule; use DateTime; use DateTime::Duration; -use Koha::Caches; +use C4::Context; use Koha::DateUtils; use t::lib::Mocks; @@ -76,7 +76,7 @@ fixtures_ok [ ], ], "add fixtures"; -my $cache = Koha::Caches->get_instance(); +my $cache = C4::Context->cache; $cache->clear_from_cache( 'single_holidays' ) ; $cache->clear_from_cache( 'exception_holidays' ) ; diff --git a/t/Context.t b/t/Context.t index e2c1825..d737509 100755 --- a/t/Context.t +++ b/t/Context.t @@ -2,7 +2,7 @@ use Modern::Perl; use DBI; -use Test::More tests => 26; +use Test::More tests => 29; use Test::MockModule; BEGIN { @@ -62,3 +62,29 @@ is(C4::Context->interface, 'opac', 'interface still opac'); #Bug 14751 is( C4::Context->interface( 'SiP' ), 'sip', 'interface SiP' ); is( C4::Context->interface( 'COMMANDLINE' ), 'commandline', 'interface commandline uc' ); + +my $DUMMY_KOHA_CONF = "TEST"; +my $ctx_a = C4::Context->new($DUMMY_KOHA_CONF, "a"); +my $ctx_b = C4::Context->new($DUMMY_KOHA_CONF, "b"); +my $cache_key = "test_C4::Context"; + +SKIP: { + skip "No cache", 3 unless $ctx_a->cache->is_cache_active && $ctx_b->cache->is_cache_active; + + # Light warm up + C4::Context->cache->set_in_cache($cache_key, 'c'); + $ctx_a->cache->set_in_cache($cache_key, 'a'); + $ctx_b->cache->set_in_cache($cache_key, 'b'); + is(C4::Context->cache->get_from_cache($cache_key), 'c', "Correct default cache value"); + is($ctx_a->cache->get_from_cache($cache_key), 'a', "Correct cache 'a' value"); + is($ctx_b->cache->get_from_cache($cache_key), 'b', "Correct cache 'b' value"); + + # A bit more extravagant + # Cannot run atm, fails due to no database in config +# $ctx_a->run_within_context( sub { +# $ctx_b->cache->set_in_cache($cache_key, 'bb'); +# C4::Context->cache->set_in_cache($cache_key, 'aa'); +# } ); +# is($ctx_a->cache->get_from_cache($cache_key), 'aa', "Correct cache 'a' value"); +# is($ctx_b->cache->get_from_cache($cache_key), 'bb', "Correct cache 'b' value"); +} 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 = < + + test + XML + . + + +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/Koha_Template_Plugin_Cache.t b/t/Koha_Template_Plugin_Cache.t index da20f61..15ee048 100644 --- a/t/Koha_Template_Plugin_Cache.t +++ b/t/Koha_Template_Plugin_Cache.t @@ -1,6 +1,8 @@ use Modern::Perl; use Test::More tests => 2; +use C4::Context; + use_ok('Koha::Template::Plugin::Cache'); -ok(my $cache = Koha::Template::Plugin::Cache->new()); +ok(my $cache = Koha::Template::Plugin::Cache->new(C4::Context->current)); 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 @@ + + + dummy + DUMMY + . + + 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 @@ + + + koha1 + KOHA1 + . + + 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 @@ + + + KOHA2 + + 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 cb7c94f..55e5334 100755 --- a/t/db_dependent/Context.t +++ b/t/db_dependent/Context.t @@ -11,14 +11,8 @@ use Koha::Database; BEGIN { $debug = $ENV{DEBUG} || 0; - - # Note: The overall number of tests may vary by configuration. - # First we need to check your environmental variables - for (qw(KOHA_CONF PERL5LIB)) { - ok( $ret = $ENV{$_}, "ENV{$_} = $ret" ); - } - use_ok('C4::Context'); } +use_ok('C4::Context'); ok($dbh = C4::Context->dbh(), 'Getting dbh from C4::Context'); @@ -50,7 +44,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/Filter_MARC_ViewPolicy.t b/t/db_dependent/Filter_MARC_ViewPolicy.t index 64759fa..bd1347b 100644 --- a/t/db_dependent/Filter_MARC_ViewPolicy.t +++ b/t/db_dependent/Filter_MARC_ViewPolicy.t @@ -30,7 +30,6 @@ use MARC::Record; use MARC::Field; use C4::Context; use C4::Biblio; -use Koha::Caches; use Koha::Database; BEGIN { @@ -66,7 +65,7 @@ sub run_hiding_tests { $sth->execute($hidden_value); - my $cache = Koha::Caches->get_instance(); + my $cache = C4::Context->cache; $cache->flush_all(); # easy way to ensure DB is queried again. my $processor = Koha::RecordProcessor->new( @@ -138,7 +137,7 @@ sub run_hiding_tests { $sth->execute(-1); # -1 is visible in opac and intranet. - my $cache = Koha::Caches->get_instance(); + my $cache = C4::Context->cache; $cache->flush_all(); # easy way to ensure DB is queried again. my $shouldhidemarc = Koha::Filter::MARC::ViewPolicy->should_hide_marc( diff --git a/t/db_dependent/Items.t b/t/db_dependent/Items.t index ef09873..d1728a0 100755 --- a/t/db_dependent/Items.t +++ b/t/db_dependent/Items.t @@ -20,6 +20,7 @@ use Modern::Perl; use Data::Dumper; use MARC::Record; +use C4::Context; use C4::Biblio; use Koha::Database; use Koha::DateUtils qw( dt_from_string ); @@ -451,7 +452,7 @@ subtest 'SearchItems test' => sub { $dbh->do('INSERT INTO marc_subfield_structure (tagfield, tagsubfield, frameworkcode) VALUES (?, "z", ?)', undef, $itemfield, $frameworkcode); # Clear cache - my $cache = Koha::Caches->get_instance(); + my $cache = C4::Context->cache; $cache->clear_from_cache("MarcStructure-0-$frameworkcode"); $cache->clear_from_cache("MarcStructure-1-$frameworkcode"); $cache->clear_from_cache("default_value_for_mod_marc-"); @@ -708,7 +709,7 @@ subtest 'C4::Items::_build_default_values_for_mod_marc' => sub { Koha::MarcSubfieldStructures->search({ frameworkcode => '', tagfield => '952', tagsubfield => 'p' })->delete; # And make sure the caches are cleared - my $cache = Koha::Caches->get_instance(); + my $cache = C4::Context->cache; $cache->clear_from_cache("default_value_for_mod_marc-"); $cache->clear_from_cache("MarcSubfieldStructure-"); 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 23fea72..97c4d12 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 $errors; -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 . 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 = "DUMMY"; +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; diff --git a/tools/newHolidays.pl b/tools/newHolidays.pl index a161eaf..68a56cd 100755 --- a/tools/newHolidays.pl +++ b/tools/newHolidays.pl @@ -24,7 +24,7 @@ use CGI qw ( -utf8 ); use C4::Auth; use C4::Output; -use Koha::Caches; +use C4::Context; use C4::Calendar; use DateTime; @@ -142,6 +142,6 @@ sub add_holiday { } } # we updated the single_holidays table, so wipe its cache - my $cache = Koha::Caches->get_instance(); + my $cache = C4::Context->cache; $cache->clear_from_cache( 'single_holidays') ; }
Apache $versions{apacheVersion}