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

(-)a/C4/Context.pm (-25 / +64 lines)
Lines 100-105 BEGIN { Link Here
100
use Encode;
100
use Encode;
101
use ZOOM;
101
use ZOOM;
102
use XML::Simple;
102
use XML::Simple;
103
use Koha::Cache;
103
use POSIX ();
104
use POSIX ();
104
use DateTime::TimeZone;
105
use DateTime::TimeZone;
105
use Module::Load::Conditional qw(can_load);
106
use Module::Load::Conditional qw(can_load);
Lines 108-113 use Carp; Link Here
108
use C4::Boolean;
109
use C4::Boolean;
109
use C4::Debug;
110
use C4::Debug;
110
use Koha;
111
use Koha;
112
use Koha::Config::SysPref;
111
use Koha::Config::SysPrefs;
113
use Koha::Config::SysPrefs;
112
114
113
=head1 NAME
115
=head1 NAME
Lines 502-520 with this method. Link Here
502
504
503
=cut
505
=cut
504
506
505
# FIXME: running this under mod_perl will require a means of
507
my $syspref_cache = Koha::Cache->get_instance();
506
# flushing the caching mechanism.
507
508
my %sysprefs;
509
my $use_syspref_cache = 1;
508
my $use_syspref_cache = 1;
510
511
sub preference {
509
sub preference {
512
    my $self = shift;
510
    my $self = shift;
513
    my $var  = shift;    # The system preference to return
511
    my $var  = shift;    # The system preference to return
514
512
515
    if ($use_syspref_cache && exists $sysprefs{lc $var}) {
513
    $var = lc $var;
516
        return $sysprefs{lc $var};
514
517
    }
515
    my $cached_var = $use_syspref_cache
516
        ? $syspref_cache->get_from_cache("syspref_$var")
517
        : undef;
518
    return $cached_var if defined $cached_var;
518
519
519
    my $dbh  = C4::Context->dbh or return 0;
520
    my $dbh  = C4::Context->dbh or return 0;
520
521
Lines 527-533 sub preference { Link Here
527
        $value = $syspref ? $syspref->value() : undef;
528
        $value = $syspref ? $syspref->value() : undef;
528
    }
529
    }
529
530
530
    $sysprefs{lc $var} = $value;
531
    $syspref_cache->set_in_cache("syspref_$var", $value) if $use_syspref_cache;
531
    return $value;
532
    return $value;
532
}
533
}
533
534
Lines 550-555 default behavior. Link Here
550
sub enable_syspref_cache {
551
sub enable_syspref_cache {
551
    my ($self) = @_;
552
    my ($self) = @_;
552
    $use_syspref_cache = 1;
553
    $use_syspref_cache = 1;
554
    # We need to clear the cache to have it up-to-date
555
    $self->clear_syspref_cache();
553
}
556
}
554
557
555
=head2 disable_syspref_cache
558
=head2 disable_syspref_cache
Lines 578-620 will not be seen by this process. Link Here
578
=cut
581
=cut
579
582
580
sub clear_syspref_cache {
583
sub clear_syspref_cache {
581
    %sysprefs = ();
584
    $syspref_cache->flush_all if $use_syspref_cache;
582
}
585
}
583
586
584
=head2 set_preference
587
=head2 set_preference
585
588
586
  C4::Context->set_preference( $variable, $value );
589
  C4::Context->set_preference( $variable, $value, [ $explanation, $type, $options ] );
