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

(-)a/C4/Auth_with_cas.pm (-1 / +1 lines)
Lines 36-42 BEGIN { Link Here
36
	@ISA    = qw(Exporter);
36
	@ISA    = qw(Exporter);
37
	@EXPORT = qw(check_api_auth_cas checkpw_cas login_cas logout_cas login_cas_url);
37
	@EXPORT = qw(check_api_auth_cas checkpw_cas login_cas logout_cas login_cas_url);
38
}
38
}
39
my $context = C4::Context->new() or die 'C4::Context->new failed';
39
my $context = C4::Context->current() or die 'No current context';
40
my $defaultcasserver;
40
my $defaultcasserver;
41
my $casservers;
41
my $casservers;
42
my $yamlauthfile = C4::Context->config('intranetdir') . "/C4/Auth_cas_servers.yaml";
42
my $yamlauthfile = C4::Context->config('intranetdir') . "/C4/Auth_cas_servers.yaml";
(-)a/C4/Auth_with_ldap.pm (-1 / +1 lines)
Lines 53-59 sub ldapserver_error { Link Here
53
}
53
}
54
54
55
use vars qw($mapping @ldaphosts $base $ldapname $ldappassword);
55
use vars qw($mapping @ldaphosts $base $ldapname $ldappassword);
56
my $context = C4::Context->new() 	or die 'C4::Context->new failed';
56
my $context = C4::Context->current() 	or die 'No current context';
57
my $ldap = C4::Context->config("ldapserver") or die 'No "ldapserver" in server hash from KOHA_CONF: ' . $ENV{KOHA_CONF};
57
my $ldap = C4::Context->config("ldapserver") or die 'No "ldapserver" in server hash from KOHA_CONF: ' . $ENV{KOHA_CONF};
58
my $prefhost  = $ldap->{hostname}	or die ldapserver_error('hostname');
58
my $prefhost  = $ldap->{hostname}	or die ldapserver_error('hostname');
59
my $base      = $ldap->{base}		or die ldapserver_error('base');
59
my $base      = $ldap->{base}		or die ldapserver_error('base');
(-)a/C4/Context.pm (-185 / +167 lines)
Lines 31-37 BEGIN { Link Here
31
			    eval {C4::Context->dbh();};
31
			    eval {C4::Context->dbh();};
32
			    if ($@){
32
			    if ($@){
33
				$debug_level = 1;
33
				$debug_level = 1;
34
			    } 
34
			    }
35
			    else {
35
			    else {
36
				$debug_level =  C4::Context->preference("DebugLevel");
36
				$debug_level =  C4::Context->preference("DebugLevel");
37
			    }
37
			    }
Lines 49-55 BEGIN { Link Here
49
		# a little example table with various version info";
49
		# a little example table with various version info";
50
					print "
50
					print "
51
						<h1>Koha error</h1>
51
						<h1>Koha error</h1>
52
						<p>The following fatal error has occurred:</p> 
52
						<p>The following fatal error has occurred:</p>
53
                        <pre><code>$msg</code></pre>
53
                        <pre><code>$msg</code></pre>
54
						<table>
54
						<table>
55
						<tr><th>Apache</th><td>  $versions{apacheVersion}</td></tr>
55
						<tr><th>Apache</th><td>  $versions{apacheVersion}</td></tr>
Lines 63-73 BEGIN { Link Here
63
				} elsif ($debug_level eq "1"){
63
				} elsif ($debug_level eq "1"){
64
					print "
64
					print "
65
						<h1>Koha error</h1>
65
						<h1>Koha error</h1>
66
						<p>The following fatal error has occurred:</p> 
66
						<p>The following fatal error has occurred:</p>
67
                        <pre><code>$msg</code></pre>";
67
                        <pre><code>$msg</code></pre>";
68
				} else {
68
				} else {
69
					print "<p>production mode - trapped fatal error</p>";
69
					print "<p>production mode - trapped fatal error</p>";
70
				}       
70
				}
71
                print "</body></html>";
71
                print "</body></html>";
72
			}
72
			}
73
		#CGI::Carp::set_message(\&handle_errors);
73
		#CGI::Carp::set_message(\&handle_errors);
