Attachment #47421 for bug #15562

View | Details | Raw Unified | Return to bug 15562
Collapse All | Expand All

Lines 37-43 BEGIN { Link Here

(-)a/C4/Auth_with_cas.pm (-1 / +1 lines)
37	@ISA = qw(Exporter);	37	@ISA = qw(Exporter);
38	@EXPORT = qw(check_api_auth_cas checkpw_cas login_cas logout_cas login_cas_url);	38	@EXPORT = qw(check_api_auth_cas checkpw_cas login_cas logout_cas login_cas_url);
39	}	39	}
40	my $context = C4::Context->new() or die 'C4::Context->new failed';	40	my $context = C4::Context->current() or die 'No current context';
41	my $defaultcasserver;	41	my $defaultcasserver;
42	my $casservers;	42	my $casservers;
43	my $yamlauthfile = C4::Context->config('intranetdir') . "/C4/Auth_cas_servers.yaml";	43	my $yamlauthfile = C4::Context->config('intranetdir') . "/C4/Auth_cas_servers.yaml";

Lines 54-60 sub ldapserver_error { Link Here

(-)a/C4/Auth_with_ldap.pm (-1 / +1 lines)
54	}	54	}
55		55
56	use vars qw($mapping @ldaphosts $base $ldapname $ldappassword);	56	use vars qw($mapping @ldaphosts $base $ldapname $ldappassword);
57	my $context = C4::Context->new() or die 'C4::Context->new failed';	57	my $context = C4::Context->current() or die 'No current context';
58	my $ldap = C4::Context->config("ldapserver") or die 'No "ldapserver" in server hash from KOHA_CONF: ' . $ENV{KOHA_CONF};	58	my $ldap = C4::Context->config("ldapserver") or die 'No "ldapserver" in server hash from KOHA_CONF: ' . $ENV{KOHA_CONF};
59	my $prefhost = $ldap->{hostname} or die ldapserver_error('hostname');	59	my $prefhost = $ldap->{hostname} or die ldapserver_error('hostname');
60	my $base = $ldap->{base} or die ldapserver_error('base');	60	my $base = $ldap->{base} or die ldapserver_error('base');




			    eval {C4::Context->dbh();};
			    if ($@){
				$debug_level = 1;
			    }
			    else {
				$debug_level =  C4::Context->preference("DebugLevel");
			    }

		# a little example table with various version info";
					print "
						<h1>Koha error</h1>
						<p>The following fatal error has occurred:</p>
                        <pre><code>$msg</code></pre>
						<table>
						<tr><th>Apache</th><td>  $versions{apacheVersion}</td></tr>

				} elsif ($debug_level eq "1"){
					print "
						<h1>Koha error</h1>
						<p>The following fatal error has occurred:</p>
                        <pre><code>$msg</code></pre>";
				} else {
					print "<p>production mode - trapped fatal error</p>";
				}
                print "</body></html>";
			}
		#CGI::Carp::set_message(\&handle_errors);

use POSIX ();
use DateTime::TimeZone;
use Module::Load::Conditional qw(can_load);
use Data::Dumper;
use Carp;

use C4::Boolean;

#    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

# 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
#    '__KOHA_CONF_DIR__/koha-conf.xml', as happens
#    when Koha is installed in 'standard' or 'single'
#    mode.


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,
                # __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:

@context_stack = ();     # Initially, no saved contexts

=head2 current

Returns the current context

    my $listen = $koha->{'listen'}->{'biblioserver'}->{'content'};

The elements nested within the <server> element:

    my $ccl2rpn = $koha->{'server'}->{'biblioserver'}->{'cql2rpn'};

Returns undef in case of error.

=cut

sub current {
    return $context;

    if ($ismemcached) {
      $memcached->set('kohaconf',$koha);
    }

    return $koha;			# Return value: ref-to-hash holding the configuration
}

=head2 ismemcached

    }
}

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);

    # 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;

    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!
    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
    $context = $new_ctx;

    if ($ismemcached) {
      $memcached->set('kohaconf',$new_ctx);
    }
}

use Scalar::Util qw(openhandle);
=head2 new

  $context = new C4::Context;

file, which defaults to either the file given by the C<$KOHA_CONF>
environment variable, or F</etc/koha/koha-conf.xml>.

XML structure is a bit complex to the uninitiated ... take a look at the
koha-conf.xml file as well as the XML::Simple documentation for details. Or,
here are a few examples that may give you what you need:

The simple elements nested within the <config> element:

    my $pass = $koha->{'config'}->{'pass'};

The <listen> elements:

    my $listen = $koha->{'listen'}->{'biblioserver'}->{'content'};

The elements nested within the <server> element:

    my $ccl2rpn = $koha->{'server'}->{'biblioserver'}->{'cql2rpn'};

Returns undef in case of error.

C<&new> does not set this context as the new default context; for
that, use C<&set_context>.

# 2004-08-10 A. Tarallo: Added check if the conf file is not empty
sub new {
    my $class = shift;
    my $conf_fname = shift or croak "No conf";
    my $self = {};

    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"};
        if (exists $ENV{"KOHA_CONF"} and $ENV{'KOHA_CONF'} and -s  $ENV{"KOHA_CONF"}) {
            $conf_fname = $ENV{"KOHA_CONF"};
        } elsif ($INSTALLED_CONFIG_FNAME !~ /__KOHA_CONF_DIR/ and -s $INSTALLED_CONFIG_FNAME) {
            # NOTE: be careful -- don't change __KOHA_CONF_DIR in the above
            # regex to anything else -- don't want installer to rewrite it
            $conf_fname = $INSTALLED_CONFIG_FNAME;
        } elsif (-s CONFIG_FNAME) {
            $conf_fname = CONFIG_FNAME;
        } else {
            warn "unable to locate Koha configuration file koha-conf.xml";
            return;
        }
    }
    
    if ($ismemcached) {
        # retrieve from memcached
        $self = $memcached->get('kohaconf');
        if (not defined $self) {
            # not in memcached yet
            $self = read_config_file($conf_fname);
        }
    } else {
        # non-memcached env, read from file
        $self = read_config_file($conf_fname);
    }

    $self->{"config_file"} = "$conf_fname";
    warn "read_config_file($conf_fname) returned undef" if !defined($self->{"config"});
    return if !defined($self->{"config"});

    $self->{"Zconn"} = undef;    # Zebra Connections
    $self->{"marcfromkohafield"} = undef; # the hash with relations between koha table fields and MARC field/subfield

    # 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 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


    # Set the new context
    $context = $new_context;
    Koha::Database->set_schema($schema);
}

=head2 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");

=cut

sub _common_config {
    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 $self->{$term}->{$var};
}

sub config {
    my $self = shift;
    return $self->_common_config($_[0],'config');
}
sub zebraconfig {
    my $self = shift;
    return $self->_common_config($_[0],'server');
}
sub ModZebrations {
    my $self = shift;
    return $self->_common_config($_[0],'serverinfo');
}

=head2 preference


    return $self->{sysprefs}{$lc_var} if $use_syspref_cache && $self && exists $self->{sysprefs}{$lc_var};

    my $dbh  = C4::Context->dbh or return 0;

    my $value;
    if ( defined $ENV{"OVERRIDE_SYSPREF_$var"} ) {
        $value = $ENV{"OVERRIDE_SYSPREF_$var"};


Returns a connection to the Zebra database

C<$self>

C<$server> one of the servers defined in the koha-conf.xml file



This database handle is cached for future use: if you call
C<C4::Context-E<gt>dbh> twice, you will get the same handle both
times. If you need a second database handle, use C<&new_dbh>.
possibly C<&set_dbh>.

=cut


    return &dbh({ new => 1 });
}

=head2 set_dbh

  $my_dbh = C4::Connect->new_dbh;
  C4::Connect->set_dbh($my_dbh);
  ...
  C4::Connect->restore_dbh;

C<&set_dbh> and C<&restore_dbh> work in a manner analogous to
C<&set_context> and C<&restore_context>.

C<&set_dbh> saves the current database handle on a stack, then sets
the current database handle to C<$my_dbh>.

C<$my_dbh> is assumed to be a good database handle.

=cut

#'
sub set_dbh
{
    my $self = shift;
    my $new_dbh = shift;

    # Save the current database handle on the handle stack.
    # We assume that $new_dbh is all good: if the caller wants to
    # screw himself by passing an invalid handle, that's fine by
    # us.
    push @{$context->{"dbh_stack"}}, $context->{"dbh"};
    $context->{"dbh"} = $new_dbh;
}

=head2 restore_dbh

  C4::Context->restore_dbh;

Restores the database handle saved by an earlier call to
C<C4::Context-E<gt>set_dbh>.

=cut