587
590
588
This updates a preference's value both in the systempreferences table and in
591
This updates a preference's value both in the systempreferences table and in
589
the sysprefs cache.
592
the sysprefs cache. If the optional parameters are provided, then the query
593
becomes a create. It won't update the parameters (except value) for an existing
594
preference.
590
595
591
=cut
596
=cut
592
597
593
sub set_preference {
598
sub set_preference {
594
    my $self = shift;
599
    my ( $self, $variable, $value, $explanation, $type, $options ) = @_;
595
    my $var = lc(shift);
596
    my $value = shift;
597
600
598
    my $syspref = Koha::Config::SysPrefs->find( $var );
601
    $variable = lc $variable;
599
    my $type = $syspref ? $syspref->type() : undef;
600
602
601
    $value = 0 if ( $type && $type eq 'YesNo' && $value eq '' );
603
    my $syspref = Koha::Config::SysPrefs->find($variable);
604
    $type =
605
        $type    ? $type
606
      : $syspref ? $syspref->type
607
      :            undef;
602
608
603
    # force explicit protocol on OPACBaseURL
609
    # force explicit protocol on OPACBaseURL
604
    if ($var eq 'opacbaseurl' && substr($value,0,4) !~ /http/) {
610
    if ( $variable eq 'opacbaseurl' && substr( $value, 0, 4 ) !~ /http/ ) {
605
        $value = 'http://' . $value;
611
        $value = 'http://' . $value;
606
    }
612
    }
607
613
608
    if ($syspref) {
614
    if ($syspref) {
609
        $syspref = $syspref->set( { value => $value } )->store();
615
        $syspref->set(
610
    }
616
            {   ( defined $value ? ( value       => $value )       : () ),
611
    else {
617
                ( $explanation   ? ( explanation => $explanation ) : () ),
612
        $syspref = Koha::Config::SysPref->new( { variable => $var, value => $value } )->store();
618
                ( $type          ? ( type        => $type )        : () ),
619
                ( $options       ? ( options     => $options )     : () ),
620
            }
621
        )->store;
622
    } else {
623
        $syspref = Koha::Config::SysPref->new(
624
            {   variable    => $variable,
625
                value       => $value,
626
                explanation => $explanation || undef,
627
                type        => $type,
628
                options     => $options || undef,
629
            }
630
        )->store();
613
    }
631
    }
614
632
615
    if ($syspref) {
633
    $syspref_cache->set_in_cache( "syspref_$variable", $value )
616
        $sysprefs{$var} = $value;
634
      if $use_syspref_cache;
635
636
    return $syspref;
637
}
638
639
=head2 delete_preference
640
641
    C4::Context->delete_preference( $variable );
642
643
This deletes a system preference from the database. Returns a true value on
644
success. Failure means there was an issue with the database, not that there
645
was no syspref of the name.
646
647
=cut
648
649
sub delete_preference {
650
    my ( $self, $var ) = @_;
651
652
    if ( Koha::Config::SysPrefs->find( $var )->delete ) {
653
        $syspref_cache->clear_from_cache("syspref_$var") if $use_syspref_cache;
654
        return 1;
617
    }
655
    }
656
    return 0;
618
}
657
}
619
658
620
=head2 Zconn
659
=head2 Zconn
(-)a/Koha/Config/SysPref.pm (+32 lines)
Lines 23-28 use Carp; Link Here
23
23
24
use Koha::Database;
24
use Koha::Database;
25
25
26
use C4::Log;
27
26
use base qw(Koha::Object);
28
use base qw(Koha::Object);
27
29
28
=head1 NAME
30
=head1 NAME
Lines 35-40 Koha::Config::SysPref - Koha System Preference Object class Link Here
35
37
36
=cut
38
=cut
37
39
40
=head3 store
41
42
=cut
43
44
sub store {
45
    my ($self) = @_;
46
47
    my $action = $self->in_storage ? 'MODIFY' : 'ADD';
48
49
    C4::Log::logaction( 'SYSTEMPREFERENCE', $action, undef, $self->variable . ' | ' . $self->value );
50
51
    return $self->SUPER::store($self);
52
}
53
54
=head3 delete
55
56
=cut
57
58
sub delete {
59
    my ($self) = @_;
60
61
    my $variable = $self->variable;
62
    my $value    = $self->value;
63
    my $deleted  = $self->SUPER::delete($self);
64
65
    C4::Log::logaction( 'SYSTEMPREFERENCE', 'DELETE', undef, " $variable | $value" );
66
67
    return $deleted;
68
}
69
38
=head3 type
70
=head3 type
39
71
40
=cut
72
=cut
(-)a/admin/preferences.pl (-1 lines)
Lines 314-320 if ( $op eq 'save' ) { Link Here
314
            my $value = join( ',', $input->param( $param ) );
314
            my $value = join( ',', $input->param( $param ) );
315
315
316
            C4::Context->set_preference( $pref, $value );
316
            C4::Context->set_preference( $pref, $value );
317
            logaction( 'SYSTEMPREFERENCE', 'MODIFY', undef, $pref . " | " . $value );
318
        }
317
        }
319
    }
318
    }
