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

(-)a/Koha/Devel/Sysprefs.pm (+97 lines)
Line 0 Link Here
1
package Koha::Devel::Sysprefs;
2
3
use Modern::Perl;
4
use File::Slurp qw(read_file);
5
6
=head1 NAME
7
8
Koha::Devel::Sysprefs
9
10
=head1 DESCRIPTION
11
12
Handle system preferences operations for developers.
13
14
=cut
15
16
=head1 API
17
18
=cut
19
20
=head2 new
21
22
my $syspref_handler = Koha::Devel::Sysprefs->new();
23
24
Constructor
25
26
=cut
27
28
sub new {
29
    my ( $class, $args ) = @_;
30
    $args ||= {};
31
32
    unless ( $args->{filepath} ) {
33
        $args->{filepath} = sprintf "%s/installer/data/mysql/mandatory/sysprefs.sql",
34
            C4::Context->config('intranetdir');
35
    }
36
    my $self = bless $args, $class;
37
    return $self;
38
}
39
40
=head2 get_sysprefs_from_file
41
42
my @sysprefs = $syspref_handler->get_sysprefs_from_file();
43
44
Return an array of sysprefs from the SQL file used to populate the system preferences DB table.
45
46
=cut
47
48
sub get_sysprefs_from_file {
49
    my ($self) = @_;
50
    my @sysprefs;
51
    my @lines = read_file( $self->{filepath} ) or die "Can't open $self->{filepath}: $!";
52
    for my $line (@lines) {
53
        chomp $line;
54
        next if $line =~ /^INSERT INTO /;    # first line
55
        next if $line =~ /^;$/;              # last line
56
        next if $line =~ /^--/;              # Comment line
57
        if (
58
            $line =~ m/
59
            '(?<variable>[^'\\]*(?:\\.[^'\\]*)*)',\s*
60
            '(?<value>[^'\\]*(?:\\.[^'\\]*)*)',\s*
61
            (?<options>NULL|'(?<options_content>[^'\\]*(?:\\.[^'\\]*)*)'),\s*
62
            (?<explanation>NULL|'(?<explanation_content>[^'\\]*(?:\\.[^'\\]*)*)'),\s*
63
            (?<type>NULL|'(?<type_content>[^'\\]*(?:\\.[^'\\]*)*)')
64
        /xms
65
            )
66
        {
67
            my $variable    = $+{variable};
68
            my $value       = $+{value};
69
            my $options     = $+{options_content};
70
            my $explanation = $+{explanation_content};
71
            my $type        = $+{type_content};
72
73
            if ($options) {
74
                $options =~ s/\\'/'/g;
75
                $options =~ s/\\\\/\\/g;
76
            }
77
            if ($explanation) {
78
                $explanation =~ s/\\'/'/g;
79
                $explanation =~ s/\\n/\n/g;
80
            }
81
82
            # FIXME Explode if already exists?
83
            push @sysprefs, {
84
                variable    => $variable,
85
                value       => $value,
86
                options     => $options,
87
                explanation => $explanation,
88
                type        => $type,
89
            };
90
        } else {
91
            die "$line does not match";
92
        }
93
    }
94
    return @sysprefs;
95
}
96
97
1;
(-)a/t/db_dependent/check_sysprefs.t (-63 / +6 lines)
Lines 19-38 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
29
our $dbh = C4::Context->dbh;
31
our $dbh = C4::Context->dbh;
30
my $intranetdir      = C4::Context->config('intranetdir');
32
my $intranetdir = C4::Context->config('intranetdir');
31
my $root_dir         = $intranetdir . '/installer/data/mysql/mandatory';
32
my $syspref_filepath = "$root_dir/sysprefs.sql";
33
33
34
my @lines            = read_file($syspref_filepath) or die "Can't open $syspref_filepath: $!";
34
my @sysprefs_in_file = Koha::Devel::Sysprefs->new->get_sysprefs_from_file();
35
my @sysprefs_in_file = get_sysprefs_from_file(@lines);
36
35
37
subtest 'Compare database with sysprefs.sql file' => sub {
36
subtest 'Compare database with sysprefs.sql file' => sub {
38
    ok( scalar(@sysprefs_in_file), "Found sysprefs" );
37
    ok( scalar(@sysprefs_in_file), "Found sysprefs" );
Lines 70-130 subtest 'Compare sysprefs.sql with YAML files' => sub { Link Here
70
    }
69
    }
71
};
70
};
72
71
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
72
#  Get system preferences from YAML files
129
sub get_syspref_from_yaml {
73
sub get_syspref_from_yaml {
130
    my @prefs;
74
    my @prefs;
131
- 

Return to bug 41746