@@ -, +, @@ If you want current context, call C4::Context->current(). C4::Context->some_method() will still work as is. database set_schema() and restore_schema(). Created run_within_context() that wraps set_context() and restore_context() around code. different (database) contexts. will correct that. --- C4/Auth_with_cas.pm | 2 +- C4/Auth_with_ldap.pm | 2 +- C4/Context.pm | 311 +++++++++++------------- Koha/Database.pm | 38 ++- Koha/Handler/Plack.pm | 163 +++++++++++++ Koha/Handler/Plack/CGI.pm | 228 +++++++++++++++++ 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/Koha_template_plugin_KohaDates.t | 2 +- t/db_dependent/XISBN.t | 2 +- t/db_dependent/sysprefs.t | 5 +- 19 files changed, 762 insertions(+), 187 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 --- a/C4/Auth_with_cas.pm +++ a/C4/Auth_with_cas.pm @@ -37,7 +37,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"; --- a/C4/Auth_with_ldap.pm +++ a/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'); --- a/C4/Context.pm +++ a/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 "

Koha error

-

The following fatal error has occurred:

+

The following fatal error has occurred:

$msg
@@ -63,11 +63,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); @@ -104,6 +104,7 @@ use Koha::Cache; use POSIX (); use DateTime::TimeZone; use Module::Load::Conditional qw(can_load); +use Data::Dumper; use Carp; use C4::Boolean; @@ -171,10 +172,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 @@ -183,7 +180,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. @@ -193,52 +190,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 -@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 element: +@context_stack = (); # Initially, no saved contexts - my $pass = $koha->{'config'}->{'pass'}; +=head2 current -The elements: - - my $listen = $koha->{'listen'}->{'biblioserver'}->{'content'}; - -The elements nested within the 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 @@ -266,6 +236,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); @@ -286,32 +265,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. +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 element: + + my $pass = $koha->{'config'}->{'pass'}; + +The elements: + + my $listen = $koha->{'listen'}->{'biblioserver'}->{'content'}; + +The elements nested within the 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>. @@ -323,46 +355,20 @@ 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); - } + 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; - warn "read_config_file($conf_fname) returned undef" if !defined($self->{"config"}); - return if !defined($self->{"config"}); + $self->{"namespace"} = $namespace; $self->{"Zconn"} = undef; # Zebra Connections $self->{"marcfromkohafield"} = undef; # the hash with relations between koha table fields and MARC field/subfield @@ -379,7 +385,6 @@ sub new { =head2 set_context - $context = new C4::Context; $context->set_context(); or set_context C4::Context $context; @@ -409,13 +414,18 @@ sub set_context # break this assumption by playing silly buggers, but that's # harder to do than doing it properly, and harder to check # for. + my $schema; if (ref($self) eq "") { # Class method. The new context is the next argument. - $new_context = shift; + $new_context = shift or croak "No new context"; + $schema = Koha::Database->new_schema($new_context); } else { # Instance method. The new context is $self. $new_context = $self; + + # undef $self->{schema} if $self->{schema} && !$self->{schema}->ping + $schema = $self->{schema} ||= Koha::Database->new_schema($self); } # Save the old context, if any, on the stack @@ -423,6 +433,7 @@ sub set_context # Set the new context $context = $new_context; + Koha::Database->set_schema($schema); } =head2 restore_context @@ -438,19 +449,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"); @@ -467,26 +497,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 @@ -685,7 +721,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 @@ -796,8 +832,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 @@ -836,64 +871,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 --- a/Koha/Database.pm +++ a/Koha/Database.pm @@ -46,12 +46,11 @@ __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"); @@ -123,16 +122,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 @@ -144,7 +143,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 @@ -201,6 +200,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-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. --- a/Koha/Handler/Plack.pm +++ a/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 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::Builder; + +=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 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 $builder = Plack::Builder->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) { + $builder->mount("http://$host/" => sub { + my $env = shift; + + return $context->run_within_context(sub { $app->($env) }); + }); + } + } + return $builder->to_app; +} + +1; --- a/Koha/Handler/Plack/CGI.pm +++ a/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; + +=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; --- a/admin/systempreferences.pl +++ a/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 --- a/misc/cronjobs/check-url.pl +++ a/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 <> ''" ); --- a/misc/plack/koha-multi.psgi +++ a/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 ); --- a/misc/translator/LangInstaller.pm +++ a/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; --- a/t/Koha_Handler_Plack.t +++ a/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); + } + } + }; --- a/t/conf/dummy/koha-conf.xml +++ a/t/conf/dummy/koha-conf.xml @@ -0,0 +1,7 @@ + + + dummy + DUMMY + . + + --- a/t/conf/koha1/koha-conf.xml +++ a/t/conf/koha1/koha-conf.xml @@ -0,0 +1,7 @@ + + + koha1 + KOHA1 + . + + --- a/t/conf/koha2/koha-conf.xml +++ a/t/conf/koha2/koha-conf.xml @@ -0,0 +1,5 @@ + + + KOHA2 + + --- a/t/db_dependent/Amazon.t +++ a/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'); --- a/t/db_dependent/Context.t +++ a/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)) { --- a/t/db_dependent/Koha_template_plugin_KohaDates.t +++ a/t/db_dependent/Koha_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()"); --- a/t/db_dependent/XISBN.t +++ a/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', '' ); --- a/t/db_dependent/sysprefs.t +++ a/t/db_dependent/sysprefs.t @@ -62,10 +62,11 @@ is(C4::Context->preference('testpreference'), undef, 'clearing preference cache' delete $ENV{OVERRIDE_SYSPREF_opacheader}; -my $context1 = C4::Context->new(); +my $DUMMY_KOHA_CONF = "DUMMY"; +my $context1 = C4::Context->new($DUMMY_KOHA_CONF); is( $context1->preference('opacheader'), $opacheader, 'context1 "opacheader"'); -my $context2 = C4::Context->new(); +my $context2 = C4::Context->new($DUMMY_KOHA_CONF); $context2->set_preference( 'opacheader', $newopacheader ); is( $context1->preference('opacheader'), $opacheader, 'context1 "opacheader"'); is( $context2->preference('opacheader'), $newopacheader, 'context2 "opacheader"'); --
Apache $versions{apacheVersion}