320
319
(-)a/admin/systempreferences.pl (-48 / +13 lines)
Lines 50-56 use C4::Context; Link Here
50
use C4::Koha;
50
use C4::Koha;
51
use C4::Languages qw(getTranslatedLanguages);
51
use C4::Languages qw(getTranslatedLanguages);
52
use C4::ClassSource;
52
use C4::ClassSource;
53
use C4::Log;
54
use C4::Output;
53
use C4::Output;
55
use YAML::Syck qw( Dump LoadFile );
54
use YAML::Syck qw( Dump LoadFile );
56
55
Lines 276-299 if ( $op eq 'update_and_reedit' ) { Link Here
276
            );    # we show only the TMPL_VAR names $op
275
            );    # we show only the TMPL_VAR names $op
277
        }
276
        }
278
    }
277
    }
279
    my $dbh   = C4::Context->dbh;
278
    my $variable = $input->param('variable');
280
    my $query = "select * from systempreferences where variable=?";
279
    C4::Context->set_preference($variable, $value) unless C4::Context->config('demo');
281
    my $sth   = $dbh->prepare($query);
282
    $sth->execute( $input->param('variable') );
283
    if ( $sth->rows ) {
284
        unless ( C4::Context->config('demo') ) {
285
            my $sth = $dbh->prepare("update systempreferences set value=?,explanation=?,type=?,options=? where variable=?");
286
            $sth->execute( $value, $input->param('explanation'), $input->param('variable'), $input->param('preftype'), $input->param('prefoptions') );
287
            logaction( 'SYSTEMPREFERENCE', 'MODIFY', undef, $input->param('variable') . " | " . $value );
288
        }
289
    } else {
290
        unless ( C4::Context->config('demo') ) {
291
            my $sth = $dbh->prepare("insert into systempreferences (variable,value,explanation) values (?,?,?,?,?)");
292
            $sth->execute( $input->param('variable'), $input->param('value'), $input->param('explanation'), $input->param('preftype'), $input->param('prefoptions') );
293
            logaction( 'SYSTEMPREFERENCE', 'ADD', undef, $input->param('variable') . " | " . $input->param('value') );
294
        }
295
    }
296
297
}
280
}
298
281
299
################## ADD_FORM ##################################
282
################## ADD_FORM ##################################
Lines 322-334 if ( $op eq 'add_form' ) { Link Here
322
################## ADD_VALIDATE ##################################
305
################## ADD_VALIDATE ##################################
323
    # called by add_form, used to insert/modify data in DB
306
    # called by add_form, used to insert/modify data in DB
324
} elsif ( $op eq 'add_validate' ) {
307
} elsif ( $op eq 'add_validate' ) {
325
    my $dbh = C4::Context->dbh;
326
    my $sth = $dbh->prepare("select * from systempreferences where variable=?");
327
    $sth->execute( $input->param('variable') );
328
329
    # to handle multiple values
308
    # to handle multiple values
330
    my $value;
309
    my $value;
331
310
311
    my $variable = $input->param('variable');
312
    my $expl     = $input->param('explanation');
313
    my $type     = $input->param('preftype');
314
    my $options  = $input->param('prefoptions');
315
332
    # handle multiple value strings (separated by ',')
316
    # handle multiple value strings (separated by ',')
333
    my $params = $input->Vars;
317
    my $params = $input->Vars;
334
    if ( defined $params->{'value'} ) {
318
    if ( defined $params->{'value'} ) {
Lines 345-393 if ( $op eq 'add_form' ) { Link Here
345
        }
329
        }
346
    }
330
    }
347
331
348
    if ( $input->param('preftype') eq 'Upload' ) {
332
    if ( $type eq 'Upload' ) {
349
        my $lgtfh = $input->upload('value');
333
        my $lgtfh = $input->upload('value');
350
        $value = join '', <$lgtfh>;
334
        $value = join '', <$lgtfh>;
351
        $value = encode_base64($value);
335
        $value = encode_base64($value);
352
    }
336
    }