#'
sub restore_dbh
{
    my $self = shift;

    if ($#{$context->{"dbh_stack"}} < 0)
    {
        # Stack underflow
        die "DBH stack underflow";
    }

    # Pop the old database handle and set it.
    $context->{"dbh"} = pop @{$context->{"dbh_stack"}};

    # FIXME - If it is determined that restore_context should
    # return something, then this function should, too.
}

=head2 queryparser

  $queryparser = C4::Context->queryparser




# 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 $db_driver = $context->db_driver;

    my $db_driver = $context->{db_driver};

    my $db_name   = $context->config("database");
    my $db_host   = $context->config("hostname");

        return $database->{schema} if defined $database->{schema};
    }

    $database->{schema} = &_new_schema($params->{context});
    return $database->{schema};
}

=head2 new_schema

  $schema = $database->new_schema($context);

Creates a new connection to the Koha database for the context
(current is default), and returns the database handle (a C<DBI::db> object).

The handle is not saved anywhere: this method is strictly a
convenience function; the point is that it knows which database to

sub new_schema {
    my $self = shift;

    return &_new_schema(@_);
}

=head2 set_schema

    # return something, then this function should, too.
}

=head2 run_with_schema

  $database->run_with_schema( $schema, sub {...} );

Restores the database handle saved by an earlier call to
C<$database-E<gt>set_schema> C<$database-E<gt>restore_schema> wrapper.

=cut

sub run_with_schema {
    my $self = shift;
    my $schema = shift or croak "No schema";
    my $code = shift or croak "No sub";

    $self->set_schema;
    local $@;
    my $ret = eval { $code->(@_) };
    my $died = $@;
    $self->restore_schema;
    die $died if $died;
    return $ret;
}

=head2 EXPORT

None by default.




package Koha::Handler::Plack;

# Copyright (c) 2016 Catalyst IT
#
# This file is part of Koha.
#
# Koha is free software; you can redistribute it and/or modify it under the
# terms of the GNU General Public License as published by the Free Software
# Foundation; either version 2 of the License, or (at your option) any later
# version.
#
# Koha is distributed in the hope that it will be useful, but WITHOUT ANY
# WARRANTY; without even the implied warranty of MERCHANTABILITY or FITNESS FOR
# A PARTICULAR PURPOSE.  See the GNU General Public License for more details.
#
# You should have received a copy of the GNU General Public License along with
# Koha; if not, write to the Free Software Foundation, Inc.,
# 51 Franklin Street, Fifth Floor, Boston, MA 02110-1301 USA.

=head1 NAME

  Koha::Handler::Plack - Plack helper

=head1 SYNOPSIS

  koha.psgi:
  use Koha::Handler::Plack;

  my %HOST_CONF = (
      'koha1.com' => { ...  },
      'koha2.com' => { ...  },
      ...
  );
  # last line
  Koha::Handler::Plack->app_per_host(\%HOST_CONF);

  See C<app_per_host()> below

=head1 DESCRIPTION

  Some handy function to help with Koha/Plack in a multi-host situation.

  The problem:
  Koha app relies on env vars. This should be changed, ie C4::Context should
  be upgraded to Koha::App, but until then we need a gap filler. That's
  because once up, there's no way to pass on new env to a psgi container.
  In Apache, for instance, we can specify env vars per virtual host. Plack
  has no such concept.

  Solution:
  We need to modify the environment in situ, per virtual host - app_per_host().
  We specify env for each hostname, and apply.

=cut

use Modern::Perl;
use Carp;

use Plack::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<hostname> is mandatory.


  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

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;




package Koha::Handler::Plack::CGI;

# Copyright (c) 2016 Catalyst IT
#
# This file is part of Koha.
#
# Koha is free software; you can redistribute it and/or modify it under the
# terms of the GNU General Public License as published by the Free Software
# Foundation; either version 2 of the License, or (at your option) any later
# version.
#
# Koha is distributed in the hope that it will be useful, but WITHOUT ANY
# WARRANTY; without even the implied warranty of MERCHANTABILITY or FITNESS FOR
# A PARTICULAR PURPOSE.  See the GNU General Public License for more details.
#
# You should have received a copy of the GNU General Public License along with
# Koha; if not, write to the Free Software Foundation, Inc.,
# 51 Franklin Street, Fifth Floor, Boston, MA 02110-1301 USA.

=head1 NAME

  Koha::Handler::Plack::CGI - Plack helper for CGI scripts

=head1 SYNOPSIS

  koha.psgi:
  use Koha::Handler::Plack::CGI;

  my %koha_env = (
      opac => {
          static_root => '/usr/share/koha/opac/htdocs',
          script_root => '/usr/share/koha/opac',
      },
      intranet => {
          static_root => '/usr/share/koha/intranet/htdocs',
          script_root => '/usr/share/koha/intranet'
      }
  );
  my @sites = (
      {
          opac_hostname => 'koha1-opac.com',
          intranet_hostname => 'koha1-intranet.com',
          config = '/etc/koha/koha1/koha-conf.xml'
      },
      {
          opac_hostname => ['opac.koha2.com', 'www.opackoha2.com'],
          intranet_hostname => ['intranet.koha2.com', 'www.intranetkoha2.com'],
          config = '/etc/koha/koha2/koha-conf.xml'
      },
  );

  # last line
  Koha::Handler::Plack::CGI->app_per_host(\%HOST_CONF);

  See C<app_per_host()> below

=head1 DESCRIPTION

  CGI script runner.

  One beautiful day wiwill move away from that and have proper App module
  with router and handlers</dream>

  See C<Koha::Handler::Plack>

=cut

use Modern::Perl;
use Carp;

use Plack::Builder;
use Plack::App::CGIBin;

use parent "Koha::Handler::Plack";

use C4::Context ":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>:
      {
          opac_hostname => 'koha1-opac.com',
          intranet_hostname => 'koha1-intranet.com',
          config => '/etc/koha/sites/koha1/koha-conf.xml'
      },
      {
          opac_hostname => ['opac.koha2.com', 'www.opackoha2.com'],
          intranet_hostname => ['intranet.koha2.com', 'www.intranetkoha2.com'],
          config => '/etc/koha/sites/koha2/koha-conf.xml'
      },
      ...

  koha.psgi:

  Koha::Handler::Plack::CGI->multi_site( \%koha_app_env, \@sites );

=cut

my $DUMMY_KOHA_CONF = "<yazgfs><config>DUMMY</config></yazgfs>";
sub multi_site {
    my $class = shift;
    my $env = shift or croak "No Koha env details";
    my $sites = shift or croak "No sites spec";

    my ($opac_app, $intranet_app);

    if (my $opac = $env->{opac}) {
        $opac_app = $class->app('opac', $opac);
    }

    if (my $intranet = $env->{intranet}) {
        $intranet_app = $class->app('intranet', $intranet);
    }

    my @host_def = map {
        my $config = $_->{config} or croak "Site without config";
        my $context = C4::Context->new($config);
        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;

                    $opac_app->(@_);
                },
                context => $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;

                    $intranet_app->(@_);
                },
                context => $context,
            };
        }
        @hd;
    } @$sites;

    return $class->app_per_host( \@host_def );
}

1;

Lines 422-428 output_html_with_http_headers $input, $cookie, $template->output; Link Here

