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

(-)a/C4/Installer.pm (-4 / +2 lines)
Lines 460-469 sub set_marcflavour_syspref { Link Here
460
    # marc_cleaned finds the marcflavour, without the variant.
460
    # marc_cleaned finds the marcflavour, without the variant.
461
    my $marc_cleaned = 'MARC21';
461
    my $marc_cleaned = 'MARC21';
462
    $marc_cleaned = 'UNIMARC' if $marcflavour =~ /unimarc/i;
462
    $marc_cleaned = 'UNIMARC' if $marcflavour =~ /unimarc/i;
463
    my $request =
463
    my $request = $self->{'dbh'}
464
        $self->{'dbh'}->prepare(
464
        ->prepare("INSERT IGNORE INTO `systempreferences` (variable, value) VALUES('marcflavour', '$marc_cleaned')");
465
        "INSERT IGNORE INTO `systempreferences` (variable,value,explanation,options,type) VALUES('marcflavour','$marc_cleaned','Define global MARC flavor (MARC21 or UNIMARC) used for character encoding','MARC21|UNIMARC','Choice');"
466
        );
467
    $request->execute;
465
    $request->execute;
468
}
466
}
469
467
(-)a/Koha/Config/SysPrefs.pm (-4 / +156 lines)
Lines 18-28 package Koha::Config::SysPrefs; Link Here
18
# along with Koha; if not, see <https://www.gnu.org/licenses>.
18
# along with Koha; if not, see <https://www.gnu.org/licenses>.
19
19
20
use Modern::Perl;
20
use Modern::Perl;
21
21
use YAML::XS qw(LoadFile);
22
use Koha::Database;
23
22
24
use Koha::Config::SysPref;
23
use Koha::Config::SysPref;
25
24
25
use Koha::Config;
26
27
use C4::Templates qw(themelanguage);
28
26
use base qw(Koha::Objects);
29
use base qw(Koha::Objects);
27
30
28
=head1 NAME
31
=head1 NAME
Lines 31-41 Koha::Config::SysPrefs - Koha System Preference object set class Link Here
31
34
32
=head1 API
35
=head1 API
33
36
34
=head2 Class Methods
37
=head2 Instance methods
38
39
=head3 get_pref_files
40
41
my $files = Koha::config::SysPrefs->get_pref_files();
42
43
Return a hashref containing the list of the yml/pref files in admin/preferences
44
45
=cut
46
47
sub get_pref_files {
48
    my ( $self, $lang ) = @_;
49
50
    my $htdocs = Koha::Config->get_instance->get('intrahtdocs');
51
    my ($theme) = C4::Templates::themelanguage( $htdocs, 'admin/preferences/admin.pref', 'intranet', undef, $lang );
52
53
    my $pref_files = {};
54
    foreach my $file ( glob("$htdocs/$theme/$lang/modules/admin/preferences/*.pref") ) {
55
        my ($tab) = ( $file =~ /([a-z0-9_-]+)\.pref$/ );
56
57
        # There is a local_use.pref file but it should not be needed
58
        next if $tab eq 'local_use';
59
        $pref_files->{$tab} = $file;
60
    }
61
62
    return $pref_files;
63
}
64
65
=head3 get_all_from_yml
66
67
my $all_sysprefs = Koha::Config::SysPrefs->get_all_from_yml;
68
69
Return the system preferences information contained in the yml/pref files
70
The result is cached!
71
72
eg. for AcqCreateItem
73
{
74
    category_name   "Policy",
75
    choices         {
76
        cataloguing   "cataloging the record.",
77
        ordering      "placing an order.",
78
        receiving     "receiving an order."
79
    },
80
    chunks          [
81
        [0] "Create an item when",
82
        [1] {
83
                choices   var{choices},
84
                pref      "AcqCreateItem"
85
            },
86
        [2] "This is only the default behavior, and can be changed per-basket."
87
    ],
88
    default         undef,
89
    description     [
90
        [0] "Create an item when",
91
        [1] "This is only the default behavior, and can be changed per-basket."
92
    ],
93
    name            "AcqCreateItem",
94
    tab_id          "acquisitions",
95
    tab_name        "Acquisitions",
96
    type            "select"
97
}
98
99
=cut
100
101
sub get_all_from_yml {
102
    my ( $self, $lang ) = @_;
103
104
    $lang //= "en";
105
106
    my $cache     = Koha::Caches->get_instance("sysprefs");
107
    my $cache_key = "all:${lang}";
108
    my $all_prefs = $cache->get_from_cache($cache_key);
109
110
    unless ($all_prefs) {
111
112
        my $pref_files = Koha::Config::SysPrefs->new->get_pref_files($lang);
113
114
        $all_prefs = {};
115
116
        while ( my ( $tab, $filepath ) = each %$pref_files ) {
117
            my $yml = LoadFile($filepath);
118
119
            if ( scalar keys %$yml != 1 ) {
120
121
                # FIXME Move this to an xt test
122
                die "malformed pref file ($filepath), only one top level key expected";
123
            }
124
125
            for my $tab_name ( sort keys %$yml ) {
126
                for my $category_name ( sort keys %{ $yml->{$tab_name} } ) {
127
                    for my $pref_entry ( @{ $yml->{$tab_name}->{$category_name} } ) {
128
                        my $pref = {
129
                            tab_id        => $tab,
130
                            tab_name      => $tab_name,
131
                            category_name => $category_name,
132
                        };
133
                        for my $entry (@$pref_entry) {
134
                            push @{ $pref->{chunks} }, $entry;
135
                            if ( ref $entry ) {
136
137
                                # get class if type is not defined
138
                                # e.g. for OPACHoldsIfAvailableAtPickupExceptions
139
                                my $type = $entry->{type} || $entry->{class};
140
                                if ( exists $entry->{choices} ) {
141
                                    $type = "select";
142
                                }
143
                                $type ||= "input";
144
                                if ( $pref->{name} ) {
145
                                    push @{ $pref->{grouped_prefs} }, {
146
                                        name    => $entry->{pref},
147
                                        choices => $entry->{choices},
148
                                        default => $entry->{default},
149
                                        type    => $type,
150
                                    };
151
                                    push @{ $pref->{description} }, $entry->{pref};
152
                                } else {
153
                                    $pref->{name}    = $entry->{pref};
154
                                    $pref->{choices} = $entry->{choices};
155
                                    $pref->{default} = $entry->{default};
156
                                    $pref->{type}    = $type;
157
                                }
158
                            } else {
159
                                unless ( defined $entry ) {
160
                                    die sprintf "Invalid description for pref %s", $pref->{name};
161
                                }
162
                                push @{ $pref->{description} }, $entry;
163
                            }
164
                        }
165
                        unless ( $pref->{name} ) {
166
167
                            # At least one "NOTE:" is expected here
168
                            next;
169
                        }
170
                        $all_prefs->{ $pref->{name} } = $pref;
171
                        if ( $pref->{grouped_prefs} ) {
172
                            for my $grouped_pref ( @{ $pref->{grouped_prefs} } ) {
173
                                $all_prefs->{ $grouped_pref->{name} } = { %$pref, %$grouped_pref };
174
                            }
175
                        }
176
                    }
177
                }
178
            }
179
        }
180
181
        $cache->set_in_cache( $cache_key, $all_prefs );
182
    }
183
    return $all_prefs;
184
}
185
186
=head2 Class methods
35
187
36
=cut
188
=cut
37
189
38
=head3 type
190
=head3 _type
39
191
40
=cut
192
=cut
41
193
(-)a/Koha/Devel/Sysprefs.pm (+108 lines)
Line 0 Link Here
1
package Koha::Devel::Sysprefs;
2
3
use Modern::Perl;
4
use File::Slurp qw(read_file write_file);
5
6
use C4::Context;
7
8
=head1 NAME
9
10
Koha::Devel::Sysprefs
11
12
=head1 DESCRIPTION
13
14
Handle system preferences operations for developers.
15
16
=cut
17
18
=head1 API
19
20
=cut
21
22
=head2 new
23
24
my $syspref_handler = Koha::Devel::Sysprefs->new();
25
26
Constructor
27
28
=cut
29
30
sub new {
31
    my ( $class, $args ) = @_;
32
    $args ||= {};
33
34
    unless ( $args->{filepath} ) {
35
        $args->{filepath} = sprintf "%s/installer/data/mysql/mandatory/sysprefs.sql",
36
            C4::Context->config('intranetdir');
37
    }
38
    my $self = bless $args, $class;
39
    return $self;
40
}
41
42
=head2 extract_syspref_from_line
43
44
my $pref = $syspref_handler->extract_syspref_from_line($line);
45
46
Parse a line from sysprefs.sql and return a hashref containing the different syspref's values
47
48
=cut
49
50
sub extract_syspref_from_line {
51
    my ( $self, $line ) = @_;
52
53
    if (
54
        $line    =~ /^INSERT INTO /    # first line
55
        || $line =~ /^;$/              # last line
56
        || $line =~ /^--/              # Comment line
57
        )
58
    {
59
        return;
60
    }
61
62
    if (
63
        $line =~ m/
64
            '(?<variable>[^'\\]*(?:\\.[^'\\]*)*)',\s*
65
            '(?<value>[^'\\]*(?:\\.[^'\\]*)*)'
66
        /xms
67
        )
68
    {
69
        my $variable = $+{variable};
70
        my $value    = $+{value};
71
72
        return {
73
            variable => $variable,
74
            value    => $value,
75
        };
76
    } else {
77
        warn "Invalid line: $line";
78
    }
79
    return {};
80
}
81
82
=head2 get_sysprefs_from_file
83
84
my @sysprefs = $syspref_handler->get_sysprefs_from_file();
85
86
Return an array of sysprefs from the SQL file used to populate the system preferences DB table.
87
88
=cut
89
90
sub get_sysprefs_from_file {
91
    my ($self) = @_;
92
    my @sysprefs;
93
    my @lines = read_file( $self->{filepath} ) or die "Can't open $self->{filepath}: $!";
94
    for my $line (@lines) {
95
        chomp $line;
96
97
        # FIXME Explode if already exists?
98
        my $syspref = $self->extract_syspref_from_line($line);
99
        if ( $syspref && exists $syspref->{variable} ) {
100
            push @sysprefs, $syspref;
101
        } elsif ( defined $syspref ) {
102
            die "$line does not match";
103
        }
104
    }
105
    return @sysprefs;
106
}
107
108
1;
(-)a/installer/data/mysql/atomicupdate/bug_41834.pl (+71 lines)
Line 0 Link Here
1
use Modern::Perl;
2
use Koha::Installer::Output qw(say_warning say_success say_info);
3
use File::Slurp             qw(read_file);
4
5
return {
6
    bug_number  => "41834",
7
    description => "NULL systempreferences's options, explanation and type",
8
    up          => sub {
9
        my ($args) = @_;
10
        my ( $dbh, $out ) = @$args{qw(dbh out)};
11
12
        # First fix some discrepancies
13
14
        # from updatedatabase.pl 20.12.00.009
15
        # UseICUStyleQUotes vs UseICUStyleQuotes
16
        $dbh->do(
17
            q{
18
                UPDATE systempreferences
19
                SET variable="UseICUStyleQuotes"
20
                WHERE BINARY variable="UseICUStyleQUotes"
21
            }
22
        );
23
24
        # from db_revs/211200012.pl
25
        # Syspref was not deleted if no value set
26
        $dbh->do(
27
            q{
28
            DELETE FROM systempreferences WHERE variable='OpacMoreSearches'
29
        }
30
        );
31
32
        # from db_revs/211200020.pl
33
        # Syspref was not deleted if no value set
34
        $dbh->do(
35
            q{
36
            DELETE FROM systempreferences WHERE variable='OPACMySummaryNote'
37
        }
38
        );
39
40
        # Then remove NULL the 3 columns for sysprefs listed in sysprefs.sql
41
        my $sysprefs_filepath = sprintf "%s/installer/data/mysql/mandatory/sysprefs.sql",
42
            C4::Context->config('intranetdir');
43
        my @lines = read_file($sysprefs_filepath) or die "Can't open $sysprefs_filepath: $!";
44
        my @sysprefs;
45
        for my $line (@lines) {
46
            chomp $line;
47
            next if $line =~ /^INSERT INTO /;    # first line
48
            next if $line =~ /^;$/;              # last line
49
            next if $line =~ /^--/;              # Comment line
50
            if (
51
                $line =~ m/
52
                '(?<variable>[^'\\]*(?:\\.[^'\\]*)*)',\s*
53
            /xms
54
                )
55
            {
56
                push @sysprefs, $+{variable};
57
            } else {
58
                die "$line does not match";
59
            }
60
        }
61
62
        my $updated = $dbh->do(
63
            q{
64
            UPDATE systempreferences
65
            SET options=NULL, explanation=NULL, type=NULL
66
            WHERE variable IN (} . join( q{,}, map { q{?} } @sysprefs ) . q{)}, undef, @sysprefs
67
        );
68
69
        say $out sprintf "Updated %s system preferences", $updated;
70
    },
71
};
(-)a/koha-tmpl/intranet-tmpl/prog/en/modules/admin/preferences/cataloguing.pref (-1 / +1 lines)
Lines 76-82 Cataloging: Link Here
76
                  1: Show
76
                  1: Show
77
                  0:  "Don't show"
77
                  0:  "Don't show"
78
            - buttons on the bibliographic details page to print item spine labels.
78
            - buttons on the bibliographic details page to print item spine labels.
79
        -
79
80
    Record structure:
80
    Record structure:
81
        -
81
        -
82
            - "Fill in the default language for field 008 Range 35-37 of MARC21 records (e.g. eng, nor, ger, see <a href='http://www.loc.gov/marc/languages/language_code.html'>MARC Code List for Languages</a>):"
82
            - "Fill in the default language for field 008 Range 35-37 of MARC21 records (e.g. eng, nor, ger, see <a href='http://www.loc.gov/marc/languages/language_code.html'>MARC Code List for Languages</a>):"
(-)a/koha-tmpl/intranet-tmpl/prog/en/modules/admin/preferences/circulation.pref (-6 / +1 lines)
Lines 696-702 Circulation: Link Here
696
              multiple:
696
              multiple:
697
                intransit: In-transit
697
                intransit: In-transit
698
                checkedout: Checked out
698
                checkedout: Checked out
699
            -
700
        -
699
        -
701
            - pref: BlockReturnOfLostItems
700
            - pref: BlockReturnOfLostItems
702
              choices:
701
              choices:
Lines 921-927 Circulation: Link Here
921
                  1: in random order.
920
                  1: in random order.
922
                  0: in that order.
921
                  0: in that order.
923
            - "<br><strong>NOTE:</strong> This system preference requires the <code>misc/cronjobs/holds/build_holds_queue.pl</code> cronjob. Ask your system administrator to schedule it."
922
            - "<br><strong>NOTE:</strong> This system preference requires the <code>misc/cronjobs/holds/build_holds_queue.pl</code> cronjob. Ask your system administrator to schedule it."
924
            -
925
        -
923
        -
926
            - pref: canreservefromotherbranches
924
            - pref: canreservefromotherbranches
927
              choices:
925
              choices:
Lines 1431-1437 Circulation: Link Here
1431
                date: Date
1429
                date: Date
1432
                pages: Pages
1430
                pages: Pages
1433
                chapters: Chapters
1431
                chapters: Chapters
1434
            -
1435
        -
1432
        -
1436
            - "For records that are only record level requestable, make the following fields mandatory:"
1433
            - "For records that are only record level requestable, make the following fields mandatory:"
1437
            - pref: ArticleRequestsMandatoryFieldsRecordOnly
1434
            - pref: ArticleRequestsMandatoryFieldsRecordOnly
Lines 1443-1449 Circulation: Link Here
1443
                date: Date
1440
                date: Date
1444
                pages: Pages
1441
                pages: Pages
1445
                chapters: Chapters
1442
                chapters: Chapters
1446
            -
1447
        -
1443
        -
1448
            - "For records that are only item level requestable, make the following fields mandatory:"
1444
            - "For records that are only item level requestable, make the following fields mandatory:"
1449
            - pref: ArticleRequestsMandatoryFieldsItemOnly
1445
            - pref: ArticleRequestsMandatoryFieldsItemOnly
Lines 1455-1461 Circulation: Link Here
1455
                date: Date
1451
                date: Date
1456
                pages: Pages
1452
                pages: Pages
1457
                chapters: Chapters
1453
                chapters: Chapters
1458
            -
1459
        -
1454
        -
1460
            - "The following article request formats are supported:"
1455
            - "The following article request formats are supported:"
1461
            - pref: ArticleRequestsSupportedFormats
1456
            - pref: ArticleRequestsSupportedFormats
Lines 1524-1530 Circulation: Link Here
1524
        -
1519
        -
1525
            - Mark a recall as problematic if it has been waiting to be picked up for
1520
            - Mark a recall as problematic if it has been waiting to be picked up for
1526
            - pref: RecallsMaxPickUpDelay
1521
            - pref: RecallsMaxPickUpDelay
1527
            - class: integer
1522
              class: integer
1528
            - days.
1523
            - days.
1529
        -
1524
        -
1530
            - pref: UseRecalls
1525
            - pref: UseRecalls
(-)a/t/db_dependent/check_sysprefs.t (-138 / +67 lines)
Lines 19-211 Link Here
19
19
20
use Modern::Perl;
20
use Modern::Perl;
21
21
22
use File::Slurp qw(read_file);
23
use C4::Context;
24
use Array::Utils qw(array_minus);
22
use Array::Utils qw(array_minus);
25
23
26
use Test::NoWarnings;
24
use Test::NoWarnings;
27
use Test::More tests => 3;
25
use Test::More tests => 3;
28
26
27
use C4::Context;
28
29
use Koha::Devel::Sysprefs;
30
use Koha::Config::SysPrefs;
31
29
our $dbh = C4::Context->dbh;
32
our $dbh = C4::Context->dbh;
30
my $intranetdir      = C4::Context->config('intranetdir');
33
my $intranetdir = C4::Context->config('intranetdir');
31
my $root_dir         = $intranetdir . '/installer/data/mysql/mandatory';
32
my $syspref_filepath = "$root_dir/sysprefs.sql";
33
34
34
my @lines            = read_file($syspref_filepath) or die "Can't open $syspref_filepath: $!";
35
my @exceptions = qw(
35
my @sysprefs_in_file = get_sysprefs_from_file(@lines);
36
    marcflavour
37
    ElasticsearchIndexStatus_authorities
38
    ElasticsearchIndexStatus_biblios
39
    OPACdidyoumean
40
    UsageStatsID
41
    UsageStatsLastUpdateTime
42
    UsageStatsPublicID
43
);
44
45
my @sysprefs_in_sql_file = Koha::Devel::Sysprefs->new->get_sysprefs_from_file();
36
46
37
subtest 'Compare database with sysprefs.sql file' => sub {
47
subtest 'Compare database with sysprefs.sql file' => sub {
38
    ok( scalar(@sysprefs_in_file), "Found sysprefs" );
48
    ok( scalar(@sysprefs_in_sql_file), "Found sysprefs" );
39
49
40
    check_db(@sysprefs_in_file);
50
    check_db(@sysprefs_in_sql_file);
41
};
51
};
42
52
43
subtest 'Compare sysprefs.sql with YAML files' => sub {
53
subtest 'Compare sysprefs.sql with YAML files' => sub {
44
    plan tests => 2;
54
    plan tests => 2;
45
55
46
    my $yaml_prefs = get_syspref_from_yaml();
56
    my $yaml_prefs                  = Koha::Config::SysPrefs->get_all_from_yml;
47
    my @yaml_mod   = @$yaml_prefs;
57
    my @syspref_names_in_yaml_files = keys %$yaml_prefs;
48
    @yaml_mod = grep !/marcflavour/, @yaml_mod;    # Added by web installer
58
    @syspref_names_in_yaml_files = array_minus @syspref_names_in_yaml_files, @exceptions;
49
59
50
    my @syspref_names_in_file = map { $_->{variable} } @sysprefs_in_file;
60
    my @syspref_names_in_sql_file = map { $_->{variable} } @sysprefs_in_sql_file;
51
    @syspref_names_in_file = grep !/ElasticsearchIndexStatus_authorities/,
61
    @syspref_names_in_sql_file = array_minus @syspref_names_in_sql_file, @exceptions;
52
        @syspref_names_in_file;                    # Not to be changed manually
62
53
    @syspref_names_in_file = grep !/ElasticsearchIndexStatus_biblios/,
63
    my @missing_yaml = array_minus( @syspref_names_in_sql_file, @syspref_names_in_yaml_files );
54
        @syspref_names_in_file;                    # Not to be changed manually
55
    @syspref_names_in_file = grep !/OPACdidyoumean/,           @syspref_names_in_file;    # Separate configuration page
56
    @syspref_names_in_file = grep !/UsageStatsID/,             @syspref_names_in_file;    # Separate configuration page
57
    @syspref_names_in_file = grep !/UsageStatsLastUpdateTime/, @syspref_names_in_file;    # Separate configuration page
58
    @syspref_names_in_file = grep !/UsageStatsPublicID/,       @syspref_names_in_file;    # Separate configuration page
59
60
    my @missing_yaml = array_minus( @syspref_names_in_file, @yaml_mod );
61
    is( scalar @missing_yaml, 0, "No system preference entries missing from sysprefs.sql" );
64
    is( scalar @missing_yaml, 0, "No system preference entries missing from sysprefs.sql" );
62
    if ( scalar @missing_yaml > 0 ) {
65
    if ( scalar @missing_yaml > 0 ) {
63
        diag "System preferences missing from YAML:\n  * " . join( "\n  * ", @missing_yaml ) . "\n";
66
        diag "System preferences missing from YAML:\n  * " . join( "\n  * ", @missing_yaml ) . "\n";
64
    }
67
    }
65
68
66
    my @missing_sysprefs = array_minus( @yaml_mod, @syspref_names_in_file );
69
    my @missing_sysprefs = array_minus( @syspref_names_in_yaml_files, @syspref_names_in_sql_file );
67
    is( scalar @missing_sysprefs, 0, "No system preference entries missing from YAML files" );
70
    is( scalar @missing_sysprefs, 0, "No system preference entries missing from YAML files" );
68
    if ( scalar @missing_sysprefs > 0 ) {
71
    if ( scalar @missing_sysprefs > 0 ) {
69
        diag "System preferences missing from sysprefs.sql:\n  * " . join( "\n  * ", @missing_sysprefs ) . "\n";
72
        diag "System preferences missing from sysprefs.sql:\n  * " . join( "\n  * ", @missing_sysprefs ) . "\n";
70
    }
73
    }
71
};
74
};
72
75
73
# Get sysprefs from SQL file populating sysprefs table with INSERT statement.
74
#
75
# Example:
76
# INSERT INTO `systempreferences` (variable,value,explanation,options,type)
77
# VALUES('AmazonLocale','US','Use to set the Locale of your Amazon.com Web Services',
78
# 'US|CA|DE|FR|JP|UK','Choice')
79
#
80
sub get_sysprefs_from_file {
81
    my @lines = @_;
82
    my @sysprefs;
83
    for my $line (@lines) {
84
        chomp $line;
85
        next if $line =~ /^INSERT INTO /;    # first line
86
        next if $line =~ /^;$/;              # last line
87
        next if $line =~ /^--/;              # Comment line
88
        if (
89
            $line =~ m/
90
            '(?<variable>[^'\\]*(?:\\.[^'\\]*)*)',\s*
91
            '(?<value>[^'\\]*(?:\\.[^'\\]*)*)',\s*
92
            (?<options>NULL|'(?<options_content>[^'\\]*(?:\\.[^'\\]*)*)'),\s*
93
            (?<explanation>NULL|'(?<explanation_content>[^'\\]*(?:\\.[^'\\]*)*)'),\s*
94
            (?<type>NULL|'(?<type_content>[^'\\]*(?:\\.[^'\\]*)*)')
95
        /xms
96
            )
97
        {
98
            my $variable    = $+{variable};
99
            my $value       = $+{value};
100
            my $options     = $+{options_content};
101
            my $explanation = $+{explanation_content};
102
            my $type        = $+{type_content};
103
104
            if ($options) {
105
                $options =~ s/\\'/'/g;
106
                $options =~ s/\\\\/\\/g;
107
            }
108
            if ($explanation) {
109
                $explanation =~ s/\\'/'/g;
110
                $explanation =~ s/\\n/\n/g;
111
            }
112
113
            # FIXME Explode if already exists?
114
            push @sysprefs, {
115
                variable    => $variable,
116
                value       => $value,
117
                options     => $options,
118
                explanation => $explanation,
119
                type        => $type,
120
            };
121
        } else {
122
            die "$line does not match";
123
        }
124
    }
125
    return @sysprefs;
126
}
127
128
#  Get system preferences from YAML files
129
sub get_syspref_from_yaml {
130
    my @prefs;
131
    foreach my $file ( glob( $intranetdir . "/koha-tmpl/intranet-tmpl/prog/en/modules/admin/preferences/*.pref" ) ) {
132
        if ( open( my $fh, '<:encoding(UTF-8)', $file ) ) {
133
            while ( my $row = <$fh> ) {
134
                chomp $row;
135
                my $pref;
136
                if ( $row =~ /pref: (.*)/ ) {
137
                    $pref = $1;
138
                    $pref =~ s/["']//ig;
139
                    push @prefs, $pref;
140
                }
141
            }
142
        } else {
143
            warn "Could not open file '$file' $!";
144
        }
145
    }
146
    return \@prefs;
147
}
148
149
sub check_db {
76
sub check_db {
150
    my @sysprefs_from_file = @_;
77
    my @sysprefs_from_file = @_;
151
78
152
    # FIXME FrameworksLoaded is a temporary syspref created during the installation process
79
    # FIXME FrameworksLoaded is a temporary syspref created during the installation process
153
    # We should either rewrite the code to avoid its need, or delete it once the installation is finished.
80
    # We should either rewrite the code to avoid its need, or delete it once the installation is finished.
154
    my $sysprefs_in_db = $dbh->selectall_hashref(
81
    my $sysprefs_in_db = $dbh->selectall_arrayref(
155
        q{
82
        q{
156
        SELECT * from systempreferences
83
        SELECT * from systempreferences
157
        WHERE variable <> 'FrameworksLoaded'
84
        WHERE variable NOT IN ('marcflavour', 'Version', 'FrameworksLoaded')
158
    }, 'variable'
85
        ORDER BY variable
86
    }, { Slice => {} }
159
    );
87
    );
160
88
89
    my $yaml_prefs = Koha::Config::SysPrefs->get_all_from_yml;
90
161
    # Checking the number of sysprefs in the database
91
    # Checking the number of sysprefs in the database
162
    my @syspref_names_in_db   = keys %$sysprefs_in_db;
92
    my @syspref_names_in_db       = map { $_->{variable} } @$sysprefs_in_db;
163
    my @syspref_names_in_file = map { $_->{variable} } @sysprefs_in_file;
93
    my @syspref_names_in_sql_file = map { $_->{variable} } @sysprefs_in_sql_file;
164
    my @diff                  = array_minus @syspref_names_in_db, @syspref_names_in_file;
94
    my @diff                      = array_minus @syspref_names_in_db, @syspref_names_in_sql_file;
165
    is_deeply( [ sort @diff ], [ 'Version', 'marcflavour' ] )
95
    is( scalar(@diff), 0 )
166
        or diag sprintf( "Too many sysprefs in DB: %s", join ", ", @diff );
96
        or diag sprintf( "Too many sysprefs in DB: %s", join ", ", @diff );
167
97
168
    my @sorted_names_in_file = sort {
98
    is_deeply( \@syspref_names_in_sql_file, \@syspref_names_in_db, 'Syspref in sysprefs.sql must be sorted by name' );
169
        $b =~ s/_/ZZZ/g;    # mysql sorts underscore last, if you modify this qa-test-tools will need adjustments
99
    for my $pref (@sysprefs_in_sql_file) {
170
        lc($a) cmp lc($b)
100
        my ($in_db)   = grep { $_->{variable} eq $pref->{variable} } @$sysprefs_in_db;
171
    } @syspref_names_in_file;
172
    is_deeply( \@syspref_names_in_file, \@sorted_names_in_file, 'Syspref in sysprefs.sql must be sorted by name' );
173
    for my $pref (@sysprefs_in_file) {
174
        my $in_db     = $sysprefs_in_db->{ $pref->{variable} };
175
        my %db_copy   = %$in_db;
101
        my %db_copy   = %$in_db;
176
        my %file_copy = %$pref;
102
        my %file_copy = %$pref;
177
        delete $db_copy{value};
103
        delete $db_copy{value};
178
        delete $file_copy{value};
104
        delete $file_copy{value};
179
105
180
        if ( $pref->{variable} =~ m{^ElasticsearchIndexStatus_} ) {
106
        delete $db_copy{options};
181
107
        delete $db_copy{explanation};
182
            # Exception for the 2 sysprefs ElasticsearchIndexStatus_authorities and ElasticsearchIndexStatus_biblios
108
        delete $db_copy{type};
183
            # They do not have a type defined
184
            # Will deal with them on a follow-up bugs
185
            next;
186
        }
187
109
188
        # Do not compare values, they can differ (new vs existing installs)
110
        # Do not compare values, they can differ (new vs existing installs)
189
        is_deeply( \%db_copy, \%file_copy, sprintf "Comparing %s", $pref->{variable} );
111
        is_deeply( \%db_copy, \%file_copy, sprintf "Comparing %s", $pref->{variable} );
190
        if ( !defined $pref->{type} ) {
112
        if ( defined $in_db->{options} ) {
191
            fail( sprintf "%s does not have a type in file!", $pref->{variable} );
113
            fail( sprintf "%s has 'options' set in DB, must be NULL!", $in_db->{variable} );
192
        }
114
        }
193
        if ( !defined $in_db->{type} ) {
115
        if ( defined $in_db->{explanation} ) {
194
            fail( sprintf "%s does not have a type in DB!", $in_db->{variable} );
116
            fail( sprintf "%s has 'explanation' set in DB, must be NULL!", $in_db->{variable} );
195
        }
117
        }
196
        if ( $pref->{type} && $pref->{type} eq 'YesNo' ) {
118
        if ( defined $in_db->{type} ) {
197
            like(
119
            fail( sprintf "%s has 'type' set in DB, must be NULL!", $in_db->{variable} );
198
                $pref->{value}, qr{^(0|1)$},
199
                sprintf( "Pref %s must be 0 or 1, found=%s in file", $pref->{variable}, $pref->{value} ),
200
            );
201
            like(
202
                $in_db->{value}, qr{^(0|1)$},
203
                sprintf( "Pref %s must be 0 or 1, found=%s in DB", $in_db->{variable}, $in_db->{value} ),
204
            );
205
        }
120
        }
206
121
207
        # TODO Check on valid 'type'
122
        next if grep { $_ eq $pref->{variable} } @exceptions;
208
        #like($pref->{type}, qr{^()$});
123
124
        my $yaml_pref = $yaml_prefs->{ $pref->{variable} };
125
        if ( $yaml_pref->{type} eq 'select' && ref( $yaml_pref->{choices} ) ) {
126
            my @choices = sort keys %{ $yaml_pref->{choices} };
127
            if ( scalar(@choices) == 2 && $choices[0] eq "0" && $choices[1] eq "1" ) {
128
                like(
129
                    $pref->{value}, qr{^(0|1)$},
130
                    sprintf( "Pref %s must be 0 or 1, found=%s in file", $pref->{variable}, $pref->{value} ),
131
                );
132
                like(
133
                    $in_db->{value}, qr{^(0|1)$},
134
                    sprintf( "Pref %s must be 0 or 1, found=%s in DB", $in_db->{variable}, $in_db->{value} ),
135
                );
136
137
            }
138
        }
209
    }
139
    }
210
}
140
}
211
141
212
- 

Return to bug 41834