353
337
354
    if ( $sth->rows ) {
338
    C4::Context->set_preference( $variable, $value, $expl, $type, $options )
355
        unless ( C4::Context->config('demo') ) {
339
        unless C4::Context->config('demo');
356
            my $sth = $dbh->prepare("update systempreferences set value=?,explanation=?,type=?,options=? where variable=?");
357
            $sth->execute( $value, $input->param('explanation'), $input->param('preftype'), $input->param('prefoptions'), $input->param('variable') );
358
            logaction( 'SYSTEMPREFERENCE', 'MODIFY', undef, $input->param('variable') . " | " . $value );
359
        }
360
    } else {
361
        unless ( C4::Context->config('demo') ) {
362
            my $sth = $dbh->prepare("insert into systempreferences (variable,value,explanation,type,options) values (?,?,?,?,?)");
363
            $sth->execute( $input->param('variable'), $value, $input->param('explanation'), $input->param('preftype'), $input->param('prefoptions') );
364
            logaction( 'SYSTEMPREFERENCE', 'ADD', undef, $input->param('variable') . " | " . $value );
365
        }
366
    }
367
    print $input->redirect("/cgi-bin/koha/admin/systempreferences.pl?tab=");
340
    print $input->redirect("/cgi-bin/koha/admin/systempreferences.pl?tab=");
368
    exit;
341
    exit;
369
################## DELETE_CONFIRM ##################################
342
################## DELETE_CONFIRM ##################################
370
    # called by default form, used to confirm deletion of data in DB
343
    # called by default form, used to confirm deletion of data in DB
371
} elsif ( $op eq 'delete_confirm' ) {
344
} elsif ( $op eq 'delete_confirm' ) {
372
    my $dbh = C4::Context->dbh;
345
    my $value = C4::Context->preference($searchfield);
373
    my $sth = $dbh->prepare("select variable,value,explanation,type,options from systempreferences where variable=?");
374
    $sth->execute($searchfield);
375
    my $data = $sth->fetchrow_hashref;
376
    $template->param(
346
    $template->param(
377
        searchfield => $searchfield,
347
        searchfield => $searchfield,
378
        Tvalue      => $data->{'value'},
348
        Tvalue      => $value,
379
    );
349
    );
380
350
381
    # END $OP eq DELETE_CONFIRM
351
    # END $OP eq DELETE_CONFIRM
382
################## DELETE_CONFIRMED ##################################
352
################## DELETE_CONFIRMED ##################################
383
    # called by delete_confirm, used to effectively confirm deletion of data in DB
353
    # called by delete_confirm, used to effectively confirm deletion of data in DB
384
} elsif ( $op eq 'delete_confirmed' ) {
354
} elsif ( $op eq 'delete_confirmed' ) {
385
    my $dbh = C4::Context->dbh;
355
    C4::Context->delete_preference($searchfield);
386
    my $sth = $dbh->prepare("delete from systempreferences where variable=?");
387
    $sth->execute($searchfield);
388
    my $logstring = $searchfield . " | " . $Tvalue;
389
    logaction( 'SYSTEMPREFERENCE', 'DELETE', undef, $logstring );
390
391
    # END $OP eq DELETE_CONFIRMED
356
    # END $OP eq DELETE_CONFIRMED
392
################## DEFAULT ##################################
357
################## DEFAULT ##################################
393
} else {    # DEFAULT
358
} else {    # DEFAULT
(-)a/misc/admin/koha-preferences (-1 lines)
Lines 82-88 sub _set_preference { Link Here
82
    _debug( "Setting $preference to $value" );
82
    _debug( "Setting $preference to $value" );
83
83
84
    C4::Context->set_preference( $preference, $value );
84
    C4::Context->set_preference( $preference, $value );
85
    logaction( 'SYSTEMPREFERENCE', 'MODIFY', undef, $preference . " | " . $value );
86
}
85
}
87
86
88
sub GetPreferences {
87
sub GetPreferences {
(-)a/svc/config/systempreferences (-2 lines)
Lines 64-70 sub set_preference { Link Here
64
    unless ( C4::Context->config('demo') ) {
64
    unless ( C4::Context->config('demo') ) {
65
        my $value = join( ',', $query->param( 'value' ) );
65
        my $value = join( ',', $query->param( 'value' ) );
66
        C4::Context->set_preference( $preference, $value );
66
        C4::Context->set_preference( $preference, $value );
67
        logaction( 'SYSTEMPREFERENCE', 'MODIFY', undef, $preference . " | " . $value );
68
    }
67
    }
69
68
70
    C4::Service->return_success( $response );
69
    C4::Service->return_success( $response );
Lines 98-104 sub set_preferences { Link Here
98
            my $value = join( ',', $query->param( $param ) );
97
            my $value = join( ',', $query->param( $param ) );
99
98
100
            C4::Context->set_preference( $pref, $value );
99
            C4::Context->set_preference( $pref, $value );
101
            logaction( 'SYSTEMPREFERENCE', 'MODIFY', undef, $pref . " | " . $value );
102
        }
100
        }
103
    }
101
    }