(-)a/admin/systempreferences.pl (-1 / +1 lines)
422	# .pref files.	422	# .pref files.
423		423
424	sub get_prefs_from_files {	424	sub get_prefs_from_files {
425	my $context = C4::Context->new();	425	my $context = C4::Context->current();
426	my $path_pref_en = $context->config('intrahtdocs') .	426	my $path_pref_en = $context->config('intrahtdocs') .
427	'/prog/en/modules/admin/preferences';	427	'/prog/en/modules/admin/preferences';
428	# Get all .pref file names	428	# Get all .pref file names




#!/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 );

Lines 56-62 sub new { Link Here

(-)a/misc/translator/LangInstaller.pm (-1 / +1 lines)
56		56
57	my $self = { };	57	my $self = { };
58		58
59	my $context = C4::Context->new();	59	my $context = C4::Context->current();
60	$self->{context} = $context;	60	$self->{context} = $context;
61	$self->{path_pref_en} = $context->config('intrahtdocs') .	61	$self->{path_pref_en} = $context->config('intrahtdocs') .
62	'/prog/en/modules/admin/preferences';	62	'/prog/en/modules/admin/preferences';




is(C4::Context->interface, 'intranet');
is(C4::Context->interface('OPAC'), 'opac');
is(C4::Context->interface, 'opac');

my $DUMMY_KOHA_CONF = "<yazgfs><config><kohasite>TEST</kohasite></config></yazgfs>";
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", 5 unless $ctx_a->cache->is_cache_active && $ctx_b->cache->is_cache_active;

    # Light warm up
    $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
    $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");
    C4::Context->cache->set_in_cache($cache_key, 'c');
}




#!/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 ":no_config";

my $db = Test::MockModule->new('Koha::Database');
$db->mock(
    _new_schema => sub {
        return $_[0];
    }
);

sub make_response {
    return join ";", map defined($_) ? $_ : "", @_;
}
sub dummy_val {
    return C4::Context->config("dummy");
}
sub check_context {
    my $dummy_val = dummy_val();
    is $dummy_val, undef, "context preserved"
      or diag("dummy val: $dummy_val");
}

my $app = sub {
    return [
        200,
        [ 'Content-Type' => 'text/plain' ],
        [ make_response(dummy_val()) ]
    ];
};
my $generic_url = "http://dummyhost.com/";

my $KOHA_CONF_XML = <<EOS;
<yazgfs>
    <config>
        <kohasite>test</kohasite>
        <dummy>XML</dummy>
        <intrahtdocs>.</intrahtdocs>
    </config>
</yazgfs>
EOS

my @HOST_CONF = (
    {
        hostname => ['koha-file.com', 'www.koha-file.com'],
        app => $app,
        context => C4::Context->new("$Bin/conf/koha1/koha-conf.xml"),
        _dummy => "KOHA1"
    },
    {
        hostname => ['koha-xml.com', 'www.koha-xml.com'],
        app => $app,
        context => C4::Context->new(\$KOHA_CONF_XML),
        _dummy => "XML"
    },
);
test_psgi
    app => Koha::Handler::Plack->app_per_host(\@HOST_CONF),
    client => sub {
        my $cb  = shift;

        foreach my $site_params ( @HOST_CONF ) {
            my $valid_response = make_response(
                $site_params->{_dummy}
            );
            foreach (@{$site_params->{hostname}}) {
                my $res = $cb->(GET "http://$_/");
                is $res->content, $valid_response, $_
                  or diag(Dumper($site_params, $_, $res->as_string));
                check_context();
            }
        }

        $res = $cb->(GET $generic_url);
        is $res->code, 404, "app_per_host unknown host"
          or diag($res->as_string);
    };

my %MULTI_HOST_ENV = (
    opac => {
        static_root => "$Bin/../koha-tmpl/opac-tmpl/bootstrap",
        script_root => "$Bin/../opac",
    },
    intranet => {
        static_root => "$Bin/../koha-tmpl/intranet-tmpl/bootstrap",
        script_root => "$Bin/.."
    }
);
my @MULTI_HOST_SITES = (
    {
        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",
    },
    {
        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",
    },
);
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);
            }
        }
    };

Line 0 Link Here

(-)a/t/conf/dummy/koha-conf.xml (+7 lines)
	1	<yazgfs>
	2	<config>
	3	<kohasite>dummy</kohasite>
	4	<dummy>DUMMY</dummy>
	5	<intrahtdocs>.</intrahtdocs>
	6	</config>
	7	</yazgfs>

Line 0 Link Here

(-)a/t/conf/koha1/koha-conf.xml (+7 lines)
	1	<yazgfs>
	2	<config>
	3	<kohasite>koha1</kohasite>
	4	<dummy>KOHA1</dummy>
	5	<intrahtdocs>.</intrahtdocs>
	6	</config>
	7	</yazgfs>

Line 0 Link Here

(-)a/t/conf/koha2/koha-conf.xml (+5 lines)
	1	<yazgfs>
	2	<config>
	3	<dummy>KOHA2</dummy>
	4	</config>
	5	</yazgfs>

Lines 13-19 BEGIN { Link Here

(-)a/t/db_dependent/Amazon.t (-1 / +1 lines)
13	use_ok('C4::External::Amazon');	13	use_ok('C4::External::Amazon');
14	}	14	}
15		15
16	my $context = C4::Context->new();	16	my $context = C4::Context->current();
17		17
18	my $locale = $context->preference('AmazonLocale');	18	my $locale = $context->preference('AmazonLocale');
19		19

Lines 48-54 C4::Context->clear_syspref_cache(); Link Here

(-)a/t/db_dependent/Context.t (-1 / +1 lines)
48	C4::Context->enable_syspref_cache();	48	C4::Context->enable_syspref_cache();
49	$dbh->rollback;	49	$dbh->rollback;
50		50
51	ok($koha = C4::Context->new, 'C4::Context->new');	51	ok($koha = C4::Context->current, 'C4::Context->current');
52	my @keys = keys %$koha;	52	my @keys = keys %$koha;
53	my $width = 0;	53	my $width = 0;
54	if (ok(@keys)) {	54	if (ok(@keys)) {

Lines 13-19 BEGIN { Link Here

(-)a/t/db_dependent/Koha_template_plugin_KohaDates.t (-1 / +1 lines)
13	my $module_context = new Test::MockModule('C4::Context');	13	my $module_context = new Test::MockModule('C4::Context');
14		14
15	my $date = "1973-05-21";	15	my $date = "1973-05-21";
16	my $context = C4::Context->new();	16	my $context = C4::Context->current();
17		17
18	my $filter = Koha::Template::Plugin::KohaDates->new();	18	my $filter = Koha::Template::Plugin::KohaDates->new();
19	ok ($filter, "new()");	19	ok ($filter, "new()");

Lines 25-31 my $search_module = new Test::MockModule('C4::Search'); Link Here

(-)a/t/db_dependent/XISBN.t (-1 / +1 lines)
25		25
26	$search_module->mock('SimpleSearch', \&Mock_SimpleSearch );	26	$search_module->mock('SimpleSearch', \&Mock_SimpleSearch );
27		27
28	my $context = C4::Context->new;	28	my $context = C4::Context->current;
29		29
30	my ( $biblionumber_tag, $biblionumber_subfield ) =	30	my ( $biblionumber_tag, $biblionumber_subfield ) =
31	GetMarcFromKohaField( 'biblio.biblionumber', '' );	31	GetMarcFromKohaField( 'biblio.biblionumber', '' );





delete $ENV{OVERRIDE_SYSPREF_opacheader};

my $DUMMY_KOHA_CONF = "<yazgfs><config>DUMMY</config></yazgfs>";
my $context1 = C4::Context->new($DUMMY_KOHA_CONF);
is( $context1->preference('opacheader'), $opacheader, 'context1 "opacheader"');

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"');
- 

Return to bug 15562

Lines 31-37 BEGIN { Link Here

(-)a/C4/Context.pm (-165 / +139 lines)
31	eval {C4::Context->dbh();};	31	eval {C4::Context->dbh();};
32	if ($@){	32	if ($@){
33	$debug_level = 1;	33	$debug_level = 1;
34	}	34	}
35	else {	35	else {
36	$debug_level = C4::Context->preference("DebugLevel");	36	$debug_level = C4::Context->preference("DebugLevel");
37	}	37	}
Lines 49-55 BEGIN { Link Here
49	# a little example table with various version info";	49	# a little example table with various version info";
50	print "	50	print "
51	<h1>Koha error</h1>	51	<h1>Koha error</h1>
52	<p>The following fatal error has occurred:</p>	52	<p>The following fatal error has occurred:</p>
53	<pre><code>$msg</code></pre>	53	<pre><code>$msg</code></pre>
54	<table>	54	<table>
55	<tr><th>Apache</th><td> $versions{apacheVersion}</td></tr>	55	<tr><th>Apache</th><td> $versions{apacheVersion}</td></tr>
Lines 63-73 BEGIN { Link Here
63	} elsif ($debug_level eq "1"){	63	} elsif ($debug_level eq "1"){
64	print "	64	print "
65	<h1>Koha error</h1>	65	<h1>Koha error</h1>
66	<p>The following fatal error has occurred:</p>	66	<p>The following fatal error has occurred:</p>
67	<pre><code>$msg</code></pre>";	67	<pre><code>$msg</code></pre>";
68	} else {	68	} else {
69	print "<p>production mode - trapped fatal error</p>";	69	print "<p>production mode - trapped fatal error</p>";
70	}	70	}
71	print "</body></html>";	71	print "</body></html>";
72	}	72	}
73	#CGI::Carp::set_message(\&handle_errors);	73	#CGI::Carp::set_message(\&handle_errors);
Lines 103-108 use XML::Simple; Link Here
103	use POSIX ();	103	use POSIX ();
104	use DateTime::TimeZone;	104	use DateTime::TimeZone;
105	use Module::Load::Conditional qw(can_load);	105	use Module::Load::Conditional qw(can_load);
		106	use Data::Dumper;
106	use Carp;	107	use Carp;
107		108
108	use C4::Boolean;	109	use C4::Boolean;
Lines 169-178 environment variable to the pathname of a configuration file to use. Link Here
169	# file (/etc/koha/koha-conf.xml).	170	# file (/etc/koha/koha-conf.xml).
170	# dbh	171	# dbh
171	# A handle to the appropriate database for this context.	172	# A handle to the appropriate database for this context.
172	# dbh_stack
173	# Used by &set_dbh and &restore_dbh to hold other database
174	# handles for this context.
175	# Zconn
176	# A connection object for the Zebra server	173	# A connection object for the Zebra server
177		174
178	# Koha's main configuration file koha-conf.xml	175	# Koha's main configuration file koha-conf.xml
Lines 181-187 environment variable to the pathname of a configuration file to use. Link Here
181	# 1. Path supplied via use C4::Context '/path/to/koha-conf.xml'	178	# 1. Path supplied via use C4::Context '/path/to/koha-conf.xml'
182	# 2. Path supplied in KOHA_CONF environment variable.	179	# 2. Path supplied in KOHA_CONF environment variable.
183	# 3. Path supplied in INSTALLED_CONFIG_FNAME, as long	180	# 3. Path supplied in INSTALLED_CONFIG_FNAME, as long
184	# as value has changed from its default of	181	# as value has changed from its default of
185	# '__KOHA_CONF_DIR__/koha-conf.xml', as happens	182	# '__KOHA_CONF_DIR__/koha-conf.xml', as happens
186	# when Koha is installed in 'standard' or 'single'	183	# when Koha is installed in 'standard' or 'single'
187	# mode.	184	# mode.
Lines 191-242 environment variable to the pathname of a configuration file to use. Link Here
191		188
192	use constant CONFIG_FNAME => "/etc/koha/koha-conf.xml";	189	use constant CONFIG_FNAME => "/etc/koha/koha-conf.xml";
193	# Default config file, if none is specified	190	# Default config file, if none is specified
194		191
195	my $INSTALLED_CONFIG_FNAME = '__KOHA_CONF_DIR__/koha-conf.xml';	192	my $INSTALLED_CONFIG_FNAME = '__KOHA_CONF_DIR__/koha-conf.xml';
196	# path to config file set by installer	193	# path to config file set by installer
197	# __KOHA_CONF_DIR__ is set by rewrite-confg.PL	194	# __KOHA_CONF_DIR__ is set by rewrite-confg.PL
198	# when Koha is installed in 'standard' or 'single'	195	# when Koha is installed in 'standard' or 'single'
199	# mode. If Koha was installed in 'dev' mode,	196	# mode. If Koha was installed in 'dev' mode,
200	# __KOHA_CONF_DIR__ is not rewritten; instead	197	# __KOHA_CONF_DIR__ is not rewritten; instead
201	# developers should set the KOHA_CONF environment variable	198	# developers should set the KOHA_CONF environment variable
202
203	$context = undef; # Initially, no context is set
204	@context_stack = (); # Initially, no saved contexts
205
206
207	=head2 read_config_file
208
209	Reads the specified Koha config file.
210
211	Returns an object containing the configuration variables. The object's
212	structure is a bit complex to the uninitiated ... take a look at the
213	koha-conf.xml file as well as the XML::Simple documentation for details. Or,
214	here are a few examples that may give you what you need:
215		199
216	The simple elements nested within the <config> element:	200	@context_stack = (); # Initially, no saved contexts
217		201
218	my $pass = $koha->{'config'}->{'pass'};	202	=head2 current
219		203
220	The <listen> elements:	204	Returns the current context
221
222	my $listen = $koha->{'listen'}->{'biblioserver'}->{'content'};
223
224	The elements nested within the <server> element:
225
226	my $ccl2rpn = $koha->{'server'}->{'biblioserver'}->{'cql2rpn'};
227
228	Returns undef in case of error.
229		205
230	=cut	206	=cut
231		207
232	sub read_config_file { # Pass argument naming config file to read	208	sub current {
233	my $koha = XMLin(shift, keyattr => ['id'], forcearray => ['listen', 'server', 'serverinfo'], suppressempty => '');	209	return $context;
234
235	if ($ismemcached) {
236	$memcached->set('kohaconf',$koha);
237	}
238
239	return $koha; # Return value: ref-to-hash holding the configuration
240	}	210	}
241		211
242	=head2 ismemcached	212	=head2 ismemcached
Lines 264-269 sub memcached { Link Here
264	}	234	}
265	}	235	}
266		236
		237	sub db_driver {
		238	my $self = shift;
		239
		240	$self = $context unless ref ($self);
		241	return unless $self;
		242
		243	return $self->{db_driver};
		244	}
		245
