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

(-)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 (-152 / +131 lines)
Lines 32-38 BEGIN { Link Here
32
			    eval {C4::Context->dbh();};
32
			    eval {C4::Context->dbh();};
33
			    if ($@){
33
			    if ($@){
34
				$debug_level = 1;
34
				$debug_level = 1;
35
			    } 
35
			    }
36
			    else {
36
			    else {
37
				$debug_level =  C4::Context->preference("DebugLevel");
37
				$debug_level =  C4::Context->preference("DebugLevel");
38
			    }
38
			    }
Lines 50-56 BEGIN { Link Here
50
		# a little example table with various version info";
50
		# a little example table with various version info";
51
					print "
51
					print "
52
						<h1>Koha error</h1>
52
						<h1>Koha error</h1>
53
						<p>The following fatal error has occurred:</p> 
53
						<p>The following fatal error has occurred:</p>
54
                        <pre><code>$msg</code></pre>
54
                        <pre><code>$msg</code></pre>
55
						<table>
55
						<table>
56
						<tr><th>Apache</th><td>  $versions{apacheVersion}</td></tr>
56
						<tr><th>Apache</th><td>  $versions{apacheVersion}</td></tr>
Lines 64-74 BEGIN { Link Here
64
				} elsif ($debug_level eq "1"){
64
				} elsif ($debug_level eq "1"){
65
					print "
65
					print "
66
						<h1>Koha error</h1>
66
						<h1>Koha error</h1>
67
						<p>The following fatal error has occurred:</p> 
67
						<p>The following fatal error has occurred:</p>
68
                        <pre><code>$msg</code></pre>";
68
                        <pre><code>$msg</code></pre>";
69
				} else {
69
				} else {
70
					print "<p>production mode - trapped fatal error</p>";
70
					print "<p>production mode - trapped fatal error</p>";
71
				}       
71
				}
72
                print "</body></html>";
72
                print "</body></html>";
73
			}
73
			}
74
		#CGI::Carp::set_message(\&handle_errors);
74
		#CGI::Carp::set_message(\&handle_errors);
Lines 96-101 use Koha::Caches; Link Here
96
use POSIX ();
96
use POSIX ();
97
use DateTime::TimeZone;
97
use DateTime::TimeZone;
98
use Module::Load::Conditional qw(can_load);
98
use Module::Load::Conditional qw(can_load);
99
use Data::Dumper;
99
use Carp;
100
use Carp;
100
101
101
use C4::Boolean;
102
use C4::Boolean;
Lines 164-177 environment variable to the pathname of a configuration file to use. Link Here
164
#    file (/etc/koha/koha-conf.xml).
165
#    file (/etc/koha/koha-conf.xml).
165
# dbh
166
# dbh
166
#    A handle to the appropriate database for this context.
167
#    A handle to the appropriate database for this context.
167
# dbh_stack
168
#    Used by &set_dbh and &restore_dbh to hold other database
169
#    handles for this context.
170
# Zconn
171
#     A connection object for the Zebra server
168
#     A connection object for the Zebra server
172
169
173
$context = undef;        # Initially, no context is set
170
@context_stack = ();     # Initially, no saved contexts
174
@context_stack = ();        # Initially, no saved contexts
171
172
=head2 current
173
174
Returns the current context
175
176
=cut
177
178
sub current {
179
    return $context;
180
}
181
182
sub db_driver {
183
    my $self = shift;
184
185
    $self = $context unless ref ($self);
186
    return unless $self;
187
188
    return $self->{db_driver};
189
}
175
190
176
=head2 db_scheme2dbi
191
=head2 db_scheme2dbi
177
192
Lines 193-224 sub import { Link Here
193
    # Create the default context ($C4::Context::Context)
208
    # Create the default context ($C4::Context::Context)
194
    # the first time the module is called
209
    # the first time the module is called
195
    # (a config file can be optionaly passed)
210
    # (a config file can be optionaly passed)
211
    # If ":no_config" is passed, no config load will be attempted
212
    # It saves the context values in the declared memcached server(s)
213
    # if currently available and uses those values until them expire and
214
    # re-reads them.
215
216
    my ($pkg,$config_file) = @_;
196
217
197
    # default context already exists?
218
    # default context already exists?
198
    return if $context;
219
    return if $context;
199
220
200
    # no ? so load it!
221
    # multihost, we don't want/have one default config
201
    my ($pkg,$config_file) = @_ ;
222
    return if $config_file && $config_file eq ":no_config";
202
    my $new_ctx = __PACKAGE__->new($config_file);
203
    return unless $new_ctx;
204
223
205
    # if successfully loaded, use it by default
224
    my $conf_cache = Koha::Caches->get_instance('config');
206
    $new_ctx->set_context;
225
    if ( $conf_cache->cache ) {
207
    1;
226
        if ( $context = $conf_cache->get_from_cache('koha_conf') ) {
227
            return;
228
        }
229
    }
230
231
    undef $config_file if $config_file && !-s $config_file;
232
    $config_file ||= Koha::Config->guess_koha_conf();
233
    $context = __PACKAGE__->new($config_file);
234
    return unless $context;
235
236
    if ( $conf_cache->memcached_cache ) {
237
        # FIXME it may be better to use the memcached servers from the config file
238
        # to cache it
239
        $conf_cache->set_in_cache('koha_conf', $context)
240
    }
208
}
241
}
209
242
210
=head2 new
243
=head2 new
211
244
212
  $context = new C4::Context;
