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 (-147 / +127 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 95-100 use Koha::Caches; Link Here
95
use POSIX ();
95
use POSIX ();
96
use DateTime::TimeZone;
96
use DateTime::TimeZone;
97
use Module::Load::Conditional qw(can_load);
97
use Module::Load::Conditional qw(can_load);
98
use Data::Dumper;
98
use Carp;
99
use Carp;
99
100
100
use C4::Boolean;
101
use C4::Boolean;
Lines 163-176 environment variable to the pathname of a configuration file to use. Link Here
163
#    file (/etc/koha/koha-conf.xml).
164
#    file (/etc/koha/koha-conf.xml).
164
# dbh
165
# dbh
165
#    A handle to the appropriate database for this context.
166
#    A handle to the appropriate database for this context.
166
# dbh_stack
167
#    Used by &set_dbh and &restore_dbh to hold other database
168
#    handles for this context.
169
# Zconn
170
#     A connection object for the Zebra server
167
#     A connection object for the Zebra server
171
168
172
$context = undef;        # Initially, no context is set
169
@context_stack = ();     # Initially, no saved contexts
173
@context_stack = ();        # Initially, no saved contexts
170
171
=head2 current
172
173
Returns the current context
174
175
=cut
176
177
sub current {
178
    return $context;
179
}
180
181
sub db_driver {
182
    my $self = shift;
183
184
    $self = $context unless ref ($self);
185
    return unless $self;
186
187
    return $self->{db_driver};
188
}
174
189
175
=head2 db_scheme2dbi
190
=head2 db_scheme2dbi
176
191
Lines 192-223 sub import { Link Here
192
    # Create the default context ($C4::Context::Context)
207
    # Create the default context ($C4::Context::Context)
193
    # the first time the module is called
208
    # the first time the module is called
194
    # (a config file can be optionaly passed)
209
    # (a config file can be optionaly passed)
210
    # If ":no_config" is passed, no config load will be attempted
211
    # It saves the context values in the declared memcached server(s)
212
    # if currently available and uses those values until them expire and
213
    # re-reads them.
214
215
    my ($pkg,$config_file) = @_;
195
216
196
    # default context already exists?
217
    # default context already exists?
197
    return if $context;
218
    return if $context;
198
219
199
    # no ? so load it!
220
    # multihost, we don't want/have one default config
200
    my ($pkg,$config_file) = @_ ;
221
    return if $config_file && $config_file eq ":no_config";
201
    my $new_ctx = __PACKAGE__->new($config_file);
222
202
    return unless $new_ctx;
223
    my $conf_cache = Koha::Caches->get_instance('config');
224
    if ( $conf_cache->cache ) {
225
        if ( $context = $conf_cache->get_from_cache('koha_conf') ) {
226
            return;
227
        }
228
    }
229
230
    undef $config_file if $config_file && !-s $config_file;
231
    $config_file ||= Koha::Config->guess_koha_conf();
232
    $context = __PACKAGE__->new($config_file);
233
    return unless $context;
203
234
204
    # if successfully loaded, use it by default
235
    if ( $conf_cache->memcached_cache ) {
205
    $new_ctx->set_context;
236
        # FIXME it may be better to use the memcached servers from the config file
206
    1;
237
        # to cache it
238
        $conf_cache->set_in_cache('koha_conf', $context)
239
    }
207
}
240
}
208
241
209
=head2 new
242
=head2 new
210
243
211
  $context = new C4::Context;
212
  $context = new C4::Context("/path/to/koha-conf.xml");
244
  $context = new C4::Context("/path/to/koha-conf.xml");