Lines 112-117 use Koha::Cache; Link Here
112
use POSIX ();
112
use POSIX ();
113
use DateTime::TimeZone;
113
use DateTime::TimeZone;
114
use Module::Load::Conditional qw(can_load);
114
use Module::Load::Conditional qw(can_load);
115
use Data::Dumper;
115
use Carp;
116
use Carp;
116
117
117
use C4::Boolean;
118
use C4::Boolean;
Lines 179-188 environment variable to the pathname of a configuration file to use. Link Here
179
#    file (/etc/koha/koha-conf.xml).
180
#    file (/etc/koha/koha-conf.xml).
180
# dbh
181
# dbh
181
#    A handle to the appropriate database for this context.
182
#    A handle to the appropriate database for this context.
182
# dbh_stack
183
#    Used by &set_dbh and &restore_dbh to hold other database
184
#    handles for this context.
185
# Zconn
186
#     A connection object for the Zebra server
183
#     A connection object for the Zebra server
187
184
188
# Koha's main configuration file koha-conf.xml
185
# Koha's main configuration file koha-conf.xml
Lines 191-197 environment variable to the pathname of a configuration file to use. Link Here
191
# 1. Path supplied via use C4::Context '/path/to/koha-conf.xml'
188
# 1. Path supplied via use C4::Context '/path/to/koha-conf.xml'
192
# 2. Path supplied in KOHA_CONF environment variable.
189
# 2. Path supplied in KOHA_CONF environment variable.
193
# 3. Path supplied in INSTALLED_CONFIG_FNAME, as long
190
# 3. Path supplied in INSTALLED_CONFIG_FNAME, as long
194
#    as value has changed from its default of 
191
#    as value has changed from its default of
195
#    '__KOHA_CONF_DIR__/koha-conf.xml', as happens
192
#    '__KOHA_CONF_DIR__/koha-conf.xml', as happens
196
#    when Koha is installed in 'standard' or 'single'
193
#    when Koha is installed in 'standard' or 'single'
197
#    mode.
194
#    mode.
Lines 201-252 environment variable to the pathname of a configuration file to use. Link Here
201
198
202
use constant CONFIG_FNAME => "/etc/koha/koha-conf.xml";
199
use constant CONFIG_FNAME => "/etc/koha/koha-conf.xml";
203
                # Default config file, if none is specified
200
                # Default config file, if none is specified
204
                
201
205
my $INSTALLED_CONFIG_FNAME = '__KOHA_CONF_DIR__/koha-conf.xml';
202
my $INSTALLED_CONFIG_FNAME = '__KOHA_CONF_DIR__/koha-conf.xml';
206
                # path to config file set by installer
203
                # path to config file set by installer
207
                # __KOHA_CONF_DIR__ is set by rewrite-confg.PL
204
                # __KOHA_CONF_DIR__ is set by rewrite-confg.PL
208
                # when Koha is installed in 'standard' or 'single'
205
                # when Koha is installed in 'standard' or 'single'
209
                # mode.  If Koha was installed in 'dev' mode, 
206
                # mode.  If Koha was installed in 'dev' mode,
210
                # __KOHA_CONF_DIR__ is *not* rewritten; instead
207
                # __KOHA_CONF_DIR__ is *not* rewritten; instead
211
                # developers should set the KOHA_CONF environment variable 
208
                # developers should set the KOHA_CONF environment variable
212
213
$context = undef;        # Initially, no context is set
214
@context_stack = ();        # Initially, no saved contexts
215
216
217
=head2 read_config_file
218
219
Reads the specified Koha config file. 
220
221
Returns an object containing the configuration variables. The object's
222
structure is a bit complex to the uninitiated ... take a look at the
223
koha-conf.xml file as well as the XML::Simple documentation for details. Or,
224
here are a few examples that may give you what you need:
225
209
226
The simple elements nested within the <config> element:
210
@context_stack = ();     # Initially, no saved contexts
227
211
228
    my $pass = $koha->{'config'}->{'pass'};
212
=head2 current
229
213
230
The <listen> elements:
214
Returns the current context
231
232
    my $listen = $koha->{'listen'}->{'biblioserver'}->{'content'};
233
234
The elements nested within the <server> element:
235
236
    my $ccl2rpn = $koha->{'server'}->{'biblioserver'}->{'cql2rpn'};