213
  $context = new C4::Context("/path/to/koha-conf.xml");
245
  $context = new C4::Context("/path/to/koha-conf.xml");
214
246
215
Allocates a new context. Initializes the context from the specified
247
Allocates a new context. Initializes the context from the specified
216
file, which defaults to either the file given by the C<$KOHA_CONF>
248
file.
217
environment variable, or F</etc/koha/koha-conf.xml>.
218
219
It saves the koha-conf.xml values in the declared memcached server(s)
220
if currently available and uses those values until them expire and
221
re-reads them.
222
249
223
C<&new> does not set this context as the new default context; for
250
C<&new> does not set this context as the new default context; for
224
that, use C<&set_context>.
251
that, use C<&set_context>.
Lines 230-267 that, use C<&set_context>. Link Here
230
# 2004-08-10 A. Tarallo: Added check if the conf file is not empty
257
# 2004-08-10 A. Tarallo: Added check if the conf file is not empty
231
sub new {
258
sub new {
232
    my $class = shift;
259
    my $class = shift;
233
    my $conf_fname = shift;        # Config file to load
260
    my $conf_fname = shift or croak "No conf";
234
    my $self = {};
261
    my $namespace = shift;
235
236
    # check that the specified config file exists and is not empty
237
    undef $conf_fname unless 
238
        (defined $conf_fname && -s $conf_fname);
239
    # Figure out a good config file to load if none was specified.
240
    unless ( defined $conf_fname ) {
241
        $conf_fname = Koha::Config->guess_koha_conf;
242
        unless ( $conf_fname ) {
243
            warn "unable to locate Koha configuration file koha-conf.xml";
244
            return;
245
        }
246
    }
247
262
248
    my $conf_cache = Koha::Caches->get_instance('config');
263
    my $self = Koha::Config->read_from_file($conf_fname);
249
    my $config_from_cache;
264
    die "Invalid config ".(ref($conf_fname) ? $$conf_fname : $conf_fname).": ".Dumper($self)
250
    if ( $conf_cache->cache ) {
265
      unless ref($self) && $self->{"config"};
251
        $self = $conf_cache->get_from_cache('koha_conf');
266
252
    }
267
    $self->{config_file} = $conf_fname;
253
    unless ( $self and %$self ) {
268
    $self->{namespace} = $namespace;
254
        $self = Koha::Config->read_from_file($conf_fname);
269
    $self->{use_syspref_cache} = 1;
255
        if ( $conf_cache->memcached_cache ) {
270
    $self->{syspref_cache} = Koha::Caches->get_instance('syspref', $namespace);
256
            # FIXME it may be better to use the memcached servers from the config file
257
            # to cache it
258
            $conf_cache->set_in_cache('koha_conf', $self)
259
        }
260
    }
261
    unless ( exists $self->{config} or defined $self->{config} ) {
262
        warn "The config file ($conf_fname) has not been parsed correctly";
263
        return;
264
    }
265
271
266
    $self->{"Zconn"} = undef;    # Zebra Connections
272
    $self->{"Zconn"} = undef;    # Zebra Connections
267
    $self->{"userenv"} = undef;        # User env
273
    $self->{"userenv"} = undef;        # User env
Lines 276-282 sub new { Link Here
276
282
277
=head2 set_context
283
=head2 set_context
278
284
279
  $context = new C4::Context;
280
  $context->set_context();
285
  $context->set_context();
281
or
286
or
282
  set_context C4::Context $context;
287
  set_context C4::Context $context;
Lines 309-325 sub set_context Link Here
309
    if (ref($self) eq "")
314
    if (ref($self) eq "")
310
    {
315
    {
311
        # Class method. The new context is the next argument.
316
        # Class method. The new context is the next argument.
312
        $new_context = shift;
317
        $new_context = shift or croak "No new context";
313
    } else {
318
    } else {
314
        # Instance method. The new context is $self.
319
        # Instance method. The new context is $self.
315
        $new_context = $self;
320
        $new_context = $self;
316
    }
321
    }
317
322
318
    # Save the old context, if any, on the stack
323
    # undef $new_context->{schema} if $new_context->{schema} && !$new_context->{schema}->ping
319
    push @context_stack, $context if defined($context);
324
    my $schema = $new_context->{schema} ||= Koha::Database->new_schema($new_context);
325
326
    # Save the old context on the stack
327
    push @context_stack, $context;
320
328
321
    # Set the new context
329
    # Set the new context
322
    $context = $new_context;
330
    $context = $new_context;
331
    Koha::Database->set_schema($schema);
323
}
332
}
324
333
325
=head2 restore_context
334
=head2 restore_context
Lines 335-353 sub restore_context Link Here
335
{
344
{
336
    my $self = shift;
345
    my $self = shift;
337
346
338
    if ($#context_stack < 0)
339
    {
340
        # Stack underflow.
341
        die "Context stack underflow";
342
    }
343
344
    # Pop the old context and set it.
347
    # Pop the old context and set it.
345
    $context = pop @context_stack;
348
    $context = pop @context_stack;
349
    Koha::Database->restore_schema();
346
350
347
    # FIXME - Should this return something, like maybe the context
351
    # FIXME - Should this return something, like maybe the context
348
    # that was current when this was called?
352
    # that was current when this was called?
349
}
353
}
350
354
355
=head2 run_within_context
356
357
  $context->run_within_context(sub {...});
358
359
Runs code within context
360
361
=cut
362
363
#'
364
sub run_within_context
365
{
366
    my $self = shift;
367
    my $code = shift or croak "No code";
368
369
    $self->set_context;
370
371
    local $@;
372
    my $ret = eval { $code->(@_) };
373
    my $died = $@;
374
    $self->restore_context;
375
    die $died if $died;
376
    return $ret;
377
}
378
351
=head2 config
379
=head2 config
352
380
353
  $value = C4::Context->config("config_variable");
381
  $value = C4::Context->config("config_variable");
Lines 364-389 C<C4::Config-E<gt>new> will not return it. Link Here
364
=cut
392
=cut
365
393
366
sub _common_config {
394
sub _common_config {
367
	my $var = shift;
395
    my $self = shift;
368
	my $term = shift;
396
    my $var = shift;
369
    return if !defined($context->{$term});
397
    my $term = shift;
398
399
    $self = $context unless ref $self;
400
    return if !defined($self->{$term});
370
       # Presumably $self->{$term} might be
401
       # Presumably $self->{$term} might be
371
       # undefined if the config file given to &new
402
       # undefined if the config file given to &new
372
       # didn't exist, and the caller didn't bother
403
       # didn't exist, and the caller didn't bother
373
       # to check the return value.
404
       # to check the return value.
374
405
375
    # Return the value of the requested config variable
406
    # Return the value of the requested config variable
376
    return $context->{$term}->{$var};
407
    return $self->{$term}->{$var};
377
}
408
}
378
409
379
sub config {
410
sub config {
380
	return _common_config($_[1],'config');
411
    my $self = shift;
412
    return $self->_common_config($_[0],'config');
381
}
413
}
382
sub zebraconfig {
414
sub zebraconfig {
383
	return _common_config($_[1],'server');
415
    my $self = shift;
416
    return $self->_common_config($_[0],'server');
384
}
417
}
385
sub ModZebrations {
418
sub ModZebrations {
386
	return _common_config($_[1],'serverinfo');
419
    my $self = shift;
420
    return $self->_common_config($_[0],'serverinfo');
387
}
421
}
388
422
389
=head2 preference
423
=head2 preference
Lines 402-430 with this method. Link Here
402
436
403
=cut
437
=cut
404
438
405
my $syspref_cache = Koha::Caches->get_instance('syspref');
406
my $use_syspref_cache = 1;
407
sub preference {
439
sub preference {
408
    my $self = shift;
440
    my $self = shift;
441
    $self = $context unless ref $self;
409
    my $var  = shift;    # The system preference to return
442
    my $var  = shift;    # The system preference to return
410
443
444
    $var = lc $var;
445
411
    return $ENV{"OVERRIDE_SYSPREF_$var"}
446
    return $ENV{"OVERRIDE_SYSPREF_$var"}
412
        if defined $ENV{"OVERRIDE_SYSPREF_$var"};
447
        if defined $ENV{"OVERRIDE_SYSPREF_$var"};
413
448
414
    $var = lc $var;
449
    my $cached_var = $self->{use_syspref_cache}
415
450
        ? $self->{syspref_cache}->get_from_cache("syspref_$var")
416
    if ($use_syspref_cache) {
451
        : undef;
417
        $syspref_cache = Koha::Caches->get_instance('syspref') unless $syspref_cache;
452
    return $cached_var if defined $cached_var;
418
        my $cached_var = $syspref_cache->get_from_cache("syspref_$var");
419
        return $cached_var if defined $cached_var;
420
    }
421
453
422
    my $syspref;
454
    my $syspref;
423
    eval { $syspref = Koha::Config::SysPrefs->find( lc $var ) };
455
    eval { $syspref = Koha::Config::SysPrefs->find( lc $var ) };
424
    my $value = $syspref ? $syspref->value() : undef;
456
    my $value = $syspref ? $syspref->value() : undef;
425
457
426
    if ( $use_syspref_cache ) {
458
    if ( $self->{use_syspref_cache} ) {
427
        $syspref_cache->set_in_cache("syspref_$var", $value);
459
        $self->{syspref_cache}->set_in_cache("syspref_$var", $value);
428
    }
460
    }
429
    return $value;
461
    return $value;
430
}
462
}
Lines 447-453 default behavior. Link Here
447
479
448
sub enable_syspref_cache {
480
sub enable_syspref_cache {
449
    my ($self) = @_;
481
    my ($self) = @_;
450
    $use_syspref_cache = 1;
482
    $self = $context unless ref $self;
483
    $self->{use_syspref_cache} = 1;
451
    # We need to clear the cache to have it up-to-date
484
    # We need to clear the cache to have it up-to-date
452
    $self->clear_syspref_cache();
485
    $self->clear_syspref_cache();
453
}
486
}
Lines 463-469 used with Plack and other persistent environments. Link Here
463
496
464
sub disable_syspref_cache {
497
sub disable_syspref_cache {
465
    my ($self) = @_;
498
    my ($self) = @_;
466
    $use_syspref_cache = 0;
499
    $self = $context unless ref $self;
500
    $self->{use_syspref_cache} = 0;
467
    $self->clear_syspref_cache();
501
    $self->clear_syspref_cache();
468
}
502
}
469
503
Lines 478-485 will not be seen by this process. Link Here
478
=cut
512
=cut
479
513
480
sub clear_syspref_cache {
514
sub clear_syspref_cache {
481
    return unless $use_syspref_cache;
515
    my ($self) = @_;
482
    $syspref_cache->flush_all;
516
    $self = $context unless ref $self;
517
    return unless $self->{use_syspref_cache};
518
    $self->{syspref_cache}->flush_all;
483
}
519
}
484
520
485
=head2 set_preference
521
=head2 set_preference
Lines 495-500 preference. Link Here
495
531
496
sub set_preference {
532
sub set_preference {
497
    my ( $self, $variable, $value, $explanation, $type, $options ) = @_;
533
    my ( $self, $variable, $value, $explanation, $type, $options ) = @_;
534
    $self = $context unless ref $self;
498
535
499
    $variable = lc $variable;
536
    $variable = lc $variable;
500
537
Lines 530-537 sub set_preference { Link Here
530
        )->store();
567
        )->store();
531
    }
568
    }
532
569
533
    if ( $use_syspref_cache ) {
570
    if ( $self->{use_syspref_cache} ) {
534
        $syspref_cache->set_in_cache( "syspref_$variable", $value );
571
        $self->{syspref_cache}->set_in_cache( "syspref_$variable", $value );
535
    }
572
    }
536
573
537
    return $syspref;
574
    return $syspref;
Lines 549-558 was no syspref of the name. Link Here
549
586
550
sub delete_preference {
587
sub delete_preference {
551
    my ( $self, $var ) = @_;
588
    my ( $self, $var ) = @_;
589
    $self = $context unless ref $self;
552
590
553
    if ( Koha::Config::SysPrefs->find( $var )->delete ) {
591
    if ( Koha::Config::SysPrefs->find( $var )->delete ) {
554
        if ( $use_syspref_cache ) {
592
        if ( $self->{use_syspref_cache} ) {
555
            $syspref_cache->clear_from_cache("syspref_$var");
593
            $self->{syspref_cache}->clear_from_cache("syspref_$var");
556
        }
594
        }
557
595
558
        return 1;
596
        return 1;
Lines 566-572 sub delete_preference { Link Here
566
604
567
Returns a connection to the Zebra database
605
Returns a connection to the Zebra database
568
606
569
C<$self> 
607
C<$self>
570
608
571
C<$server> one of the servers defined in the koha-conf.xml file
609
C<$server> one of the servers defined in the koha-conf.xml file
572
610
Lines 677-684 creates one, and connects to the database. Link Here
677
715
678
This database handle is cached for future use: if you call
716
This database handle is cached for future use: if you call
679
C<C4::Context-E<gt>dbh> twice, you will get the same handle both
717
C<C4::Context-E<gt>dbh> twice, you will get the same handle both
680
times. If you need a second database handle, use C<&new_dbh> and
718
times. If you need a second database handle, use C<&new_dbh>.
681
possibly C<&set_dbh>.
682
719
683
=cut
720
=cut
684
721
Lines 717-780 sub new_dbh Link Here
717
    return &dbh({ new => 1 });
754
    return &dbh({ new => 1 });
718
}
755
}
719
756
720
=head2 set_dbh
721
722
  $my_dbh = C4::Connect->new_dbh;
723
  C4::Connect->set_dbh($my_dbh);
724
  ...
725
  C4::Connect->restore_dbh;
726
727
C<&set_dbh> and C<&restore_dbh> work in a manner analogous to
728
C<&set_context> and C<&restore_context>.
729
730
C<&set_dbh> saves the current database handle on a stack, then sets
731
the current database handle to C<$my_dbh>.
732
733
C<$my_dbh> is assumed to be a good database handle.
734
735
=cut
736
737
#'
738
sub set_dbh
739
{
740
    my $self = shift;
741
    my $new_dbh = shift;
742
743
    # Save the current database handle on the handle stack.
744
    # We assume that $new_dbh is all good: if the caller wants to
745
    # screw himself by passing an invalid handle, that's fine by
746
    # us.
747
    push @{$context->{"dbh_stack"}}, $context->{"dbh"};
748
    $context->{"dbh"} = $new_dbh;
749
}
750
751
=head2 restore_dbh
752
753
  C4::Context->restore_dbh;
754
755
Restores the database handle saved by an earlier call to
756
C<C4::Context-E<gt>set_dbh>.
757
758
=cut
759
760
#'
761
sub restore_dbh
762
{
763
    my $self = shift;
764
765
    if ($#{$context->{"dbh_stack"}} < 0)
766
    {
767
        # Stack underflow
768
        die "DBH stack underflow";
769
    }
770
771
    # Pop the old database handle and set it.
772
    $context->{"dbh"} = pop @{$context->{"dbh_stack"}};
773
774
    # FIXME - If it is determined that restore_context should
775
    # return something, then this function should, too.
776
}
777
778
=head2 queryparser
757
=head2 queryparser
779
758
780
  $queryparser = C4::Context->queryparser
759
  $queryparser = C4::Context->queryparser
(-)a/Koha/Caches.pm (-5 / +8 lines)
Lines 46-56 persistent across multiple instances. Link Here
46
=cut
46
=cut
47
47
48
sub get_instance {
48
sub get_instance {
49
    my ($class, $subnamespace) = @_;
49
    my ($class, $subnamespace, $namespace) = @_;
50
    $subnamespace //= '';
50
    $subnamespace //= '';
51
    $singleton_caches->{$subnamespace} = Koha::Cache->new({}, { subnamespace => $subnamespace } )
51
    $namespace //= '';
52
        unless $singleton_caches->{$subnamespace};
52
    return $singleton_caches->{$namespace}{$subnamespace}
53
    return $singleton_caches->{$subnamespace};
53
      ||= Koha::Cache->new({ namespace => $namespace }, { subnamespace => $subnamespace });
54
}
54
}
55
55
56
=head2 flush_L1_caches
56
=head2 flush_L1_caches
Lines 58-65 sub get_instance { Link Here
58
=cut
58
=cut
59
59
60
sub flush_L1_caches {
60
sub flush_L1_caches {
61
    my ($class, $subnamespace, $namespace) = @_;
62
    $namespace //= '';
63
61
    return unless $singleton_caches;
64
    return unless $singleton_caches;
62
    for my $cache ( values %$singleton_caches ) {
65
    for my $cache ( values %{$singleton_caches->{$namespace}} ) {
63
        $cache->flush_L1_cache;
66
        $cache->flush_L1_cache;
64
    }
67
    }
65
}
68
}
(-)a/Koha/Database.pm (-8 / +30 lines)
Lines 47-56 __PACKAGE__->mk_accessors(qw( )); Link Here
47
# database connection from the data given in the current context, and
47
# database connection from the data given in the current context, and
48
# returns it.
48
# returns it.
49
sub _new_schema {
49
sub _new_schema {
50
    my $context = shift || C4::Context->current();
50
51
51
    my $context = C4::Context->new();
52
    my $db_driver = $context->db_driver;
52
53
    my $db_driver = $context->{db_driver};
54
53
55
    my $db_name   = $context->config("database");
54
    my $db_name   = $context->config("database");
56
    my $db_host   = $context->config("hostname");
55
    my $db_host   = $context->config("hostname");
Lines 136-151 sub schema { Link Here
136
        return $database->{schema} if defined $database->{schema};
135
        return $database->{schema} if defined $database->{schema};
137
    }
136
    }
138
137
139
    $database->{schema} = &_new_schema();
138
    $database->{schema} = &_new_schema($params->{context});
140
    return $database->{schema};
139
    return $database->{schema};
141
}
140
}
142
141
143
=head2 new_schema
142
=head2 new_schema
144
143
145
  $schema = $database->new_schema;
144
  $schema = $database->new_schema($context);
146
145
147
Creates a new connection to the Koha database for the current context,
146
Creates a new connection to the Koha database for the context
148
and returns the database handle (a C<DBI::db> object).
147
(current is default), and returns the database handle (a C<DBI::db> object).
149
148
150
The handle is not saved anywhere: this method is strictly a
149
The handle is not saved anywhere: this method is strictly a
151
convenience function; the point is that it knows which database to
150
convenience function; the point is that it knows which database to
Lines 157-163 connect to so that the caller doesn't have to know. Link Here
157
sub new_schema {
156
sub new_schema {
158
    my $self = shift;
157
    my $self = shift;
159
158
160
    return &_new_schema();
159
    return &_new_schema(@_);
161
}
160
}
162
161
163
=head2 set_schema
162
=head2 set_schema
Lines 231-236 sub flush_schema_cache { Link Here
231
    return 1;
230
    return 1;
232
}
231
}
233
232
233
=head2 run_with_schema
234
235
  $database->run_with_schema( $schema, sub {...} );
236
237
Restores the database handle saved by an earlier call to
238
C<$database-E<gt>set_schema> C<$database-E<gt>restore_schema> wrapper.
239
240
=cut
241
242
sub run_with_schema {
243
    my $self = shift;
244
    my $schema = shift or croak "No schema";
245
    my $code = shift or croak "No sub";
246
247
    $self->set_schema;
248
    local $@;
249
    my $ret = eval { $code->(@_) };
250
    my $died = $@;
251
    $self->restore_schema;
252
    die $died if $died;
253
    return $ret;
254
}
255
234
=head2 EXPORT
256
=head2 EXPORT
235
257
236
None by default.
258
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::App::URLMap;
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 $map = Plack::App::URLMap->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
            $map->map("http://$host/" => sub {
154
                my $env = shift;
155
156
                return $context->run_within_context(sub { $app->($env) });
157
            });
158
        }
159
    }
160
    return $map->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/about.pl (-1 / +1 lines)
Lines 131-137 my $warnNoActiveCurrency = (! defined Koha::Acquisition::Currencies->get_active) Link Here
131
131
132
my @xml_config_warnings;
132
my @xml_config_warnings;
133
133
134
my $context = new C4::Context;
134
my $context = C4::Context->current;
135
135
136
if ( ! defined C4::Context->config('zebra_bib_index_mode') ) {
136
if ( ! defined C4::Context->config('zebra_bib_index_mode') ) {
137
    push @xml_config_warnings, {
137
    push @xml_config_warnings, {
(-)a/admin/systempreferences.pl (-1 / +1 lines)
Lines 387-393 output_html_with_http_headers $input, $cookie, $template->output; Link Here
387
# .pref files.
387
# .pref files.
388
388
389
sub get_prefs_from_files {
389
sub get_prefs_from_files {
390
    my $context       = C4::Context->new();
390
    my $context       = C4::Context->current();
391
    my $path_pref_en  = $context->config('intrahtdocs') .
391
    my $path_pref_en  = $context->config('intrahtdocs') .
392
                        '/prog/en/modules/admin/preferences';
392
                        '/prog/en/modules/admin/preferences';
393
    # Get all .pref file names
393
    # Get all .pref file names
(-)a/misc/cronjobs/check-url.pl (-1 / +1 lines)
Lines 190-196 sub check_all_url { Link Here
190
    my $checker = C4::URL::Checker->new($timeout,$agent);
190
    my $checker = C4::URL::Checker->new($timeout,$agent);
191
    $checker->{ host_default }  = $host;
191
    $checker->{ host_default }  = $host;
192
    
192
    
193
    my $context = new C4::Context(  );  
193
    my $context = C4::Context->current();
194
    my $dbh = $context->dbh;
194
    my $dbh = $context->dbh;
195
    my $sth = $dbh->prepare( 
195
    my $sth = $dbh->prepare( 
196
        "SELECT biblionumber FROM biblioitems WHERE url <> ''" );
196
        "SELECT biblionumber FROM biblioitems WHERE url <> ''" );
(-)a/misc/plack/koha-multi.psgi (+34 lines)
Line 0 Link Here
1
#!/usr/bin/perl
2
3
use Koha::Handler::Plack::CGI;
4
5
# If modules are not in a standard location
6
# use lib '/usr/share/koha/lib' or set PERL5LIB or plackup -I
7
8
# This is a minimal example. You can include all frills from koha.psgi
9
# To try it:
10
# plackup --port 5010 koha-multi.psgi
11
12
my %KOHA_ENV = (
13
  opac => {
14
      static_root => '/usr/share/koha/opac/htdocs',
15
      script_root => '/usr/share/koha/opac/cgi-bin/opac',
16
      pugins => [
17
	# don't enable this plugin in production, since stack traces reveal too much information
18
	# about system to potential attackers!
19
          [ 'StackTrace' ],
20
      ],
21
  },
22
  intranet => {
23
      static_root => '/usr/share/koha/intranet/htdocs',
24
      script_root => '/usr/share/koha/intranet/cgi-bin',
25
  }
26
);
27
my @SITES = map {
28
    namespace => $_,
29
    opac_hostname => "opac.$_.my-koha-multisite.net",
30
    intranet_hostname => "intranet.$_.my-koha-multisite.net",
31
    config => "/etc/koha/sites/$_/koha-conf.xml"
32
}, qw(koha1 koha2 koha3);
33
34
Koha::Handler::Plack::CGI->multi_site( \%KOHA_ENV, \@SITES );
(-)a/misc/translator/LangInstaller.pm (-2 / +2 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';
Lines 140-146 sub new { Link Here
140
sub po_filename {
140
sub po_filename {
141
    my $self = shift;
141
    my $self = shift;
142
142
143
    my $context    = C4::Context->new;
143
    my $context    = C4::Context->current();
144
    my $trans_path = $Bin . '/po';
144
    my $trans_path = $Bin . '/po';
145
    my $trans_file = "$trans_path/" . $self->{lang} . "-pref.po";
145
    my $trans_file = "$trans_path/" . $self->{lang} . "-pref.po";
146
    return $trans_file;
146
    return $trans_file;
(-)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 14-20 BEGIN { Link Here
14
    use_ok('C4::External::Amazon');
14
    use_ok('C4::External::Amazon');
15
}
15
}
16
16
17
my $context = C4::Context->new();
17
my $context = C4::Context->current();
18
18
19
my $locale = $context->preference('AmazonLocale');
19
my $locale = $context->preference('AmazonLocale');
20
20
(-)a/t/db_dependent/Context.t (-1 / +1 lines)
Lines 51-57 C4::Context->clear_syspref_cache(); Link Here
51
C4::Context->enable_syspref_cache();
51
C4::Context->enable_syspref_cache();
52
$dbh->rollback;
52
$dbh->rollback;
53
53
54
ok($koha = C4::Context->new,  'C4::Context->new');
54
ok($koha = C4::Context->current,  'C4::Context->current');
55
my @keys = keys %$koha;
55
my @keys = keys %$koha;
56
my $width = 0;
56
my $width = 0;
57
if (ok(@keys)) { 
57
if (ok(@keys)) { 
(-)a/t/db_dependent/Template/Plugin/KohaDates.t (-1 / +1 lines)
Lines 14-20 BEGIN { Link Here
14
my $module_context = new Test::MockModule('C4::Context');
14
my $module_context = new Test::MockModule('C4::Context');
15
15
16
my $date = "1973-05-21";
16
my $date = "1973-05-21";
17
my $context = C4::Context->new();
17
my $context = C4::Context->current();
18
18
19
my $filter = Koha::Template::Plugin::KohaDates->new();
19
my $filter = Koha::Template::Plugin::KohaDates->new();
20
ok ($filter, "new()");
20
ok ($filter, "new()");
(-)a/t/db_dependent/XISBN.t (-1 / +1 lines)
Lines 26-32 my $search_module = new Test::MockModule('C4::Search'); Link Here
26
26
27
$search_module->mock('SimpleSearch', \&Mock_SimpleSearch );
27
$search_module->mock('SimpleSearch', \&Mock_SimpleSearch );
28
28
29
my $context = C4::Context->new;
29
my $context = C4::Context->current;
30
30
31
my ( $biblionumber_tag, $biblionumber_subfield ) =
31
my ( $biblionumber_tag, $biblionumber_subfield ) =
32
  GetMarcFromKohaField( 'biblio.biblionumber', '' );
32
  GetMarcFromKohaField( 'biblio.biblionumber', '' );
(-)a/t/db_dependent/sysprefs.t (-2 / +12 lines)
Lines 19-25 Link Here
19
# along with Koha; if not, see <http://www.gnu.org/licenses>.
19
# along with Koha; if not, see <http://www.gnu.org/licenses>.
20
20
21
use Modern::Perl;
21
use Modern::Perl;
22
use Test::More tests => 8;
22
use Test::More tests => 11;
23
use C4::Context;
23
use C4::Context;
24
24
25
# Start transaction
25
# Start transaction
Lines 60-63 is(C4::Context->preference('testpreference'), 'def', 'caching preferences'); Link Here
60
C4::Context->clear_syspref_cache();
60
C4::Context->clear_syspref_cache();
61
is(C4::Context->preference('testpreference'), undef, 'clearing preference cache');
61
is(C4::Context->preference('testpreference'), undef, 'clearing preference cache');
62
62
63
delete $ENV{OVERRIDE_SYSPREF_opacheader};
64
65
my $DUMMY_KOHA_CONF = "<yazgfs><config><dummy>DUMMY</dummy></config></yazgfs>";
66
my $context1 = C4::Context->new($DUMMY_KOHA_CONF, "context1");
67
is( $context1->preference('opacheader'), $opacheader, 'context1 "opacheader"');
68
69
my $context2 = C4::Context->new($DUMMY_KOHA_CONF, "context2");
70
$context2->set_preference( 'opacheader', $newopacheader );
71
is( $context1->preference('opacheader'), $opacheader, 'context1 "opacheader"');
72
is( $context2->preference('opacheader'), $newopacheader, 'context2 "opacheader"');
73
63
$dbh->rollback;
74
$dbh->rollback;
64
- 

Return to bug 15562