213
245
214
Allocates a new context. Initializes the context from the specified
246
Allocates a new context. Initializes the context from the specified
215
file, which defaults to either the file given by the C<$KOHA_CONF>
247
file.
216
environment variable, or F</etc/koha/koha-conf.xml>.
217
218
It saves the koha-conf.xml values in the declared memcached server(s)
219
if currently available and uses those values until them expire and
220
re-reads them.
221
248
222
C<&new> does not set this context as the new default context; for
249
C<&new> does not set this context as the new default context; for
223
that, use C<&set_context>.
250
that, use C<&set_context>.
Lines 229-266 that, use C<&set_context>. Link Here
229
# 2004-08-10 A. Tarallo: Added check if the conf file is not empty
256
# 2004-08-10 A. Tarallo: Added check if the conf file is not empty
230
sub new {
257
sub new {
231
    my $class = shift;
258
    my $class = shift;
232
    my $conf_fname = shift;        # Config file to load
259
    my $conf_fname = shift or croak "No conf";
233
    my $self = {};
260
    my $namespace = shift;
234
235
    # check that the specified config file exists and is not empty
236
    undef $conf_fname unless 
237
        (defined $conf_fname && -s $conf_fname);
238
    # Figure out a good config file to load if none was specified.
239
    unless ( defined $conf_fname ) {
240
        $conf_fname = Koha::Config->guess_koha_conf;
241
        unless ( $conf_fname ) {
242
            warn "unable to locate Koha configuration file koha-conf.xml";
243
            return;
244
        }
245
    }
246
261
247
    my $conf_cache = Koha::Caches->get_instance('config');
262
    my $self = Koha::Config->read_from_file($conf_fname);
248
    my $config_from_cache;
263
    die "Invalid config ".(ref($conf_fname) ? $$conf_fname : $conf_fname).": ".Dumper($self)
249
    if ( $conf_cache->cache ) {
264
      unless ref($self) && $self->{"config"};
250
        $self = $conf_cache->get_from_cache('koha_conf');
265
251
    }
266
    $self->{config_file} = $conf_fname;
252
    unless ( $self and %$self ) {
267
    $self->{namespace} = $namespace;
253
        $self = Koha::Config->read_from_file($conf_fname);
268
    $self->{use_syspref_cache} = 1;
254
        if ( $conf_cache->memcached_cache ) {
269
    $self->{syspref_cache} = Koha::Cache->new({namespace => $namespace});
255
            # FIXME it may be better to use the memcached servers from the config file
256
            # to cache it
257
            $conf_cache->set_in_cache('koha_conf', $self)
258
        }
259
    }
260
    unless ( exists $self->{config} or defined $self->{config} ) {
261
        warn "The config file ($conf_fname) has not been parsed correctly";
262
        return;
263
    }
264
270
265
    $self->{"Zconn"} = undef;    # Zebra Connections
271
    $self->{"Zconn"} = undef;    # Zebra Connections
266
    $self->{"userenv"} = undef;        # User env
272
    $self->{"userenv"} = undef;        # User env
Lines 275-281 sub new { Link Here
275
281
276
=head2 set_context
282
=head2 set_context
277
283
278
  $context = new C4::Context;
279
  $context->set_context();
284
  $context->set_context();
280
or
285
or
281
  set_context C4::Context $context;
286
  set_context C4::Context $context;
Lines 308-324 sub set_context Link Here
308
    if (ref($self) eq "")
313
    if (ref($self) eq "")
309
    {
314
    {
310
        # Class method. The new context is the next argument.
315
        # Class method. The new context is the next argument.
311
        $new_context = shift;
316
        $new_context = shift or croak "No new context";
312
    } else {
317
    } else {
313
        # Instance method. The new context is $self.
318
        # Instance method. The new context is $self.
314
        $new_context = $self;
319
        $new_context = $self;
315
    }
320
    }
316
321
317
    # Save the old context, if any, on the stack
322
    # undef $new_context->{schema} if $new_context->{schema} && !$new_context->{schema}->ping
318
    push @context_stack, $context if defined($context);
323
    my $schema = $new_context->{schema} ||= Koha::Database->new_schema($new_context);
324
325
    # Save the old context on the stack
326
    push @context_stack, $context;
319
327
320
    # Set the new context
328
    # Set the new context
321
    $context = $new_context;
329
    $context = $new_context;
330
    Koha::Database->set_schema($schema);
322
}
331
}
323
332
324
=head2 restore_context
333
=head2 restore_context
Lines 334-352 sub restore_context Link Here
334
{
343
{
335
    my $self = shift;
344
    my $self = shift;
336
345
337
    if ($#context_stack < 0)
338
    {
339
        # Stack underflow.
340
        die "Context stack underflow";
341
    }
342
343
    # Pop the old context and set it.
346
    # Pop the old context and set it.
344
    $context = pop @context_stack;
347
    $context = pop @context_stack;
348
    Koha::Database->restore_schema();
345
349
346
    # FIXME - Should this return something, like maybe the context
350
    # FIXME - Should this return something, like maybe the context
347
    # that was current when this was called?
351
    # that was current when this was called?
348
}
352
}
349
353
354
=head2 run_within_context
355
356
  $context->run_within_context(sub {...});
357
358
Runs code within context
359
360
=cut
361
362
#'
363
sub run_within_context
364
{
365
    my $self = shift;
366
    my $code = shift or croak "No code";
367
368
    $self->set_context;
369
370
    local $@;
371
    my $ret = eval { $code->(@_) };
372
    my $died = $@;
373
    $self->restore_context;
374
    die $died if $died;
375
    return $ret;
376
}
377
350
=head2 config
378
=head2 config
351
379
352
  $value = C4::Context->config("config_variable");
380
  $value = C4::Context->config("config_variable");
Lines 363-388 C<C4::Config-E<gt>new> will not return it. Link Here
363
=cut
391
=cut
364
392
365
sub _common_config {
393
sub _common_config {
366
	my $var = shift;
394
    my $self = shift;
367
	my $term = shift;
395
    my $var = shift;
368
    return if !defined($context->{$term});
396
    my $term = shift;
397
398
    $self = $context unless ref $self;
399
    return if !defined($self->{$term});
369
       # Presumably $self->{$term} might be
400
       # Presumably $self->{$term} might be
370
       # undefined if the config file given to &new
401
       # undefined if the config file given to &new
371
       # didn't exist, and the caller didn't bother
402
       # didn't exist, and the caller didn't bother
372
       # to check the return value.
403
       # to check the return value.
373
404
374
    # Return the value of the requested config variable
405
    # Return the value of the requested config variable
375
    return $context->{$term}->{$var};
406
    return $self->{$term}->{$var};
376
}
407
}
377
408
378
sub config {
409
sub config {
379
	return _common_config($_[1],'config');
410
    my $self = shift;
411
    return $self->_common_config($_[0],'config');
380
}
412
}
381
sub zebraconfig {
413
sub zebraconfig {
382
	return _common_config($_[1],'server');
414
    my $self = shift;
415
    return $self->_common_config($_[0],'server');
383
}
416
}
384
sub ModZebrations {
417
sub ModZebrations {
385
	return _common_config($_[1],'serverinfo');
418
    my $self = shift;
419
    return $self->_common_config($_[0],'serverinfo');
386
}
420
}
387
421
388
=head2 preference
422
=head2 preference
Lines 401-410 with this method. Link Here
401
435
402
=cut
436
=cut
403
437
404
my $syspref_cache = Koha::Caches->get_instance('syspref');
405
my $use_syspref_cache = 1;
406
sub preference {
438
sub preference {
407
    my $self = shift;
439
    my $self = shift;
440
    $self = $context unless ref $self;
408
    my $var  = shift;    # The system preference to return
441
    my $var  = shift;    # The system preference to return
409
442
410
    $var = lc $var;
443
    $var = lc $var;
Lines 412-419 sub preference { Link Here
412
    return $ENV{"OVERRIDE_SYSPREF_$var"}
445
    return $ENV{"OVERRIDE_SYSPREF_$var"}
413
        if defined $ENV{"OVERRIDE_SYSPREF_$var"};
446
        if defined $ENV{"OVERRIDE_SYSPREF_$var"};
414
447
415
    my $cached_var = $use_syspref_cache
448
    my $cached_var = $self->{use_syspref_cache}
416
        ? $syspref_cache->get_from_cache("syspref_$var")
449
        ? $self->{syspref_cache}->get_from_cache("syspref_$var")
417
        : undef;
450
        : undef;
418
    return $cached_var if defined $cached_var;
451
    return $cached_var if defined $cached_var;
419
452
Lines 421-428 sub preference { Link Here
421
    eval { $syspref = Koha::Config::SysPrefs->find( lc $var ) };
454
    eval { $syspref = Koha::Config::SysPrefs->find( lc $var ) };
422
    my $value = $syspref ? $syspref->value() : undef;
455
    my $value = $syspref ? $syspref->value() : undef;
423
456
424
    if ( $use_syspref_cache ) {
457
    if ( $self->{use_syspref_cache} ) {
425
        $syspref_cache->set_in_cache("syspref_$var", $value);
458
        $self->{syspref_cache}->set_in_cache("syspref_$var", $value);
426
    }
459
    }
427
    return $value;
460
    return $value;
428
}
461
}
Lines 445-451 default behavior. Link Here
445
478
446
sub enable_syspref_cache {
479
sub enable_syspref_cache {
447
    my ($self) = @_;
480
    my ($self) = @_;
448
    $use_syspref_cache = 1;
481
    $self = $context unless ref $self;
482
    $self->{use_syspref_cache} = 1;
449
    # We need to clear the cache to have it up-to-date
483
    # We need to clear the cache to have it up-to-date
450
    $self->clear_syspref_cache();
484
    $self->clear_syspref_cache();
451
}
485
}
Lines 461-467 used with Plack and other persistent environments. Link Here
461
495
462
sub disable_syspref_cache {
496
sub disable_syspref_cache {
463
    my ($self) = @_;
497
    my ($self) = @_;
464
    $use_syspref_cache = 0;
498
    $self = $context unless ref $self;
499
    $self->{use_syspref_cache} = 0;
465
    $self->clear_syspref_cache();
500
    $self->clear_syspref_cache();
466
}
501
}
467
502
Lines 476-483 will not be seen by this process. Link Here
476
=cut
511
=cut
477
512
478
sub clear_syspref_cache {
513
sub clear_syspref_cache {
479
    return unless $use_syspref_cache;
514
    my ($self) = @_;
480
    $syspref_cache->flush_all;
515
    $self = $context unless ref $self;
516
    return unless $self->{use_syspref_cache};
517
    $self->{syspref_cache}->flush_all;
481
}
518
}
482
519
483
=head2 set_preference
520
=head2 set_preference
Lines 493-498 preference. Link Here
493
530
494
sub set_preference {
531
sub set_preference {
495
    my ( $self, $variable, $value, $explanation, $type, $options ) = @_;
532
    my ( $self, $variable, $value, $explanation, $type, $options ) = @_;
533
    $self = $context unless ref $self;
496
534
497
    $variable = lc $variable;
535
    $variable = lc $variable;
498
536
Lines 528-535 sub set_preference { Link Here
528
        )->store();
566
        )->store();
529
    }
567
    }
530
568
531
    if ( $use_syspref_cache ) {
569
    if ( $self->{use_syspref_cache} ) {
532
        $syspref_cache->set_in_cache( "syspref_$variable", $value );
570
        $self->{syspref_cache}->set_in_cache( "syspref_$variable", $value );
533
    }
571
    }
534
572
535
    return $syspref;
573
    return $syspref;
Lines 547-556 was no syspref of the name. Link Here
547
585
548
sub delete_preference {
586
sub delete_preference {
549
    my ( $self, $var ) = @_;
587
    my ( $self, $var ) = @_;
588
    $self = $context unless ref $self;
550
589
551
    if ( Koha::Config::SysPrefs->find( $var )->delete ) {
590
    if ( Koha::Config::SysPrefs->find( $var )->delete ) {
552
        if ( $use_syspref_cache ) {
591
        if ( $self->{use_syspref_cache} ) {
553
            $syspref_cache->clear_from_cache("syspref_$var");
592
            $self->{syspref_cache}->clear_from_cache("syspref_$var");
554
        }
593
        }
555
594
556
        return 1;
595
        return 1;
Lines 564-570 sub delete_preference { Link Here
564
603
565
Returns a connection to the Zebra database
604
Returns a connection to the Zebra database
566
605
567
C<$self> 
606
C<$self>
568
607
569
C<$server> one of the servers defined in the koha-conf.xml file
608
C<$server> one of the servers defined in the koha-conf.xml file
570
609
Lines 675-682 creates one, and connects to the database. Link Here
675
714
676
This database handle is cached for future use: if you call
715
This database handle is cached for future use: if you call
677
C<C4::Context-E<gt>dbh> twice, you will get the same handle both
716
C<C4::Context-E<gt>dbh> twice, you will get the same handle both
678
times. If you need a second database handle, use C<&new_dbh> and
717
times. If you need a second database handle, use C<&new_dbh>.
679
possibly C<&set_dbh>.
680
718
681
=cut
719
=cut
682
720
Lines 715-778 sub new_dbh Link Here
715
    return &dbh({ new => 1 });
753
    return &dbh({ new => 1 });
716
}
754
}
717
755
718
=head2 set_dbh
719
720
  $my_dbh = C4::Connect->new_dbh;
721
  C4::Connect->set_dbh($my_dbh);
722
  ...
723
  C4::Connect->restore_dbh;
724
725
C<&set_dbh> and C<&restore_dbh> work in a manner analogous to
726
C<&set_context> and C<&restore_context>.
727
728
C<&set_dbh> saves the current database handle on a stack, then sets
729
the current database handle to C<$my_dbh>.
730
731
C<$my_dbh> is assumed to be a good database handle.
732
733
=cut
734
735
#'
736
sub set_dbh
737
{
738
    my $self = shift;
739
    my $new_dbh = shift;
740
741
    # Save the current database handle on the handle stack.
742
    # We assume that $new_dbh is all good: if the caller wants to
743
    # screw himself by passing an invalid handle, that's fine by
744
    # us.
745
    push @{$context->{"dbh_stack"}}, $context->{"dbh"};
746
    $context->{"dbh"} = $new_dbh;
747
}
748
749
=head2 restore_dbh
750
751
  C4::Context->restore_dbh;
752
753
Restores the database handle saved by an earlier call to
754
C<C4::Context-E<gt>set_dbh>.
755
756
=cut
757
758
#'
759
sub restore_dbh
760
{
761
    my $self = shift;
762
763
    if ($#{$context->{"dbh_stack"}} < 0)
764
    {
765
        # Stack underflow
766
        die "DBH stack underflow";
767
    }
768
769
    # Pop the old database handle and set it.
770
    $context->{"dbh"} = pop @{$context->{"dbh_stack"}};
771
772
    # FIXME - If it is determined that restore_context should
773
    # return something, then this function should, too.
774
}
775
776
=head2 queryparser
756
=head2 queryparser
777
757
778
  $queryparser = C4::Context->queryparser
758
  $queryparser = C4::Context->queryparser
(-)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 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::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 101-107 my $warnIsRootUser = (! $loggedinuser); Link Here
101
my $warnNoActiveCurrency = (! defined Koha::Acquisition::Currencies->get_active);
101
my $warnNoActiveCurrency = (! defined Koha::Acquisition::Currencies->get_active);
102
my @xml_config_warnings;
102
my @xml_config_warnings;
103
103
104
my $context = new C4::Context;
104
my $context = C4::Context->current;
105
105
106
if ( ! defined C4::Context->config('zebra_bib_index_mode') ) {
106
if ( ! defined C4::Context->config('zebra_bib_index_mode') ) {
107
    push @xml_config_warnings, {
107
    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 (+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 (-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