237
238
Returns undef in case of error.
239
215
240
=cut
216
=cut
241
217
242
sub read_config_file {		# Pass argument naming config file to read
218
sub current {
243
    my $koha = XMLin(shift, keyattr => ['id'], forcearray => ['listen', 'server', 'serverinfo'], suppressempty => '');
219
    return $context;
244
245
    if ($ismemcached) {
246
      $memcached->set('kohaconf',$koha);
247
    }
248
249
    return $koha;			# Return value: ref-to-hash holding the configuration
250
}
220
}
251
221
252
=head2 ismemcached
222
=head2 ismemcached
Lines 274-279 sub memcached { Link Here
274
    }
244
    }
275
}
245
}
276
246
247
sub db_driver {
248
    my $self = shift;
249
250
    $self = $context unless ref ($self);
251
    return unless $self;
252
253
    return $self->{db_driver};
254
}
255
277
=head2 db_scheme2dbi
256
=head2 db_scheme2dbi
278
257
279
    my $dbd_driver_name = C4::Context::db_schema2dbi($scheme);
258
    my $dbd_driver_name = C4::Context::db_schema2dbi($scheme);
Lines 294-325 sub import { Link Here
294
    # Create the default context ($C4::Context::Context)
273
    # Create the default context ($C4::Context::Context)
295
    # the first time the module is called
274
    # the first time the module is called
296
    # (a config file can be optionaly passed)
275
    # (a config file can be optionaly passed)
276
    # If ":no_config" is passed, no config load will be attempted
277
    # Config file defaults to either the file given by the $KOHA_CONF
278
    # environment variable, or /etc/koha/koha-conf.xml.
279
    # It saves the context values in the declared memcached server(s)
280
    # if currently available and uses those values until them expire and
281
    # re-reads them.
282
283
    my ($pkg,$config_file) = @_ ;
297
284
298
    # default context already exists?
285
    # default context already exists?
299
    return if $context;
286
    return if $context;
300
287
288
    if ($ismemcached) {
289
        # retrieve from memcached
290
        if (my $self = $memcached->get('kohaconf')) {
291
            $context = $self;
292
            return;
293
        }
294
    }
295
296
    # check that the specified config file exists and is not empty
297
    undef $config_file if defined $config_file &&
298
        !( ref($config_file) || openhandle($config_file) || -s $config_file );
299
    # Figure out a good config file to load if none was specified.
300
    if (!defined($config_file))
301
    {
302
        # If the $KOHA_CONF environment variable is set, use
303
        # that. Otherwise, use the built-in default.
304
        if ($ENV{'KOHA_CONF'} and ref($ENV{'KOHA_CONF'}) || -s  $ENV{"KOHA_CONF"}) {
305
            $config_file = $ENV{"KOHA_CONF"};
306
        } elsif ($INSTALLED_CONFIG_FNAME !~ /__KOHA_CONF_DIR/ and -s $INSTALLED_CONFIG_FNAME) {
307
            # NOTE: be careful -- don't change __KOHA_CONF_DIR in the above
308
            # regex to anything else -- don't want installer to rewrite it
309
            $config_file = $INSTALLED_CONFIG_FNAME;
310
        } elsif (-s CONFIG_FNAME) {
311
            $config_file = CONFIG_FNAME;
312
        } else {
313
            die "unable to locate Koha configuration file koha-conf.xml";
314
        }
315
    }
316
301
    # no ? so load it!
317
    # no ? so load it!
302
    my ($pkg,$config_file) = @_ ;
318
    return if $config_file && $config_file eq ":no_config";
303
    my $new_ctx = __PACKAGE__->new($config_file);
319
    my $new_ctx = __PACKAGE__->new($config_file);
304
    return unless $new_ctx;
320
    return unless $new_ctx;
305
321
306
    # if successfully loaded, use it by default
322
    # if successfully loaded, use it by default
307
    $new_ctx->set_context;
323
    $context = $new_ctx;
308
    1;
324
325
    if ($ismemcached) {
326
      $memcached->set('kohaconf',$new_ctx);
327
    }
309
}
328
}
310
329
330
use Scalar::Util qw(openhandle);
311
=head2 new
331
=head2 new
312
332
313
  $context = new C4::Context;