267	=head2 db_scheme2dbi	246	=head2 db_scheme2dbi
268		247
269	my $dbd_driver_name = C4::Context::db_schema2dbi($scheme);	248	my $dbd_driver_name = C4::Context::db_schema2dbi($scheme);
Lines 284-303 sub import { Link Here
284	# Create the default context ($C4::Context::Context)	263	# Create the default context ($C4::Context::Context)
285	# the first time the module is called	264	# the first time the module is called
286	# (a config file can be optionaly passed)	265	# (a config file can be optionaly passed)
		266	# If ":no_config" is passed, no config load will be attempted
		267	# It saves the context values in the declared memcached server(s)
		268	# if currently available and uses those values until them expire and
		269	# re-reads them.
		270
		271	my ($pkg,$config_file) = @_ ;
287		272
288	# default context already exists?	273	# default context already exists?
289	return if $context;	274	return if $context;
290		275
		276	if ($ismemcached) {
		277	# retrieve from memcached
		278	if (my $self = $memcached->get('kohaconf')) {
		279	$context = $self;
		280	return;
		281	}
		282	}
		283
		284	# check that the specified config file exists and is not empty
		285	undef $config_file if defined $config_file &&
		286	!( ref($config_file) \|\| openhandle($config_file) \|\| -s $config_file );
		287	# Figure out a good config file to load if none was specified.
		288	if (!defined($config_file))
		289	{
		290	# If the $KOHA_CONF environment variable is set, use
		291	# that. Otherwise, use the built-in default.
		292	if ($ENV{'KOHA_CONF'} and ref($ENV{'KOHA_CONF'}) \|\| -s $ENV{"KOHA_CONF"}) {
		293	$config_file = $ENV{"KOHA_CONF"};
		294	} elsif ($INSTALLED_CONFIG_FNAME !~ /__KOHA_CONF_DIR/ and -s $INSTALLED_CONFIG_FNAME) {
		295	# NOTE: be careful -- don't change __KOHA_CONF_DIR in the above
		296	# regex to anything else -- don't want installer to rewrite it
		297	$config_file = $INSTALLED_CONFIG_FNAME;
		298	} elsif (-s CONFIG_FNAME) {
		299	$config_file = CONFIG_FNAME;
		300	} else {
		301	die "unable to locate Koha configuration file koha-conf.xml";
		302	}
		303	}
		304
291	# no ? so load it!	305	# no ? so load it!
292	my ($pkg,$config_file) = @_ ;	306	return if $config_file && $config_file eq ":no_config";
293	my $new_ctx = __PACKAGE__->new($config_file);	307	my $new_ctx = __PACKAGE__->new($config_file);
294	return unless $new_ctx;	308	return unless $new_ctx;
295		309
296	# if successfully loaded, use it by default	310	# if successfully loaded, use it by default
297	$new_ctx->set_context;	311	$context = $new_ctx;
298	1;	312
		313	if ($ismemcached) {
		314	$memcached->set('kohaconf',$new_ctx);
		315	}
299	}	316	}
300		317
		318	use Scalar::Util qw(openhandle);
301	=head2 new	319	=head2 new
302		320
303	$context = new C4::Context;	321	$context = new C4::Context;
Lines 307-315 Allocates a new context. Initializes the context from the specified Link Here
307	file, which defaults to either the file given by the C<$KOHA_CONF>	325	file, which defaults to either the file given by the C<$KOHA_CONF>
308	environment variable, or F</etc/koha/koha-conf.xml>.	326	environment variable, or F</etc/koha/koha-conf.xml>.
309		327
310	It saves the koha-conf.xml values in the declared memcached server(s)	328	XML structure is a bit complex to the uninitiated ... take a look at the
311	if currently available and uses those values until them expire and	329	koha-conf.xml file as well as the XML::Simple documentation for details. Or,
312	re-reads them.	330	here are a few examples that may give you what you need:
		331
		332	The simple elements nested within the <config> element:
		333
		334	my $pass = $koha->{'config'}->{'pass'};
		335
		336	The <listen> elements:
		337
		338	my $listen = $koha->{'listen'}->{'biblioserver'}->{'content'};
		339
		340	The elements nested within the <server> element:
		341
		342	my $ccl2rpn = $koha->{'server'}->{'biblioserver'}->{'cql2rpn'};
		343
		344	Returns undef in case of error.
