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

(-)a/C4/Auth_with_cas.pm (-1 / +1 lines)
Lines 37-43 BEGIN { Link Here
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";
(-)a/C4/Auth_with_ldap.pm (-1 / +1 lines)
Lines 54-60 sub ldapserver_error { Link Here
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');
(-)a/C4/Context.pm (-165 / +141 lines)
Lines 31-37 BEGIN { Link Here
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 = {};
357
    my $namespace = shift;
326
358
327
    # check that the specified config file exists and is not empty
359
    my $self = XMLin(
328
    undef $conf_fname unless 
360
        $conf_fname,
329
        (defined $conf_fname && -s $conf_fname);
361
        keyattr => ['id'],
330
    # Figure out a good config file to load if none was specified.
362
        forcearray => ['listen', 'server', 'serverinfo'],
331
    if (!defined($conf_fname))
363
        suppressempty => '',
332
    {
364
    );
333
        # If the $KOHA_CONF environment variable is set, use
365
    die "Invalid config ".(ref($conf_fname) ? $$conf_fname : $conf_fname).": ".Dumper($self)
334
        # that. Otherwise, use the built-in default.
366
      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
367
361
    $self->{"config_file"} = $conf_fname;
368
    $self->{"config_file"} = $conf_fname;
362
    warn "read_config_file($conf_fname) returned undef" if !defined($self->{"config"});
369
    $self->{"namespace"} = $namespace;
363
    return if !defined($self->{"config"});
364
370
365
    $self->{"Zconn"} = undef;    # Zebra Connections
371
    $self->{"Zconn"} = undef;    # Zebra Connections
366
    $self->{"marcfromkohafield"} = undef; # the hash with relations between koha table fields and MARC field/subfield
372
    $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
413
    # break this assumption by playing silly buggers, but that's
408
    # harder to do than doing it properly, and harder to check
414
    # harder to do than doing it properly, and harder to check
409
    # for.
415
    # for.
416
    my $schema;
410
    if (ref($self) eq "")
417
    if (ref($self) eq "")
411
    {
418
    {
412
        # Class method. The new context is the next argument.
419
        # Class method. The new context is the next argument.
413
        $new_context = shift;
420
        $new_context = shift or croak "No new context";
421
        $schema = Koha::Database->new_schema($new_context);
414
    } else {
422
    } else {
415
        # Instance method. The new context is $self.
423
        # Instance method. The new context is $self.
416
        $new_context = $self;
424
        $new_context = $self;
425
426
        # undef $self->{schema} if $self->{schema} && !$self->{schema}->ping
427
        $schema = $self->{schema} ||= Koha::Database->new_schema($self);
417
    }
428
    }
418
429
419
    # Save the old context, if any, on the stack
430
    # Save the old context, if any, on the stack
Lines 421-426 sub set_context Link Here
421
432
422
    # Set the new context
433
    # Set the new context
423
    $context = $new_context;
434
    $context = $new_context;
435
    Koha::Database->set_schema($schema);
424
}
436
}
425
437
426
=head2 restore_context
438
=head2 restore_context
Lines 436-454 sub restore_context Link Here
436
{
448
{
437
    my $self = shift;
449
    my $self = shift;
438
450
439
    if ($#context_stack < 0)
440
    {
441
        # Stack underflow.
442
        die "Context stack underflow";
443
    }
444
445
    # Pop the old context and set it.
451
    # Pop the old context and set it.
446
    $context = pop @context_stack;
452
    $context = pop @context_stack;
453
    Koha::Database->restore_schema();
447
454
448
    # FIXME - Should this return something, like maybe the context
455
    # FIXME - Should this return something, like maybe the context
449
    # that was current when this was called?
456
    # that was current when this was called?
450
}
457
}
451
458
459
=head2 run_within_context
460
461
  $context->run_within_context(sub {...});
462
463
Runs code within context
464
465
=cut
466
467
#'
468
sub run_within_context
469
{
470
    my $self = shift;
471
    my $code = shift or croak "No code";
472
473
    $self->set_context;
474
475
    local $@;
476
    my $ret = eval { $code->(@_) };
477
    my $died = $@;
478
    $self->restore_context;
479
    die $died if $died;
480
    return $ret;
481
}
482
452
=head2 config
483
=head2 config
453
484
454
  $value = C4::Context->config("config_variable");
485
  $value = C4::Context->config("config_variable");
Lines 465-490 C<C4::Config-E<gt>new> will not return it. Link Here
465
=cut
496
=cut
466
497
467
sub _common_config {
498
sub _common_config {
468
	my $var = shift;
499
    my $self = shift;
469
	my $term = shift;
500
    my $var = shift;
470
    return if !defined($context->{$term});
501
    my $term = shift;
502
503
    $self = $context unless ref $self;
504
    return if !defined($self->{$term});
471
       # Presumably $self->{$term} might be
505
       # Presumably $self->{$term} might be
472
       # undefined if the config file given to &new
506
       # undefined if the config file given to &new
473
       # didn't exist, and the caller didn't bother
507
       # didn't exist, and the caller didn't bother
474
       # to check the return value.
508
       # to check the return value.
475
509
476
    # Return the value of the requested config variable
510
    # Return the value of the requested config variable
477
    return $context->{$term}->{$var};
511
    return $self->{$term}->{$var};
478
}
512
}
479
513
480
sub config {
514
sub config {
481
	return _common_config($_[1],'config');
515
    my $self = shift;
516
    return $self->_common_config($_[0],'config');
482
}
517
}
483
sub zebraconfig {
518
sub zebraconfig {
484
	return _common_config($_[1],'server');
519
    my $self = shift;
520
    return $self->_common_config($_[0],'server');
485
}
521
}
486
sub ModZebrations {
522
sub ModZebrations {
487
	return _common_config($_[1],'serverinfo');
523
    my $self = shift;
524
    return $self->_common_config($_[0],'serverinfo');
488
}
525
}
489
526
490
=head2 preference
527
=head2 preference
Lines 517-524 sub preference { Link Here
517
554
518
    return $self->{sysprefs}{$lc_var} if $use_syspref_cache && $self && exists $self->{sysprefs}{$lc_var};
555
    return $self->{sysprefs}{$lc_var} if $use_syspref_cache && $self && exists $self->{sysprefs}{$lc_var};
519
556
520
    my $dbh  = C4::Context->dbh or return 0;
521
522
    my $value;
557
    my $value;
523
    if ( defined $ENV{"OVERRIDE_SYSPREF_$var"} ) {
558
    if ( defined $ENV{"OVERRIDE_SYSPREF_$var"} ) {
524
        $value = $ENV{"OVERRIDE_SYSPREF_$var"};
559
        $value = $ENV{"OVERRIDE_SYSPREF_$var"};
Lines 626-632 sub set_preference { Link Here
626
661
627
Returns a connection to the Zebra database
662
Returns a connection to the Zebra database
628
663
629
C<$self> 
664
C<$self>
630
665
631
C<$server> one of the servers defined in the koha-conf.xml file
666
C<$server> one of the servers defined in the koha-conf.xml file
632
667
Lines 737-744 creates one, and connects to the database. Link Here
737
772
738
This database handle is cached for future use: if you call
773
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
774
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
775
times. If you need a second database handle, use C<&new_dbh>.
741
possibly C<&set_dbh>.
742
776
743
=cut
777
=cut
744
778
Lines 777-840 sub new_dbh Link Here
777
    return &dbh({ new => 1 });
811
    return &dbh({ new => 1 });
778
}
812
}
779
813
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
814
=head2 queryparser
839
815
840
  $queryparser = C4::Context->queryparser
816
  $queryparser = C4::Context->queryparser
(-)a/Koha/Database.pm (-8 / +30 lines)
Lines 46-57 __PACKAGE__->mk_accessors(qw( )); Link Here
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.
(-)a/Koha/Handler/Plack.pm (+163 lines)
Line 0 Link Here
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
  koha.psgi:
83
84
  use Plack::Builder;
85
  use Plack::App::CGIBin;
86
87
  use C4::Context;
88
89
  my $opac_app = builder {
90
      enable "Plack::Middleware::Static",
91
              path => qr{^/opac-tmpl/}, root => '/usr/share/koha/opac/htdocs/';
92
93
      enable 'StackTrace';
94
      mount "/cgi-bin/koha" => Plack::App::CGIBin->new(root => "/usr/share/koha/opac/cgi-bin/opac");
95
  };
96
  my $intranet_app = builder {
97
      enable "Plack::Middleware::Static",
98
              path => qr{^/intranet-tmpl/}, root => '/usr/share/koha/intranet/htdocs/';
99
100
      enable 'StackTrace';
101
      mount "/cgi-bin/koha" => Plack::App::CGIBin->new(root => "/usr/share/koha/cgi-bin");
102
  };
103
104
  my @host_def;
105
106
  my $conf_file_1 = "/etc/koha/site-1/koha_conf.xml";
107
  my $context_1 = C4::Context->new($conf_file_1);
108
  push @host_def,
109
      {
110
          hostname => [ "public.host.for.site-1", "www.public.host.for.site-1" ],
111
          app => $opac_app,
112
          context => $context_1,
113
      },
114
      {
115
          hostname => "intranet.host.for.site-1",
116
          app => $intranet_app,
117
          context => $context_1,
118
      };
119
120
  my $conf_file_2 = "/etc/koha/site-1/koha_conf.xml";
121
  my $context_2 = C4::Context->new($conf_file_2);
122
  push @host_def,
123
      {
124
          hostname => "public.host.for.site-2",
125
          app => $opac_app,
126
          context => $context_2,
127
      },
128
      {
129
          hostname => "intranet.host.for.site-2",
130
          app => $intranet_app,
131
          context => $context_2,
132
      };
133
134
  ...
135
136
  Koha::Handler::Plack->app_per_host( \@host_def );
137
138
=cut
139
140
sub app_per_host {
141
    my $class = shift;
142
    my $sites = shift or die "No sites spec";
143
144
    my $builder = Plack::Builder->new;
145
    foreach my $site_params ( @$sites ) {
146
        my $hosts = $site_params->{hostname} or croak "No hostname";
147
        $hosts = [$hosts] unless ref $hosts;
148
149
        my $app = $site_params->{app} or croak "No app";
150
        my $context = $site_params->{context} or croak "No Koha Context";
151
152
        foreach my $host (@$hosts) {
153
            $builder->mount("http://$host/" => sub {
154
                my $env = shift;
155
156
                return $context->run_within_context(sub { $app->($env) });
157
            });
158
        }
159
    }
160
    return $builder->to_app;
161
}
162
163
1;
(-)a/Koha/Handler/Plack/CGI.pm (+228 lines)
Line 0 Link Here
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;
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
          namespace => 'koha1',
149
          opac_hostname => 'koha1-opac.com',
150
          intranet_hostname => 'koha1-intranet.com',
151
          config => '/etc/koha/sites/koha1/koha-conf.xml',
152
          shared_config => 1
153
      },
154
      {
155
          namespace => 'koha2',
156
          opac_hostname => ['opac.koha2.com', 'www.opackoha2.com'],
157
          intranet_hostname => ['intranet.koha2.com', 'www.intranetkoha2.com'],
158
          config => '/etc/koha/sites/koha2/koha-conf.xml'
159
      },
160
      ...
161
162
  koha.psgi:
163
164
  Koha::Handler::Plack::CGI->multi_site( \%koha_app_env, \@sites );
165
166
=cut
167
168
my $DUMMY_KOHA_CONF = "<yazgfs><config>DUMMY</config></yazgfs>";
169
sub multi_site {
170
    my $class = shift;
171
    my $env = shift or croak "No Koha env details";
172
    my $sites = shift or croak "No sites spec";
173
174
    my ($opac_app, $intranet_app);
175
176
    if (my $opac = $env->{opac}) {
177
        $opac_app = $class->app('opac', $opac);
178
    }
179
180
    if (my $intranet = $env->{intranet}) {
181
        $intranet_app = $class->app('intranet', $intranet);
182
    }
183
184
    my @host_def = map {
185
        my $namespace      = $_->{namespace} or croak "No namespace";
186
        my $config         = $_->{config}    or croak "Site without config";
187
        my $shared_context = $_->{shared_context};
188
189
        my $context = C4::Context->new($config, $namespace);
190
191
        my @hd;
192
        if (my $hostname = $_->{opac_hostname}) {
193
            croak "You have OPAC hosts without OPAC env details" unless $opac_app;
194
            push @hd, {
195
                hostname => $hostname,
196
                app => sub {
197
                    # XXX this may need some rethinking
198
                    local $ENV{KOHA_CONF} = \$DUMMY_KOHA_CONF;
199
                    local $ENV{MEMCACHED_NAMESPACE} = $namespace;
200
201
                    $opac_app->(@_);
202
                },
203
                context => $context,
204
                shared_context => $shared_context,
205
            };
206
        }
207
        if (my $hostname = $_->{intranet_hostname}) {
208
            croak "You have Intranet hosts without Intranet env details" unless $intranet_app;
209
            push @hd, {
210
                hostname => $hostname,
211
                app => sub {
212
                    # XXX this may need some rethinking
213
                    local $ENV{KOHA_CONF} = \$DUMMY_KOHA_CONF;
214
                    local $ENV{MEMCACHED_NAMESPACE} = $namespace;
215
216
                    $intranet_app->(@_);
217
                },
218
                context => $context,
219
                shared_context => $shared_context,
220
            };
221
        }
222
        @hd;
223
    } @$sites;
224
225
    return $class->app_per_host( \@host_def );
226
}
227
228
1;
(-)a/admin/systempreferences.pl (-1 / +1 lines)
Lines 422-428 output_html_with_http_headers $input, $cookie, $template->output; Link Here
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
(-)a/misc/plack/koha-multi.psgi (+29 lines)
Line 0 Link Here
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 );
(-)a/misc/translator/LangInstaller.pm (-1 / +1 lines)
Lines 56-62 sub new { Link Here
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';
(-)a/t/Context.t (+25 lines)
Lines 59-61 is(C4::Context->interface('foobar'), 'intranet'); Link Here
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
}
(-)a/t/Koha_Handler_Plack.t (+136 lines)
Line 0 Link Here
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;
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
        namespace => 'koha1',
104
        opac_hostname => ['opac.koha1.com', 'www.opac.koha1.com'],
105
        intranet_hostname => ['intranet.koha1.com', 'www.intranet.koha1.com'],
106
        config => "$Bin/conf/koha1/koha-conf.xml",
107
    },
108
    {
109
        namespace => 'koha2',
110
        opac_hostname => ['opac.koha2.com', 'www.opac.koha2.com'],
111
        intranet_hostname => ['intranet.koha2.com', 'www.intranet.koha2.com'],
112
        config => "$Bin/conf/koha2/koha-conf.xml",
113
        shared_context => 1,
114
    },
115
);
116
test_psgi
117
    app => Koha::Handler::Plack::CGI->multi_site(\%MULTI_HOST_ENV, \@MULTI_HOST_SITES),
118
    client => sub {
119
        my $cb  = shift;
120
121
        foreach my $site (@MULTI_HOST_SITES) {
122
            my $opac = $site->{opac_hostname};
123
            foreach my $host (@$opac) {
124
# this is not really a test, but cannot do any better atm
125
# TODO: a complex test involving two database connections
126
                my $res = $cb->(GET "http://$host/");
127
                # A future implementation may not redirect
128
                if ($res->is_redirect) {
129
                    my $loc = $res->header("Location");
130
                    $res = $cb->(GET "http://$host$loc");
131
                }
132
                is $res->code, 500, "multi_site() $host"
133
                  or diag($res->as_string);
134
            }
135
        }
136
    };
(-)a/t/conf/dummy/koha-conf.xml (+7 lines)
Line 0 Link Here
1
<yazgfs>
2
    <config>
3
        <kohasite>dummy</kohasite>
4
        <dummy>DUMMY</dummy>
5
        <intrahtdocs>.</intrahtdocs>
6
    </config>
7
</yazgfs>
(-)a/t/conf/koha1/koha-conf.xml (+7 lines)
Line 0 Link Here
1
<yazgfs>
2
    <config>
3
        <kohasite>koha1</kohasite>
4
        <dummy>KOHA1</dummy>
5
        <intrahtdocs>.</intrahtdocs>
6
    </config>
7
</yazgfs>
(-)a/t/conf/koha2/koha-conf.xml (+5 lines)
Line 0 Link Here
1
<yazgfs>
2
    <config>
3
        <dummy>KOHA2</dummy>
4
    </config>
5
</yazgfs>
(-)a/t/db_dependent/Amazon.t (-1 / +1 lines)
Lines 13-19 BEGIN { Link Here
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
(-)a/t/db_dependent/Context.t (-1 / +1 lines)
Lines 48-54 C4::Context->clear_syspref_cache(); Link Here
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)) { 
(-)a/t/db_dependent/Koha_template_plugin_KohaDates.t (-1 / +1 lines)
Lines 13-19 BEGIN { Link Here
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()");
(-)a/t/db_dependent/XISBN.t (-1 / +1 lines)
Lines 25-31 my $search_module = new Test::MockModule('C4::Search'); Link Here
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', '' );
(-)a/t/db_dependent/sysprefs.t (-3 / +3 lines)
Lines 51-60 is( C4::Context->preference('IDoNotExist'), 'NonExistent', 'Test creation of non Link Here
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
- 

Return to bug 15562