314
  $context = new C4::Context("/path/to/koha-conf.xml");
333
  $context = new C4::Context("/path/to/koha-conf.xml");
315
334
316
Allocates a new context. Initializes the context from the specified
335
Allocates a new context. Initializes the context from the specified
317
file, which defaults to either the file given by the C<$KOHA_CONF>
336
file.
318
environment variable, or F</etc/koha/koha-conf.xml>.
319
337
320
It saves the koha-conf.xml values in the declared memcached server(s)
338
XML structure is a bit complex to the uninitiated ... take a look at the
321
if currently available and uses those values until them expire and
339
koha-conf.xml file as well as the XML::Simple documentation for details. Or,
322
re-reads them.
340
here are a few examples that may give you what you need:
341
342
The simple elements nested within the <config> element:
343
344
    my $pass = $koha->{'config'}->{'pass'};
345
346
The <listen> elements:
347
348
    my $listen = $koha->{'listen'}->{'biblioserver'}->{'content'};
349
350
The elements nested within the <server> element:
351
352
    my $ccl2rpn = $koha->{'server'}->{'biblioserver'}->{'cql2rpn'};
353
354
Returns undef in case of error.
323
355
324
C<&new> does not set this context as the new default context; for
356
C<&new> does not set this context as the new default context; for
325
that, use C<&set_context>.
357
that, use C<&set_context>.
Lines 331-376 that, use C<&set_context>. Link Here
331
# 2004-08-10 A. Tarallo: Added check if the conf file is not empty
363
# 2004-08-10 A. Tarallo: Added check if the conf file is not empty
332
sub new {
364
sub new {
333
    my $class = shift;
365
    my $class = shift;
334
    my $conf_fname = shift;        # Config file to load
366
    my $conf_fname = shift or croak "No conf";
335
    my $self = {};
367
    my $namespace = shift;
336
368
337
    # check that the specified config file exists and is not empty
369
    my $self = XMLin(
338
    undef $conf_fname unless 
370
        $conf_fname,
339
        (defined $conf_fname && -s $conf_fname);
371
        keyattr => ['id'],
340
    # Figure out a good config file to load if none was specified.
372
        forcearray => ['listen', 'server', 'serverinfo'],
341
    if (!defined($conf_fname))
373
        suppressempty => '',
342
    {
374
    );
343
        # If the $KOHA_CONF environment variable is set, use
375
    die "Invalid config ".(ref($conf_fname) ? $$conf_fname : $conf_fname).": ".Dumper($self)
344
        # that. Otherwise, use the built-in default.
376
      unless ref($self) && $self->{"config"};
345
        if (exists $ENV{"KOHA_CONF"} and $ENV{'KOHA_CONF'} and -s  $ENV{"KOHA_CONF"}) {
377
346
            $conf_fname = $ENV{"KOHA_CONF"};
378
    $self->{config_file} = $conf_fname;
347
        } elsif ($INSTALLED_CONFIG_FNAME !~ /__KOHA_CONF_DIR/ and -s $INSTALLED_CONFIG_FNAME) {
379
    $self->{namespace} = $namespace;
348
            # NOTE: be careful -- don't change __KOHA_CONF_DIR in the above
380
    $self->{use_syspref_cache} = 1;
349
            # regex to anything else -- don't want installer to rewrite it
381
    $self->{syspref_cache} = Koha::Cache->new({namespace => $namespace});
350
            $conf_fname = $INSTALLED_CONFIG_FNAME;
351
        } elsif (-s CONFIG_FNAME) {
352
            $conf_fname = CONFIG_FNAME;
353
        } else {
354
            warn "unable to locate Koha configuration file koha-conf.xml";
355
            return;
356
        }
357
    }
358
    
359
    if ($ismemcached) {
360
        # retrieve from memcached
361
        $self = $memcached->get('kohaconf');
362
        if (not defined $self) {
363
            # not in memcached yet
364
            $self = read_config_file($conf_fname);
365
        }
366
    } else {
367
        # non-memcached env, read from file
368
        $self = read_config_file($conf_fname);
369
    }
370
371
    $self->{"config_file"} = $conf_fname;
372
    warn "read_config_file($conf_fname) returned undef" if !defined($self->{"config"});
373
    return if !defined($self->{"config"});
374
382
375
    $self->{"Zconn"} = undef;    # Zebra Connections
383
    $self->{"Zconn"} = undef;    # Zebra Connections
376
    $self->{"marcfromkohafield"} = undef; # the hash with relations between koha table fields and MARC field/subfield
384
    $self->{"marcfromkohafield"} = undef; # the hash with relations between koha table fields and MARC field/subfield
Lines 386-392 sub new { Link Here
386
394
387
=head2 set_context
395
=head2 set_context
388
396
389
  $context = new C4::Context;
390
  $context->set_context();
397
  $context->set_context();
391
or
398
or
392
  set_context C4::Context $context;
399
  set_context C4::Context $context;
Lines 419-435 sub set_context Link Here
419
    if (ref($self) eq "")
426
    if (ref($self) eq "")
420
    {
427
    {
421
        # Class method. The new context is the next argument.
428
        # Class method. The new context is the next argument.
422
        $new_context = shift;
429
        $new_context = shift or croak "No new context";
423
    } else {
430
    } else {
424
        # Instance method. The new context is $self.
431
        # Instance method. The new context is $self.
425
        $new_context = $self;
432
        $new_context = $self;
426
    }
433
    }
427
434
428
    # Save the old context, if any, on the stack
435
    # undef $new_context->{schema} if $new_context->{schema} && !$new_context->{schema}->ping
429
    push @context_stack, $context if defined($context);
436
    my $schema = $new_context->{schema} ||= Koha::Database->new_schema($new_context);
437
438
    # Save the old context on the stack
439
    push @context_stack, $context;
430
440
431
    # Set the new context
441
    # Set the new context
432
    $context = $new_context;
442
    $context = $new_context;
443
    Koha::Database->set_schema($schema);
433
}
444
}
434
445
435
=head2 restore_context
446
=head2 restore_context
Lines 445-463 sub restore_context Link Here
445
{
456
{
446
    my $self = shift;
457
    my $self = shift;
447
458
448
    if ($#context_stack < 0)
449
    {
450
        # Stack underflow.
451
        die "Context stack underflow";
452
    }
453
454
    # Pop the old context and set it.
459
    # Pop the old context and set it.
455
    $context = pop @context_stack;
460
    $context = pop @context_stack;
461
    Koha::Database->restore_schema();
456
462
457
    # FIXME - Should this return something, like maybe the context
463
    # FIXME - Should this return something, like maybe the context
458
    # that was current when this was called?
464
    # that was current when this was called?
459
}
465
}
460
466
467
=head2 run_within_context
468
469
  $context->run_within_context(sub {...});
470
471
Runs code within context
472
473
=cut
474
475
#'
476
sub run_within_context
477
{
478
    my $self = shift;
479
    my $code = shift or croak "No code";
480
481
    $self->set_context;
482
483
    local $@;
484
    my $ret = eval { $code->(@_) };
485
    my $died = $@;
486
    $self->restore_context;
487
    die $died if $died;
488
    return $ret;
489
}
490
461
=head2 config
491
=head2 config
462
492
463
  $value = C4::Context->config("config_variable");
493
  $value = C4::Context->config("config_variable");
Lines 474-499 C<C4::Config-E<gt>new> will not return it. Link Here
474
=cut
504
=cut
475
505
476
sub _common_config {
506
sub _common_config {
477
	my $var = shift;
507
    my $self = shift;
478
	my $term = shift;
508
    my $var = shift;
479
    return if !defined($context->{$term});
509
    my $term = shift;
510
511
    $self = $context unless ref $self;
512
    return if !defined($self->{$term});
480
       # Presumably $self->{$term} might be
513
       # Presumably $self->{$term} might be
481
       # undefined if the config file given to &new
514
       # undefined if the config file given to &new
482
       # didn't exist, and the caller didn't bother
515
       # didn't exist, and the caller didn't bother
483
       # to check the return value.
516
       # to check the return value.
484
517
485
    # Return the value of the requested config variable
518
    # Return the value of the requested config variable
486
    return $context->{$term}->{$var};
519
    return $self->{$term}->{$var};
487
}
520
}
488
521
489
sub config {
522
sub config {
490
	return _common_config($_[1],'config');
523
    my $self = shift;
524
    return $self->_common_config($_[0],'config');
491
}
525
}
492
sub zebraconfig {
526
sub zebraconfig {
493
	return _common_config($_[1],'server');
527
    my $self = shift;
528
    return $self->_common_config($_[0],'server');
494
}
529
}
495
sub ModZebrations {
530
sub ModZebrations {
496
	return _common_config($_[1],'serverinfo');
531
    my $self = shift;
532
    return $self->_common_config($_[0],'serverinfo');
497
}
533
}
498
534
499
=head2 preference
535
=head2 preference
Lines 512-527 with this method. Link Here
512
548
513
=cut
549
=cut
514
550
515
my $syspref_cache = Koha::Cache->get_instance();
516
my $use_syspref_cache = 1;
517
sub preference {
551
sub preference {
518
    my $self = shift;
552
    my $self = shift;
553
    $self = $context unless ref $self;
519
    my $var  = shift;    # The system preference to return
554
    my $var  = shift;    # The system preference to return
520
555
521
    $var = lc $var;
556
    $var = lc $var;
522
557
523
    my $cached_var = $use_syspref_cache
558
    my $cached_var = $self->{use_syspref_cache}
524
        ? $syspref_cache->get_from_cache("syspref_$var")
559
        ? $self->{syspref_cache}->get_from_cache("syspref_$var")
525
        : undef;
560
        : undef;
526
    return $cached_var if defined $cached_var;
561
    return $cached_var if defined $cached_var;
527
562
Lines 534-541 sub preference { Link Here
534
        $value = $syspref ? $syspref->value() : undef;
569
        $value = $syspref ? $syspref->value() : undef;
535
    }
570
    }
536
571
537
    if ( $use_syspref_cache ) {
572
    if ( $self->{use_syspref_cache} ) {
538
        $syspref_cache->set_in_cache("syspref_$var", $value);
573
        $self->{syspref_cache}->set_in_cache("syspref_$var", $value);
539
    }
574
    }
540
    return $value;
575
    return $value;
541
}
576
}
Lines 558-564 default behavior. Link Here
558
593
559
sub enable_syspref_cache {
594
sub enable_syspref_cache {
560
    my ($self) = @_;
595
    my ($self) = @_;
561
    $use_syspref_cache = 1;
596
    $self = $context unless ref $self;
597
    $self->{use_syspref_cache} = 1;
562
    # We need to clear the cache to have it up-to-date
598
    # We need to clear the cache to have it up-to-date
563
    $self->clear_syspref_cache();
599
    $self->clear_syspref_cache();
564
}
600
}
Lines 574-580 used with Plack and other persistent environments. Link Here
574
610
575
sub disable_syspref_cache {
611
sub disable_syspref_cache {
576
    my ($self) = @_;
612
    my ($self) = @_;
577
    $use_syspref_cache = 0;
613
    $self = $context unless ref $self;
614
    $self->{use_syspref_cache} = 0;
578
    $self->clear_syspref_cache();
615
    $self->clear_syspref_cache();
579
}
616
}
580
617
Lines 589-596 will not be seen by this process. Link Here
589
=cut
626
=cut
590
627
591
sub clear_syspref_cache {
628
sub clear_syspref_cache {
592
    return unless $use_syspref_cache;
629
    my ($self) = @_;
593
    $syspref_cache->flush_all;
630
    $self = $context unless ref $self;
631
    return unless $self->{use_syspref_cache};
632
    $self->{syspref_cache}->flush_all;
594
}
633
}
595
634
596
=head2 set_preference
635
=head2 set_preference
Lines 606-611 preference. Link Here
606
645
607
sub set_preference {
646
sub set_preference {
608
    my ( $self, $variable, $value, $explanation, $type, $options ) = @_;
647
    my ( $self, $variable, $value, $explanation, $type, $options ) = @_;
648
    $self = $context unless ref $self;
609
649
610
    $variable = lc $variable;
650
    $variable = lc $variable;
611
651
Lines 641-648 sub set_preference { Link Here
641
        )->store();
681
        )->store();
642
    }
682
    }