313		345
314	C<&new> does not set this context as the new default context; for	346	C<&new> does not set this context as the new default context; for
315	that, use C<&set_context>.	347	that, use C<&set_context>.
Lines 321-366 that, use C<&set_context>. Link Here
321	# 2004-08-10 A. Tarallo: Added check if the conf file is not empty	353	# 2004-08-10 A. Tarallo: Added check if the conf file is not empty
322	sub new {	354	sub new {
323	my $class = shift;	355	my $class = shift;
324	my $conf_fname = shift; # Config file to load	356	my $conf_fname = shift or croak "No conf";
325	my $self = {};
326		357
327	# check that the specified config file exists and is not empty	358	my $self = XMLin(
328	undef $conf_fname unless	359	$conf_fname,
329	(defined $conf_fname && -s $conf_fname);	360	keyattr => ['id'],
330	# Figure out a good config file to load if none was specified.	361	forcearray => ['listen', 'server', 'serverinfo'],
331	if (!defined($conf_fname))	362	suppressempty => '',
332	{	363	);
333	# If the $KOHA_CONF environment variable is set, use	364	die "Invalid config ".(ref($conf_fname) ? $$conf_fname : $conf_fname).": ".Dumper($self)
334	# that. Otherwise, use the built-in default.	365	unless ref($self) && $self->{"config"};
335	if (exists $ENV{"KOHA_CONF"} and $ENV{'KOHA_CONF'} and -s $ENV{"KOHA_CONF"}) {
336	$conf_fname = $ENV{"KOHA_CONF"};
337	} elsif ($INSTALLED_CONFIG_FNAME !~ /__KOHA_CONF_DIR/ and -s $INSTALLED_CONFIG_FNAME) {
338	# NOTE: be careful -- don't change __KOHA_CONF_DIR in the above
339	# regex to anything else -- don't want installer to rewrite it
340	$conf_fname = $INSTALLED_CONFIG_FNAME;
341	} elsif (-s CONFIG_FNAME) {
342	$conf_fname = CONFIG_FNAME;
343	} else {
344	warn "unable to locate Koha configuration file koha-conf.xml";
345	return;
346	}
347	}
348
349	if ($ismemcached) {
350	# retrieve from memcached
351	$self = $memcached->get('kohaconf');
352	if (not defined $self) {
353	# not in memcached yet
354	$self = read_config_file($conf_fname);
355	}
356	} else {
357	# non-memcached env, read from file
358	$self = read_config_file($conf_fname);
359	}
360		366
361	$self->{"config_file"} = $conf_fname;	367	$self->{"config_file"} = "$conf_fname";
362	warn "read_config_file($conf_fname) returned undef" if !defined($self->{"config"});
363	return if !defined($self->{"config"});
364		368
365	$self->{"Zconn"} = undef; # Zebra Connections	369	$self->{"Zconn"} = undef; # Zebra Connections
366	$self->{"marcfromkohafield"} = undef; # the hash with relations between koha table fields and MARC field/subfield	370	$self->{"marcfromkohafield"} = undef; # the hash with relations between koha table fields and MARC field/subfield
Lines 407-419 sub set_context Link Here
407	# break this assumption by playing silly buggers, but that's	411	# break this assumption by playing silly buggers, but that's
408	# harder to do than doing it properly, and harder to check	412	# harder to do than doing it properly, and harder to check
409	# for.	413	# for.
		414	my $schema;
410	if (ref($self) eq "")	415	if (ref($self) eq "")
411	{	416	{
412	# Class method. The new context is the next argument.	417	# Class method. The new context is the next argument.
413	$new_context = shift;	418	$new_context = shift or croak "No new context";
		419	$schema = Koha::Database->new_schema($new_context);
414	} else {	420	} else {
415	# Instance method. The new context is $self.	421	# Instance method. The new context is $self.
416	$new_context = $self;	422	$new_context = $self;
		423
		424	# undef $self->{schema} if $self->{schema} && !$self->{schema}->ping
		425	$schema = $self->{schema} \|\|= Koha::Database->new_schema($self);
417	}	426	}
418		427
419	# Save the old context, if any, on the stack	428	# Save the old context, if any, on the stack
Lines 421-426 sub set_context Link Here
421		430
422	# Set the new context	431	# Set the new context
423	$context = $new_context;	432	$context = $new_context;
		433	Koha::Database->set_schema($schema);
424	}	434	}
425		435
426	=head2 restore_context	436	=head2 restore_context
Lines 436-454 sub restore_context Link Here
436	{	446	{
437	my $self = shift;	447	my $self = shift;
438		448
439	if ($#context_stack < 0)
440	{
441	# Stack underflow.
442	die "Context stack underflow";
443	}
444
445	# Pop the old context and set it.	449	# Pop the old context and set it.
446	$context = pop @context_stack;	450	$context = pop @context_stack;
		451	Koha::Database->restore_schema();
447		452
448	# FIXME - Should this return something, like maybe the context	453	# FIXME - Should this return something, like maybe the context
449	# that was current when this was called?	454	# that was current when this was called?
450	}	455	}
451		456
		457	=head2 run_within_context
		458
		459	$context->run_within_context(sub {...});
		460
		461	Runs code within context
		462
		463	=cut
		464
		465	#'
		466	sub run_within_context
		467	{
		468	my $self = shift;
		469	my $code = shift or croak "No code";
		470
		471	$self->set_context;
		472
		473	local $@;
		474	my $ret = eval { $code->(@_) };
		475	my $died = $@;
		476	$self->restore_context;
		477	die $died if $died;
		478	return $ret;
		479	}
		480
452	=head2 config	481	=head2 config
453		482
454	$value = C4::Context->config("config_variable");	483	$value = C4::Context->config("config_variable");
Lines 465-490 C<C4::Config-E<gt>new> will not return it. Link Here
465	=cut	494	=cut
466		495
467	sub _common_config {	496	sub _common_config {
468	my $var = shift;	497	my $self = shift;
469	my $term = shift;	498	my $var = shift;
470	return if !defined($context->{$term});	499	my $term = shift;
		500
		501	$self = $context unless ref $self;
		502	return if !defined($self->{$term});
471	# Presumably $self->{$term} might be	503	# Presumably $self->{$term} might be
472	# undefined if the config file given to &new	504	# undefined if the config file given to &new
473	# didn't exist, and the caller didn't bother	505	# didn't exist, and the caller didn't bother
474	# to check the return value.	506	# to check the return value.
475		507
476	# Return the value of the requested config variable	508	# Return the value of the requested config variable
477	return $context->{$term}->{$var};	509	return $self->{$term}->{$var};
478	}	510	}
479		511
480	sub config {	512	sub config {
481	return _common_config($_[1],'config');	513	my $self = shift;
		514	return $self->_common_config($_[0],'config');
482	}	515	}
483	sub zebraconfig {	516	sub zebraconfig {
484	return _common_config($_[1],'server');	517	my $self = shift;
		518	return $self->_common_config($_[0],'server');
485	}	519	}
486	sub ModZebrations {	520	sub ModZebrations {
487	return _common_config($_[1],'serverinfo');	521	my $self = shift;
		522	return $self->_common_config($_[0],'serverinfo');
488	}	523	}
489		524
490	=head2 preference	525	=head2 preference
Lines 517-524 sub preference { Link Here
517		552
518	return $self->{sysprefs}{$lc_var} if $use_syspref_cache && $self && exists $self->{sysprefs}{$lc_var};	553	return $self->{sysprefs}{$lc_var} if $use_syspref_cache && $self && exists $self->{sysprefs}{$lc_var};
519		554
520	my $dbh = C4::Context->dbh or return 0;
521
522	my $value;	555	my $value;
523	if ( defined $ENV{"OVERRIDE_SYSPREF_$var"} ) {	556	if ( defined $ENV{"OVERRIDE_SYSPREF_$var"} ) {
524	$value = $ENV{"OVERRIDE_SYSPREF_$var"};	557	$value = $ENV{"OVERRIDE_SYSPREF_$var"};
Lines 626-632 sub set_preference { Link Here
626		659
627	Returns a connection to the Zebra database	660	Returns a connection to the Zebra database
628		661
629	C<$self>	662	C<$self>
630		663
631	C<$server> one of the servers defined in the koha-conf.xml file	664	C<$server> one of the servers defined in the koha-conf.xml file
632		665
Lines 737-744 creates one, and connects to the database. Link Here
737		770
738	This database handle is cached for future use: if you call	771	This database handle is cached for future use: if you call
739	C<C4::Context-E<gt>dbh> twice, you will get the same handle both	772	C<C4::Context-E<gt>dbh> twice, you will get the same handle both
740	times. If you need a second database handle, use C<&new_dbh> and	773	times. If you need a second database handle, use C<&new_dbh>.
741	possibly C<&set_dbh>.
742		774
743	=cut	775	=cut
744		776
Lines 777-840 sub new_dbh Link Here
777	return &dbh({ new => 1 });	809	return &dbh({ new => 1 });
778	}	810	}
779		811
780	=head2 set_dbh
781
782	$my_dbh = C4::Connect->new_dbh;
783	C4::Connect->set_dbh($my_dbh);
784	...
785	C4::Connect->restore_dbh;
786
787	C<&set_dbh> and C<&restore_dbh> work in a manner analogous to
788	C<&set_context> and C<&restore_context>.
789
790	C<&set_dbh> saves the current database handle on a stack, then sets
791	the current database handle to C<$my_dbh>.
792
793	C<$my_dbh> is assumed to be a good database handle.
794
795	=cut
796
797	#'
798	sub set_dbh
799	{
800	my $self = shift;
801	my $new_dbh = shift;
802
803	# Save the current database handle on the handle stack.
804	# We assume that $new_dbh is all good: if the caller wants to
805	# screw himself by passing an invalid handle, that's fine by
806	# us.
807	push @{$context->{"dbh_stack"}}, $context->{"dbh"};
808	$context->{"dbh"} = $new_dbh;
809	}
810
811	=head2 restore_dbh
812
813	C4::Context->restore_dbh;
814
815	Restores the database handle saved by an earlier call to
816	C<C4::Context-E<gt>set_dbh>.
817
818	=cut
819
820	#'
821	sub restore_dbh
822	{
823	my $self = shift;
824
825	if ($#{$context->{"dbh_stack"}} < 0)
826	{
827	# Stack underflow
828	die "DBH stack underflow";
829	}
830
831	# Pop the old database handle and set it.
832	$context->{"dbh"} = pop @{$context->{"dbh_stack"}};
833
834	# FIXME - If it is determined that restore_context should
835	# return something, then this function should, too.
836	}
837
838	=head2 queryparser	812	=head2 queryparser
839		813
840	$queryparser = C4::Context->queryparser	814	$queryparser = C4::Context->queryparser

Lines 46-57 __PACKAGE__->mk_accessors(qw( )); Link Here

(-)a/Koha/Database.pm (-8 / +30 lines)
46	# database connection from the data given in the current context, and	46	# database connection from the data given in the current context, and
47	# returns it.	47	# returns it.
48	sub _new_schema {	48	sub _new_schema {
		49	my $context = shift \|\| C4::Context->current();
49		50
50	require Koha::Schema;	51	require Koha::Schema;
51		52
52	my $context = C4::Context->new();	53	my $db_driver = $context->db_driver;
53
54	my $db_driver = $context->{db_driver};
55		54
56	my $db_name = $context->config("database");	55	my $db_name = $context->config("database");
57	my $db_host = $context->config("hostname");	56	my $db_host = $context->config("hostname");
Lines 122-137 sub schema { Link Here
122	return $database->{schema} if defined $database->{schema};	121	return $database->{schema} if defined $database->{schema};
123	}	122	}
124		123
125	$database->{schema} = &_new_schema();	124	$database->{schema} = &_new_schema($params->{context});
126	return $database->{schema};	125	return $database->{schema};
127	}	126	}
128		127
129	=head2 new_schema	128	=head2 new_schema
130		129
131	$schema = $database->new_schema;	130	$schema = $database->new_schema($context);
132		131
133	Creates a new connection to the Koha database for the current context,	132	Creates a new connection to the Koha database for the context
134	and returns the database handle (a C<DBI::db> object).	133	(current is default), and returns the database handle (a C<DBI::db> object).
135		134
136	The handle is not saved anywhere: this method is strictly a	135	The handle is not saved anywhere: this method is strictly a
137	convenience function; the point is that it knows which database to	136	convenience function; the point is that it knows which database to
Lines 143-149 connect to so that the caller doesn't have to know. Link Here
143	sub new_schema {	142	sub new_schema {
144	my $self = shift;	143	my $self = shift;
145		144
146	return &_new_schema();	145	return &_new_schema(@_);
147	}	146	}
148		147
149	=head2 set_schema	148	=head2 set_schema
Lines 200-205 sub restore_schema { Link Here
200	# return something, then this function should, too.	199	# return something, then this function should, too.
201	}	200	}
202		201
		202	=head2 run_with_schema
		203
		204	$database->run_with_schema( $schema, sub {...} );
		205
		206	Restores the database handle saved by an earlier call to
		207	C<$database-E<gt>set_schema> C<$database-E<gt>restore_schema> wrapper.
		208
		209	=cut
		210
		211	sub run_with_schema {
		212	my $self = shift;
		213	my $schema = shift or croak "No schema";
		214	my $code = shift or croak "No sub";
		215
		216	$self->set_schema;
		217	local $@;
		218	my $ret = eval { $code->(@_) };
		219	my $died = $@;
		220	$self->restore_schema;
		221	die $died if $died;
		222	return $ret;
		223	}
		224
203	=head2 EXPORT	225	=head2 EXPORT
204		226
205	None by default.	227	None by default.

Line 0 Link Here

(-)a/Koha/Handler/Plack.pm (+163 lines)
		1	package Koha::Handler::Plack;
		2
		3	# Copyright (c) 2016 Catalyst IT
		4	#
		5	# This file is part of Koha.
		6	#
		7	# Koha is free software; you can redistribute it and/or modify it under the
		8	# terms of the GNU General Public License as published by the Free Software
		9	# Foundation; either version 2 of the License, or (at your option) any later
		10	# version.
		11	#
		12	# Koha is distributed in the hope that it will be useful, but WITHOUT ANY
		13	# WARRANTY; without even the implied warranty of MERCHANTABILITY or FITNESS FOR
		14	# A PARTICULAR PURPOSE. See the GNU General Public License for more details.
		15	#
		16	# You should have received a copy of the GNU General Public License along with
		17	# Koha; if not, write to the Free Software Foundation, Inc.,
		18	# 51 Franklin Street, Fifth Floor, Boston, MA 02110-1301 USA.
		19
		20	=head1 NAME
		21
		22	Koha::Handler::Plack - Plack helper
		23
		24	=head1 SYNOPSIS
		25
		26	koha.psgi:
		27	use Koha::Handler::Plack;
		28
		29	my %HOST_CONF = (
		30	'koha1.com' => { ... },
		31	'koha2.com' => { ... },
		32	...
		33	);
		34	# last line
		35	Koha::Handler::Plack->app_per_host(\%HOST_CONF);
		36
		37	See C<app_per_host()> below
		38
		39	=head1 DESCRIPTION
		40
		41	Some handy function to help with Koha/Plack in a multi-host situation.
		42
		43	The problem:
		44	Koha app relies on env vars. This should be changed, ie C4::Context should
		45	be upgraded to Koha::App, but until then we need a gap filler. That's
		46	because once up, there's no way to pass on new env to a psgi container.
		47	In Apache, for instance, we can specify env vars per virtual host. Plack
		48	has no such concept.
		49
		50	Solution:
		51	We need to modify the environment in situ, per virtual host - app_per_host().
		52	We specify env for each hostname, and apply.
		53
		54	=cut
		55
		56	use Modern::Perl;
		57	use Carp;
		58
		59	use Plack::Builder;
		60
		61	=head1 CLASS METHODS
		62
		63	=head2 app_per_host($host_apps)
		64
65	App wrapper for per virtual host scenario.
66
67	C<$host_apps>:
68	{
69	hostname => 'koha1.com',
70	app => $app1,
71	context = $context1,
72	},
73	{
74	hostname => ['koha2.com', 'www.koha2.com'],
75	app => $app2,
76	context = $context2,
77	},
78	...
79
80	C<hostname> is mandatory.
81
82
83	koha.psgi:
84
85	use Plack::Builder;
86	use Plack::App::CGIBin;
87
88	use C4::Context ":no_config";
89
90	my $opac_app = builder {
91	enable "Plack::Middleware::Static",
92	path => qr{^/opac-tmpl/}, root => '/usr/share/koha/opac/htdocs/';
93
94	enable 'StackTrace';
95	mount "/cgi-bin/koha" => Plack::App::CGIBin->new(root => "/usr/share/koha/opac/cgi-bin/opac");
96	};
97	my $intranet_app = builder {
98	enable "Plack::Middleware::Static",
99	path => qr{^/intranet-tmpl/}, root => '/usr/share/koha/intranet/htdocs/';
100
101	enable 'StackTrace';
102	mount "/cgi-bin/koha" => Plack::App::CGIBin->new(root => "/usr/share/koha/cgi-bin");
103	};
104
105	my @host_def;
106
107	my $conf_file_1 = "/etc/koha/site-1/koha_conf.xml";
108	my $context_1 = C4::Context->new($conf_file_1);
109	push @host_def,
110	{
111	hostname => [ "public.host.for.site-1", "www.public.host.for.site-1" ],
112	app => $opac_app,
113	context => $context_1,
114	},
115	{
116	hostname => "intranet.host.for.site-1",
117	app => $intranet_app,
118	context => $context_1,
119	};
120
121	my $conf_file_2 = "/etc/koha/site-1/koha_conf.xml";
122	my $context_2 = C4::Context->new($conf_file_2);
123	push @host_def,
124	{
125	hostname => "public.host.for.site-2",
126	app => $opac_app,
127	context => $context_2,
128	},
129	{
130	hostname => "intranet.host.for.site-2",
131	app => $intranet_app,
132	context => $context_2,
133	};
134
135	...
136
137	Koha::Handler::Plack->app_per_host( \@host_def );
138
139	=cut
140
141	sub app_per_host {
142	my $class = shift;
143	my $sites = shift or die "No sites spec";
144
145	my $builder = Plack::Builder->new;
146	foreach my $site_params ( @$sites ) {
147	my $hosts = $site_params->{hostname} or croak "No hostname";
148	$hosts = [$hosts] unless ref $hosts;
149
150	my $app = $site_params->{app} or croak "No app";
151	my $context = $site_params->{context} or croak "No Koha Context";
152
153	foreach my $host (@$hosts) {
154	$builder->mount("http://$host/" => sub {
155	my $env = shift;
156	return $context->run_within_context(sub { $app->($env) });
157	});
158	}
159	}
160	return $builder->to_app;
161	}
162
163	1;

Line 0 Link Here

(-)a/Koha/Handler/Plack/CGI.pm (+217 lines)
		1	package Koha::Handler::Plack::CGI;
		2
		3	# Copyright (c) 2016 Catalyst IT
		4	#
		5	# This file is part of Koha.
		6	#
		7	# Koha is free software; you can redistribute it and/or modify it under the
		8	# terms of the GNU General Public License as published by the Free Software
		9	# Foundation; either version 2 of the License, or (at your option) any later
		10	# version.
		11	#
		12	# Koha is distributed in the hope that it will be useful, but WITHOUT ANY
		13	# WARRANTY; without even the implied warranty of MERCHANTABILITY or FITNESS FOR
		14	# A PARTICULAR PURPOSE. See the GNU General Public License for more details.
		15	#
		16	# You should have received a copy of the GNU General Public License along with
		17	# Koha; if not, write to the Free Software Foundation, Inc.,
		18	# 51 Franklin Street, Fifth Floor, Boston, MA 02110-1301 USA.
		19
		20	=head1 NAME
		21
		22	Koha::Handler::Plack::CGI - Plack helper for CGI scripts
		23
		24	=head1 SYNOPSIS
		25
		26	koha.psgi:
		27	use Koha::Handler::Plack::CGI;
		28
		29	my %koha_env = (
		30	opac => {
		31	static_root => '/usr/share/koha/opac/htdocs',
		32	script_root => '/usr/share/koha/opac',
		33	},
		34	intranet => {
		35	static_root => '/usr/share/koha/intranet/htdocs',
		36	script_root => '/usr/share/koha/intranet'
		37	}
		38	);
		39	my @sites = (
		40	{
		41	opac_hostname => 'koha1-opac.com',
		42	intranet_hostname => 'koha1-intranet.com',
		43	config = '/etc/koha/koha1/koha-conf.xml'
		44	},
		45	{
		46	opac_hostname => ['opac.koha2.com', 'www.opackoha2.com'],
		47	intranet_hostname => ['intranet.koha2.com', 'www.intranetkoha2.com'],
		48	config = '/etc/koha/koha2/koha-conf.xml'
		49	},
		50	);
		51
		52	# last line
		53	Koha::Handler::Plack::CGI->app_per_host(\%HOST_CONF);
		54
		55	See C<app_per_host()> below
		56
		57	=head1 DESCRIPTION
		58
		59	CGI script runner.
		60
		61	One beautiful day wiwill move away from that and have proper App module
		62	with router and handlers</dream>
		63
		64	See C<Koha::Handler::Plack>
65
66	=cut
67
68	use Modern::Perl;
69	use Carp;
70
71	use Plack::Builder;
72	use Plack::App::CGIBin;
73
74	use parent "Koha::Handler::Plack";
75
76	use C4::Context ":no_config";
77
78	=head1 CLASS METHODS
79
80	=head2 app($context, $env)
81
82	Plack app builder fora CGI app
83
84	C<$context>: "opac" or "intranet"
85	C<$env>:
86	{
87	static_root => '...',
88	script_root => '...',
89	pugins => [
90	[ 'StackTrace' ],
91	...
92	],
93	}
94
95	koha.psgi:
96
97	Koha::Handler::Plack::CGI->app( "opac", \%opac_app_env );
98
99	=cut
100
101	sub app {
102	my $class = shift;
103	my $context = shift;
104	croak "Invalid app context '$context' - must be 'opac' or 'intranet'"
105	unless $context =~ m/^(opac\|intranet)$/;
106	my $env = shift or croak "No $context env details";
107
108	my $static_root = $env->{static_root} or croak "No $context static_root";
109	$static_root = "$static_root/" unless $static_root =~ m!/$!;
110	my $script_root = $env->{script_root} or croak "No $context script_root";
111	$script_root =~ s!/$!!;
112	my $plugins = $env->{plugins} \|\| [];
113	my $is_intranet = $context eq "intranet";
114
115	builder {
116	enable "Plack::Middleware::Static",
117	path => qr{^/$context-tmpl/}, root => $static_root;
118
119	map enable(@$_), @$plugins;
120
121	mount "/cgi-bin/koha" => Plack::App::CGIBin->new(root => $script_root)->to_app;
122	mount "/" => sub {
123	return [ 302, [ Location => '/cgi-bin/koha/' . ( $is_intranet ? 'mainpage.pl' : 'opac-main.pl' ) ], [] ];
124	};
125	};
126	}
127
128	=head2 multi_site($env, $sites)
129
130	App wrapper for per virtual host scenario.
131
132	C<$env>:
133	{
134	opac => {
135	static_root => '/usr/share/koha/opac/htdocs',
136	script_root => '/usr/share/koha/opac/cgi-bin/opac',
137	pugins => [
138	[ 'StackTrace' ],
139	],
140	},
141	intranet => {
142	static_root => '/usr/share/koha/intranet/htdocs',
143	script_root => '/usr/share/koha/cgi-bin'
144	}
145	}
146	C<$sites>:
147	{
148	opac_hostname => 'koha1-opac.com',
149	intranet_hostname => 'koha1-intranet.com',
150	config => '/etc/koha/sites/koha1/koha-conf.xml'
151	},
152	{
153	opac_hostname => ['opac.koha2.com', 'www.opackoha2.com'],
154	intranet_hostname => ['intranet.koha2.com', 'www.intranetkoha2.com'],
155	config => '/etc/koha/sites/koha2/koha-conf.xml'
156	},
157	...
158
159	koha.psgi:
160
161	Koha::Handler::Plack::CGI->multi_site( \%koha_app_env, \@sites );
162
163	=cut
164
165	my $DUMMY_KOHA_CONF = "<yazgfs><config>DUMMY</config></yazgfs>";
166	sub multi_site {
167	my $class = shift;
168	my $env = shift or croak "No Koha env details";
169	my $sites = shift or croak "No sites spec";
170
171	my ($opac_app, $intranet_app);
172
173	if (my $opac = $env->{opac}) {
174	$opac_app = $class->app('opac', $opac);
175	}
176
177	if (my $intranet = $env->{intranet}) {
178	$intranet_app = $class->app('intranet', $intranet);
179	}
180
181	my @host_def = map {
182	my $config = $_->{config} or croak "Site without config";
183	my $context = C4::Context->new($config);
184	my @hd;
185	if (my $hostname = $_->{opac_hostname}) {
186	croak "You have OPAC hosts without OPAC env details" unless $opac_app;
187	push @hd, {
188	hostname => $hostname,
189	app => sub {
190	# XXX this may need some rethinking
191	local $ENV{KOHA_CONF} = \$DUMMY_KOHA_CONF;
192
193	$opac_app->(@_);
194	},
195	context => $context,
196	};
197	}
198	if (my $hostname = $_->{intranet_hostname}) {
199	croak "You have Intranet hosts without Intranet env details" unless $intranet_app;
200	push @hd, {
201	hostname => $hostname,
202	app => sub {
203	# XXX this may need some rethinking
204	local $ENV{KOHA_CONF} = \$DUMMY_KOHA_CONF;
205
206	$intranet_app->(@_);
207	},
208	context => $context,
209	};
210	}
211	@hd;
212	} @$sites;
213
214	return $class->app_per_host( \@host_def );
215	}
216
217	1;

Line 0 Link Here

(-)a/misc/plack/koha-multi.psgi (+29 lines)
	1	#!/usr/bin/perl
	2
	3	# This is a minimal example. You can include all frills from koha.psgi
	4	# To try it:
	5	# plackup -I /usr/share/koha/lib --port 5010 koha-multi.psgi
	6
	7	my %KOHA_ENV = (
	8	opac => {
	9	static_root => '/usr/share/koha/opac/htdocs',
	10	script_root => '/usr/share/koha/opac/cgi-bin/opac',
	11	pugins => [
	12	# don't enable this plugin in production, since stack traces reveal too much information
	13	# about system to potential attackers!
	14	[ 'StackTrace' ],
	15	],
	16	},
	17	intranet => {
	18	static_root => '/usr/share/koha/intranet/htdocs',
	19	script_root => '/usr/share/koha/intranet/cgi-bin',
	20	}
	21	);
	22	my @SITES = map {
	23	namespace => $_,
	24	opac_hostname => "opac.$_.my-koha-multisite.net",
	25	intranet_hostname => "intranet.$_.my-koha-multisite.net",
	26	config => "/etc/koha/sites/$_/koha-conf.xml"
	27	}, qw(koha1 koha2 koha3);
	28
	29	Koha::Handler::Plack::CGI->multi_site( \%KOHA_ENV, \@SITES );

Lines 59-61 is(C4::Context->interface('foobar'), 'intranet'); Link Here

(-)a/t/Context.t (+25 lines)
59	is(C4::Context->interface, 'intranet');	59	is(C4::Context->interface, 'intranet');
60	is(C4::Context->interface('OPAC'), 'opac');	60	is(C4::Context->interface('OPAC'), 'opac');
61	is(C4::Context->interface, 'opac');	61	is(C4::Context->interface, 'opac');
		62
		63	my $DUMMY_KOHA_CONF = "<yazgfs><config><kohasite>TEST</kohasite></config></yazgfs>";
		64	my $ctx_a = C4::Context->new($DUMMY_KOHA_CONF, "a");
		65	my $ctx_b = C4::Context->new($DUMMY_KOHA_CONF, "b");
		66	my $cache_key = "test_C4::Context";
		67
		68	SKIP: {
		69	skip "No cache", 5 unless $ctx_a->cache->is_cache_active && $ctx_b->cache->is_cache_active;
		70
		71	# Light warm up
		72	$ctx_a->cache->set_in_cache($cache_key, 'a');
		73	$ctx_b->cache->set_in_cache($cache_key, 'b');
		74	is(C4::Context->cache->get_from_cache($cache_key), 'c', "Correct default cache value");
		75	is($ctx_a->cache->get_from_cache($cache_key), 'a', "Correct cache 'a' value");
		76	is($ctx_b->cache->get_from_cache($cache_key), 'b', "Correct cache 'b' value");
		77
		78	# A bit more extravagant
		79	$ctx_a->run_within_context( sub {
		80	$ctx_b->cache->set_in_cache($cache_key, 'bb');
		81	C4::Context->cache->set_in_cache($cache_key, 'aa');
		82	} );
		83	is($ctx_a->cache->get_from_cache($cache_key), 'aa', "Correct cache 'a' value");
		84	is($ctx_b->cache->get_from_cache($cache_key), 'bb', "Correct cache 'b' value");
		85	C4::Context->cache->set_in_cache($cache_key, 'c');
		86	}

Line 0 Link Here

(-)a/t/Koha_Handler_Plack.t (+133 lines)
		1	#!/usr/bin/perl
		2
		3	use Test::More tests => 15;
		4	use Plack::Test;
		5	use Plack::Test::MockHTTP;
		6	use Test::Mock::LWP::Dispatch;
		7	use Test::MockModule;
		8	use HTTP::Request::Common;
		9	use FindBin qw($Bin);
		10	use Data::Dumper;
		11
		12	use_ok("Koha::Handler::Plack");
		13	use_ok("Koha::Handler::Plack::CGI");
		14
		15	use C4::Context ":no_config";
		16
		17	my $db = Test::MockModule->new('Koha::Database');
		18	$db->mock(
		19	_new_schema => sub {
		20	return $_[0];
		21	}
		22	);
		23
		24	sub make_response {
		25	return join ";", map defined($_) ? $_ : "", @_;
		26	}
		27	sub dummy_val {
		28	return C4::Context->config("dummy");
		29	}
		30	sub check_context {
		31	my $dummy_val = dummy_val();
		32	is $dummy_val, undef, "context preserved"
		33	or diag("dummy val: $dummy_val");
		34	}
		35
		36	my $app = sub {
		37	return [
		38	200,
		39	[ 'Content-Type' => 'text/plain' ],
		40	[ make_response(dummy_val()) ]
		41	];
		42	};
		43	my $generic_url = "http://dummyhost.com/";
		44
		45	my $KOHA_CONF_XML = <<EOS;
		46	<yazgfs>
		47	<config>
		48	<kohasite>test</kohasite>
		49	<dummy>XML</dummy>
		50	<intrahtdocs>.</intrahtdocs>
		51	</config>
		52	</yazgfs>
		53	EOS
		54
		55	my @HOST_CONF = (
		56	{
		57	hostname => ['koha-file.com', 'www.koha-file.com'],
		58	app => $app,
		59	context => C4::Context->new("$Bin/conf/koha1/koha-conf.xml"),
		60	_dummy => "KOHA1"
		61	},
		62	{
		63	hostname => ['koha-xml.com', 'www.koha-xml.com'],
		64	app => $app,
65	context => C4::Context->new(\$KOHA_CONF_XML),
66	_dummy => "XML"
67	},
68	);
69	test_psgi
70	app => Koha::Handler::Plack->app_per_host(\@HOST_CONF),
71	client => sub {
72	my $cb = shift;
73
74	foreach my $site_params ( @HOST_CONF ) {
75	my $valid_response = make_response(
76	$site_params->{_dummy}
77	);
78	foreach (@{$site_params->{hostname}}) {
79	my $res = $cb->(GET "http://$_/");
80	is $res->content, $valid_response, $_
81	or diag(Dumper($site_params, $_, $res->as_string));
82	check_context();
83	}
84	}
85
86	$res = $cb->(GET $generic_url);
87	is $res->code, 404, "app_per_host unknown host"
88	or diag($res->as_string);
89	};
90
91	my %MULTI_HOST_ENV = (
92	opac => {
93	static_root => "$Bin/../koha-tmpl/opac-tmpl/bootstrap",
94	script_root => "$Bin/../opac",
95	},
96	intranet => {
97	static_root => "$Bin/../koha-tmpl/intranet-tmpl/bootstrap",
98	script_root => "$Bin/.."
99	}
100	);
101	my @MULTI_HOST_SITES = (
102	{
103	opac_hostname => ['opac.koha1.com', 'www.opac.koha1.com'],
104	intranet_hostname => ['intranet.koha1.com', 'www.intranet.koha1.com'],
105	config => "$Bin/conf/koha1/koha-conf.xml",
106	},
107	{
108	opac_hostname => ['opac.koha2.com', 'www.opac.koha2.com'],
109	intranet_hostname => ['intranet.koha2.com', 'www.intranet.koha2.com'],
110	config => "$Bin/conf/koha2/koha-conf.xml",
111	},
112	);
113	test_psgi
114	app => Koha::Handler::Plack::CGI->multi_site(\%MULTI_HOST_ENV, \@MULTI_HOST_SITES),
115	client => sub {
116	my $cb = shift;
117
118	foreach my $site (@MULTI_HOST_SITES) {
119	my $opac = $site->{opac_hostname};
120	foreach my $host (@$opac) {
121	# this is not really a test, but cannot do any better atm
122	# TODO: a complex test involving two database connections
123	my $res = $cb->(GET "http://$host/");
124	# A future implementation may not redirect
125	if ($res->is_redirect) {
126	my $loc = $res->header("Location");
127	$res = $cb->(GET "http://$host$loc");
128	}
129	is $res->code, 500, "multi_site() $host"
130	or diag($res->as_string);
131	}
132	}
133	};

Lines 51-60 is( C4::Context->preference('IDoNotExist'), 'NonExistent', 'Test creation of non Link Here

(-)a/t/db_dependent/sysprefs.t (-3 / +3 lines)
51		51
52	delete $ENV{OVERRIDE_SYSPREF_opacheader};	52	delete $ENV{OVERRIDE_SYSPREF_opacheader};
53		53
54	my $context1 = C4::Context->new();	54	my $DUMMY_KOHA_CONF = "<yazgfs><config>DUMMY</config></yazgfs>";
		55	my $context1 = C4::Context->new($DUMMY_KOHA_CONF);
55	is( $context1->preference('opacheader'), $opacheader, 'context1 "opacheader"');	56	is( $context1->preference('opacheader'), $opacheader, 'context1 "opacheader"');
56		57
57	my $context2 = C4::Context->new();	58	my $context2 = C4::Context->new($DUMMY_KOHA_CONF);
58	$context2->set_preference( 'opacheader', $newopacheader );	59	$context2->set_preference( 'opacheader', $newopacheader );
59	is( $context1->preference('opacheader'), $opacheader, 'context1 "opacheader"');	60	is( $context1->preference('opacheader'), $opacheader, 'context1 "opacheader"');
60	is( $context2->preference('opacheader'), $newopacheader, 'context2 "opacheader"');	61	is( $context2->preference('opacheader'), $newopacheader, 'context2 "opacheader"');
61	-