104
102
(-)a/t/db_dependent/Context.t (-2 / +9 lines)
Lines 24-30 BEGIN { Link Here
24
ok($dbh = C4::Context->dbh(), 'Getting dbh from C4::Context');
24
ok($dbh = C4::Context->dbh(), 'Getting dbh from C4::Context');
25
25
26
$dbh->begin_work;
26
$dbh->begin_work;
27
C4::Context->disable_syspref_cache();
28
C4::Context->set_preference('OPACBaseURL','junk');
27
C4::Context->set_preference('OPACBaseURL','junk');
29
C4::Context->clear_syspref_cache();
28
C4::Context->clear_syspref_cache();
30
my $OPACBaseURL = C4::Context->preference('OPACBaseURL');
29
my $OPACBaseURL = C4::Context->preference('OPACBaseURL');
Lines 99-107 $trace_read = q{}; Link Here
99
98
100
C4::Context->enable_syspref_cache();
99
C4::Context->enable_syspref_cache();
101
is(C4::Context->preference("SillyPreference"), 'thing3', "Retrieved syspref (value='thing3') successfully from cache");
100
is(C4::Context->preference("SillyPreference"), 'thing3', "Retrieved syspref (value='thing3') successfully from cache");
102
is( $trace_read, q{}, 'Did not retrieve syspref from database');
101
isnt( $trace_read, q{}, 'The pref should be retrieved from the database if the cache has been enabled');
103
$trace_read = q{};
102
$trace_read = q{};
104
103
104
# FIXME This was added by Robin and does not pass anymore
105
# I don't understand why we should expect thing1 while thing3 is in the cache and in the DB
106
#$dbh->{mock_clear_history} = 1;
107
## This gives us the value that was cached on the first call, when the cache was active.
108
#is(C4::Context->preference("SillyPreference"), 'thing1', "Retrieved syspref (value='thing1') successfully from cache");
109
#$history = $dbh->{mock_all_history};
110
#is(scalar(@{$history}), 0, 'Did not retrieve syspref from database');
111
105
$silly_preference->set( { value => 'thing4' } )->store();
112
$silly_preference->set( { value => 'thing4' } )->store();
106
C4::Context->clear_syspref_cache();
113
C4::Context->clear_syspref_cache();
107
is(C4::Context->preference("SillyPreference"), 'thing4', "Retrieved syspref (value='thing4') successfully after clearing cache");
114
is(C4::Context->preference("SillyPreference"), 'thing4', "Retrieved syspref (value='thing4') successfully after clearing cache");
(-)a/t/db_dependent/sysprefs.t (-2 / +14 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 => 5;
22
use Test::More tests => 8;
23
use C4::Context;
23
use C4::Context;
24
24
25
# Start transaction
25
# Start transaction
Lines 48-50 is( C4::Context->preference('IDoNotExist'), undef, 'Get a non-existent system pr Link Here
48
48
49
C4::Context->set_preference( 'IDoNotExist', 'NonExistent' );
49
C4::Context->set_preference( 'IDoNotExist', 'NonExistent' );
50
is( C4::Context->preference('IDoNotExist'), 'NonExistent', 'Test creation of non-existent system preference' );
50
is( C4::Context->preference('IDoNotExist'), 'NonExistent', 'Test creation of non-existent system preference' );
51
- 
51
52
C4::Context->set_preference('testpreference', 'abc');
53
C4::Context->delete_preference('testpreference');
54
is(C4::Context->preference('testpreference'), undef, 'deleting preferences');
55
56
C4::Context->set_preference('testpreference', 'def');
57
# Delete from the database, it should still be in cache
58
$dbh->do("DELETE FROM systempreferences WHERE variable='testpreference'");
59
is(C4::Context->preference('testpreference'), 'def', 'caching preferences');
60
C4::Context->clear_syspref_cache();
61
is(C4::Context->preference('testpreference'), undef, 'clearing preference cache');
62
63
$dbh->rollback;

Return to bug 11998