643
683
644
    if ( $use_syspref_cache ) {
684
    if ( $self->{use_syspref_cache} ) {
645
        $syspref_cache->set_in_cache( "syspref_$variable", $value );
685
        $self->{syspref_cache}->set_in_cache( "syspref_$variable", $value );
646
    }
686
    }
647
687
648
    return $syspref;
688
    return $syspref;
Lines 660-669 was no syspref of the name. Link Here
660
700
661
sub delete_preference {
701
sub delete_preference {
662
    my ( $self, $var ) = @_;
702
    my ( $self, $var ) = @_;
703
    $self = $context unless ref $self;
663
704
664
    if ( Koha::Config::SysPrefs->find( $var )->delete ) {
705
    if ( Koha::Config::SysPrefs->find( $var )->delete ) {
665
        if ( $use_syspref_cache ) {
706
        if ( $self->{use_syspref_cache} ) {
666
            $syspref_cache->clear_from_cache("syspref_$var");
707
            $self->{syspref_cache}->clear_from_cache("syspref_$var");
667
        }
708
        }
668
709
669
        return 1;
710
        return 1;
Lines 677-683 sub delete_preference { Link Here
677
718
678
Returns a connection to the Zebra database
719
Returns a connection to the Zebra database
679
720
680
C<$self> 
721
C<$self>
681
722
682
C<$server> one of the servers defined in the koha-conf.xml file
723
C<$server> one of the servers defined in the koha-conf.xml file
683
724
Lines 788-795 creates one, and connects to the database. Link Here
788
829
789
This database handle is cached for future use: if you call
830
This database handle is cached for future use: if you call
790
C<C4::Context-E<gt>dbh> twice, you will get the same handle both
831
C<C4::Context-E<gt>dbh> twice, you will get the same handle both
791
times. If you need a second database handle, use C<&new_dbh> and
832
times. If you need a second database handle, use C<&new_dbh>.
792
possibly C<&set_dbh>.
793
833
794
=cut
834
=cut
795
835
Lines 828-891 sub new_dbh Link Here
828
    return &dbh({ new => 1 });
868
    return &dbh({ new => 1 });
829
}
869
}
830
870
831
=head2 set_dbh
832
833
  $my_dbh = C4::Connect->new_dbh;
834
  C4::Connect->set_dbh($my_dbh);
835
  ...
836
  C4::Connect->restore_dbh;
837
838
C<&set_dbh> and C<&restore_dbh> work in a manner analogous to
839
C<&set_context> and C<&restore_context>.
840
841
C<&set_dbh> saves the current database handle on a stack, then sets
842
the current database handle to C<$my_dbh>.
843
844
C<$my_dbh> is assumed to be a good database handle.
845
846
=cut
847
848
#'
849
sub set_dbh
850
{
851
    my $self = shift;
852
    my $new_dbh = shift;
853
854
    # Save the current database handle on the handle stack.
855
    # We assume that $new_dbh is all good: if the caller wants to
856
    # screw himself by passing an invalid handle, that's fine by
857
    # us.
858
    push @{$context->{"dbh_stack"}}, $context->{"dbh"};
859
    $context->{"dbh"} = $new_dbh;
860
}
861
862
=head2 restore_dbh
863
864
  C4::Context->restore_dbh;
865
866
Restores the database handle saved by an earlier call to
867
C<C4::Context-E<gt>set_dbh>.
868
869
=cut
870
871
#'
872
sub restore_dbh
873
{
874
    my $self = shift;
875
876
    if ($#{$context->{"dbh_stack"}} < 0)
877
    {
878
        # Stack underflow
879
        die "DBH stack underflow";
880
    }
881
882
    # Pop the old database handle and set it.
883
    $context->{"dbh"} = pop @{$context->{"dbh_stack"}};
884
885
    # FIXME - If it is determined that restore_context should
886
    # return something, then this function should, too.
887
}
888
889
=head2 queryparser
871
=head2 queryparser
890
872
891
  $queryparser = C4::Context->queryparser
873
  $queryparser = C4::Context->queryparser
(-)a/Koha/Cache.pm (-7 / +7 lines)
Lines 282-288 sub set_in_cache { Link Here
282
    my $set_sub = $self->{ref($self->{$cache}) . "_set"};
282
    my $set_sub = $self->{ref($self->{$cache}) . "_set"};
283
283
284
    # Set in L1 cache
284
    # Set in L1 cache
285
    $L1_cache{ $key } = $value;
285
    $L1_cache{ $self->{namespace} }{ $key } = $value;
286
286
287
    # We consider an expiry of 0 to be inifinite
287
    # We consider an expiry of 0 to be inifinite
288
    if ( $expiry ) {
288
    if ( $expiry ) {
Lines 320-331 sub get_from_cache { Link Here
320
    return unless ( $self->{$cache} && ref( $self->{$cache} ) =~ m/^Cache::/ );
320
    return unless ( $self->{$cache} && ref( $self->{$cache} ) =~ m/^Cache::/ );
321
321
322
    # Return L1 cache value if exists
322
    # Return L1 cache value if exists
323
    if ( exists $L1_cache{$key} ) {
323
    if ( exists $L1_cache{ $self->{namespace} }{ $key } ) {
324
        # No need to deep copy if it's a scalar
324
        # No need to deep copy if it's a scalar
325
        # Or if we do not need to deep copy
325
        # Or if we do not need to deep copy
326
        return $L1_cache{$key}
326
        return $L1_cache{ $self->{namespace} }{ $key }
327
            if not ref $L1_cache{$key} or $unsafe;
327
            if not ref $L1_cache{ $self->{namespace} }{ $key } or $unsafe;
328
        return clone $L1_cache{$key};
328
        return clone $L1_cache{ $self->{namespace} }{ $key };
329
    }
329
    }
330
330
331
    my $get_sub = $self->{ref($self->{$cache}) . "_get"};
331
    my $get_sub = $self->{ref($self->{$cache}) . "_get"};
Lines 354-360 sub clear_from_cache { Link Here
354
    return unless ( $self->{$cache} && ref( $self->{$cache} ) =~ m/^Cache::/ );
354
    return unless ( $self->{$cache} && ref( $self->{$cache} ) =~ m/^Cache::/ );
355
355
356
    # Clear from L1 cache
356
    # Clear from L1 cache
357
    delete $L1_cache{$key};
357
    delete $L1_cache{ $self->{namespace} }{ $key };
358
358
359
    return $self->{$cache}->delete($key)
359
    return $self->{$cache}->delete($key)
360
      if ( ref( $self->{$cache} ) =~ m'^Cache::Memcached' );
360
      if ( ref( $self->{$cache} ) =~ m'^Cache::Memcached' );
Lines 383-389 sub flush_all { Link Here
383
383
384
sub flush_L1_cache {
384
sub flush_L1_cache {
385
    my( $self ) = @_;
385
    my( $self ) = @_;
386
    %L1_cache = ();
386
    delete $L1_cache{ $self->{namespace} };
387
}
387
}
388
388
389
=head1 TIED INTERFACE
389
=head1 TIED INTERFACE
(-)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 92-98 my $warnIsRootUser = (! $loggedinuser); Link Here
92
my $warnNoActiveCurrency = (! defined Koha::Acquisition::Currencies->get_active);
92
my $warnNoActiveCurrency = (! defined Koha::Acquisition::Currencies->get_active);
93
my @xml_config_warnings;
93
my @xml_config_warnings;
94
94
95
my $context = new C4::Context;
95
my $context = C4::Context->current;
96
96
97
if ( ! defined C4::Context->config('zebra_bib_index_mode') ) {
97
if ( ! defined C4::Context->config('zebra_bib_index_mode') ) {
98
    push @xml_config_warnings, {
98
    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 47-53 C4::Context->clear_syspref_cache(); Link Here
47
C4::Context->enable_syspref_cache();
47
C4::Context->enable_syspref_cache();
48
$dbh->rollback;
48
$dbh->rollback;
49
49
50
ok($koha = C4::Context->new,  'C4::Context->new');
50
ok($koha = C4::Context->current,  'C4::Context->current');
51
my @keys = keys %$koha;
51
my @keys = keys %$koha;
52
my $width = 0;
52
my $width = 0;
53
if (ok(@keys)) { 
53
if (ok(@keys)) { 
(-)a/t/db_dependent/Koha_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