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

(-)a/Koha/Devel/Sysprefs.pm (-36 / +106 lines)
Lines 1-7 Link Here
1
package Koha::Devel::Sysprefs;
1
package Koha::Devel::Sysprefs;
2
2
3
use Modern::Perl;
3
use Modern::Perl;
4
use File::Slurp qw(read_file);
4
use File::Slurp qw(read_file write_file);
5
6
use C4::Context;
5
7
6
=head1 NAME
8
=head1 NAME
7
9
Lines 37-42 sub new { Link Here
37
    return $self;
39
    return $self;
38
}
40
}
39
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>[^'\\]*(?:\\.[^'\\]*)*)',\s*
66
            (?<options>NULL|'(?<options_content>[^'\\]*(?:\\.[^'\\]*)*)'),\s*
67
            (?<explanation>NULL|'(?<explanation_content>[^'\\]*(?:\\.[^'\\]*)*)'),\s*
68
            (?<type>NULL|'(?<type_content>[^'\\]*(?:\\.[^'\\]*)*)')
69
        /xms
70
        )
71
    {
72
        my $variable    = $+{variable};
73
        my $value       = $+{value};
74
        my $options     = $+{options_content};
75
        my $explanation = $+{explanation_content};
76
        my $type        = $+{type_content};
77
78
        if ($options) {
79
            $options =~ s/\\'/'/g;
80
            $options =~ s/\\\\/\\/g;
81
        }
82
        if ($explanation) {
83
            $explanation =~ s/\\'/'/g;
84
            $explanation =~ s/\\n/\n/g;
85
        }
86
87
        return {
88
            variable    => $variable,
89
            value       => $value,
90
            options     => $options,
91
            explanation => $explanation,
92
            type        => $type,
93
        };
94
    }
95
    return {};
96
}
97
40
=head2 get_sysprefs_from_file
98
=head2 get_sysprefs_from_file
41
99
42
my @sysprefs = $syspref_handler->get_sysprefs_from_file();
100
my @sysprefs = $syspref_handler->get_sysprefs_from_file();
Lines 51-97 sub get_sysprefs_from_file { Link Here
51
    my @lines = read_file( $self->{filepath} ) or die "Can't open $self->{filepath}: $!";
109
    my @lines = read_file( $self->{filepath} ) or die "Can't open $self->{filepath}: $!";
52
    for my $line (@lines) {
110
    for my $line (@lines) {
53
        chomp $line;
111
        chomp $line;
54
        next if $line =~ /^INSERT INTO /;    # first line
112
55
        next if $line =~ /^;$/;              # last line
113
        # FIXME Explode if already exists?
56
        next if $line =~ /^--/;              # Comment line
114
        my $syspref = $self->extract_syspref_from_line($line);
57
        if (
115
        if ( $syspref && exists $syspref->{variable} ) {
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
116
82
            # FIXME Explode if already exists?
117
            # FIXME Explode if already exists?
83
            push @sysprefs, {
118
            push @sysprefs, $syspref;
84
                variable    => $variable,
119
        } elsif ( defined $syspref ) {
85
                value       => $value,
86
                options     => $options,
87
                explanation => $explanation,
88
                type        => $type,
89
            };
90
        } else {
91
            die "$line does not match";
120
            die "$line does not match";
92
        }
121
        }
93
    }
122
    }
94
    return @sysprefs;
123
    return @sysprefs;
95
}
124
}
96
125
126
=head2 add_new_pref
127
128
$syspref_handler->add_new_pref({variable => $variable, value => $value, options => $options, explanation => $explanation, type => $type});
129
130
Add new syspref to the sysprefs.sql file
131
132
=cut
133
134
sub add_new_pref {
135
    my ( $self, $new_syspref ) = @_;
136
    my @lines = read_file( $self->{filepath} ) or die "Can't open $self->{filepath}: $!";
137
    my @sysprefs;
138
    for my $line (@lines) {
139
        chomp $line;
140
141
        # FIXME Explode if already exists?
142
        my $syspref = $self->extract_syspref_from_line($line);
143
        push @sysprefs, { variable => $syspref ? $syspref->{variable} : undef, line => $line };
144
    }
145
146
    push @sysprefs,
147
        {
148
        variable => $new_syspref->{variable},
149
        line     => sprintf(
150
            "('%s', %s, %s, '%s', '%s'),", $new_syspref->{variable},
151
            ( defined $new_syspref->{value} ? "'$new_syspref->{value}'" : 'NULL' ),
152
            ( defined $new_syspref->{options} ? "'$new_syspref->{options}'" : 'NULL' ), $new_syspref->{explanation},
153
            $new_syspref->{type}
154
        )
155
        };
156
    @sysprefs = sort {
157
               defined $a->{variable}
158
            && defined $b->{variable}
159
            && ( lc( $a->{variable} ) =~ s/_/ZZZ/gr )
160
            cmp(
161
            lc( $b->{variable} ) =~
162
                s/_/ZZZ/gr )    # mysql sorts underscore last, if you modify this qa-test-tools will need adjustments
163
    } @sysprefs;
164
    write_file( $self->{filepath}, join( "\n", map { $_->{line} } @sysprefs ) );
165
}
166
97
1;
167
1;
(-)a/misc/devel/add_syspref.pl (+182 lines)
Line 0 Link Here
1
#!/usr/bin/env perl
2
use Modern::Perl;
3
use Getopt::Long;
4
use Pod::Usage;
5
use Try::Tiny;
6
use File::Slurp qw( read_file write_file );
7
8
use Koha::Devel::Sysprefs;
9
10
my ( $bug_number, $variable, $value, $options, $explanation, $type, $help );
11
12
GetOptions(
13
    'bug-number=s'  => \$bug_number,
14
    'variable=s'    => \$variable,
15
    'value=s'       => \$value,
16
    'options=s'     => \$options,
17
    'explanation=s' => \$explanation,
18
    'type=s'        => \$type,
19
    'help|?'        => \$help,
20
) or pod2usage(2);
21
22
pod2usage(1) if $help;
23
24
my $pref = {};
25
if ($variable) {
26
    $pref->{variable} = $variable;
27
}
28
if ( defined $value ) {
29
    $pref->{value} = $value eq 'NULL' ? undef : $value;
30
}
31
if ($options) {
32
    $pref->{options} = $options eq 'NULL' ? undef : $options;
33
}
34
if ($explanation) {
35
    $pref->{explanation} = $explanation;
36
}
37
if ($type) {
38
    $pref->{type} = $type;
39
}
40
41
#ill-backends
42
#ClassSources
43
#Themes
44
#Languages
45
my @choices = qw(
46
    Free
47
    YesNo
48
    Integer
49
    textarea
50
    Choice
51
    multiple
52
    multiple_sortable
53
);
54
55
while (
56
    !(
57
           defined $bug_number
58
        && exists $pref->{variable}
59
        && defined $pref->{variable}
60
        && exists $pref->{value}
61
        && exists $pref->{options}
62
        && exists $pref->{explanation}
63
        && defined $pref->{explanation}
64
        && exists $pref->{type}
65
        && defined $pref->{type}
66
    )
67
    )
68
{
69
    unless ( defined $bug_number ) {
70
        $bug_number = ask_bug();
71
    }
72
73
    unless ( defined $pref->{variable} ) {
74
        $pref->{variable} = ask_variable();
75
    }
76
    unless ( exists $pref->{value} ) {
77
        $pref->{value} = ask_value();
78
    }
79
    unless ( defined $type ) {
80
        $pref->{type} = ask_type();
81
    }
82
    if ( $pref->{type}
83
        && ( $pref->{type} eq 'Choice' || $pref->{type} eq 'multiple' || $pref->{type} eq 'multiple_sortable' ) )
84
    {
85
        $pref->{options} = ask_options();
86
    } else {
87
        $pref->{options} = undef;
88
    }
89
    unless ( defined $pref->{explanation} ) {
90
        $pref->{explanation} = ask_explanation();
91
    }
92
}
93
94
if ( $pref->{options} && !grep { $pref->{type} eq $_ } qw(Choice multiple multiple_sortable) ) {
95
    pod2usage("Options cannot be set if type is 'Choice' or 'multiple'");
96
}
97
98
if ( $pref->{type} eq 'free' ) {
99
    $pref->{type} = 'Free';
100
}
101
if ( $pref->{type} eq 'integer' ) {
102
    $pref->{type} = 'Integer';
103
}
104
105
if ( !grep { $_ eq $pref->{type} } @choices ) {
106
    pod2usage( sprintf "Type must be in (%s)", join( ', ', @choices ) );
107
}
108
109
my $new_pref_content = sprintf q{$dbh->do(
110
            q{
111
                INSERT IGNORE INTO systempreferences(variable, value, options, explanation, type)
112
                VALUES('%s', %s, %s, '%s', '%s')
113
            }
114
        ) == 1 && say $out "Added new system preference '%s'";
115
}, $pref->{variable}, ( defined $pref->{value} ? qq{'$pref->{value}'} : 'NULL' ),
116
    ( defined $pref->{options} ? qq{'$pref->{options}'} : 'NULL' ), $pref->{explanation}, $pref->{type},
117
    $pref->{variable};
118
my $atomic_filepath = "installer/data/mysql/atomicupdate/bug_${bug_number}.pl";
119
say "Adding syspref to sysprefs.sql and creating new atomicupdate file ($atomic_filepath)";
120
qx{cp installer/data/mysql/atomicupdate/skeleton.pl $atomic_filepath};
121
my $content = read_file($atomic_filepath);
122
$content =~ s#"BUG_NUMBER"#"$bug_number"#;
123
$content =~ s#say \$out "Added new system preference 'XXX'";#$new_pref_content#;
124
write_file( $atomic_filepath, $content );
125
126
Koha::Devel::Sysprefs->new->add_new_pref($pref);
127
128
sub ask_bug {
129
    my $bug;
130
    while ( !$bug || !$bug =~ /^\d+$/ ) {
131
        $bug = prompt("Bug number? ");
132
    }
133
    return $bug;
134
}
135
136
sub ask_variable {
137
    return prompt("Syspref name? ");
138
}
139
140
sub ask_value {
141
    my $input = prompt("Default value? ");
142
    return $input eq 'NULL' ? undef : $input;
143
}
144
145
sub ask_type {
146
    my $prompt = "Type?\n";
147
    for my $i ( 0 .. $#choices ) {
148
        $prompt .= "[" . ( $i + 1 ) . "] " . $choices[$i] . "\n";
149
    }
150
151
    my $input;
152
    while ( !$input ) {
153
        $input = prompt($prompt);
154
155
        if ( $input =~ /^\d+$/ && $input >= 1 && $input <= scalar @choices ) {
156
            $input = $choices[ $input - 1 ];
157
        } else {
158
            undef $input;
159
        }
160
    }
161
    return $input;
162
}
163
164
sub ask_options {
165
    return prompt("Options (separated by pipe)? ");
166
}
167
168
sub ask_explanation {
169
    my $explanation = prompt("Explanation? ");
170
    $explanation =~ s|'|\\'|g;
171
    return $explanation;
172
}
173
174
sub prompt {
175
    print shift;
176
    my $response;
177
    while ( !$response ) {
178
        $response = <STDIN>;
179
        chomp $response;
180
    }
181
    return $response;
182
}
(-)a/t/db_dependent/check_sysprefs.t (-3 / +4 lines)
Lines 110-117 sub check_db { Link Here
110
        or diag sprintf( "Too many sysprefs in DB: %s", join ", ", @diff );
110
        or diag sprintf( "Too many sysprefs in DB: %s", join ", ", @diff );
111
111
112
    my @sorted_names_in_file = sort {
112
    my @sorted_names_in_file = sort {
113
        $b =~ s/_/ZZZ/g;    # mysql sorts underscore last, if you modify this qa-test-tools will need adjustments
113
        ( lc($a) =~ s/_/ZZZ/gr )
114
        lc($a) cmp lc($b)
114
            cmp(
115
            lc($b) =~
116
                s/_/ZZZ/gr )    # mysql sorts underscore last, if you modify this qa-test-tools will need adjustments
115
    } @syspref_names_in_file;
117
    } @syspref_names_in_file;
116
    is_deeply( \@syspref_names_in_file, \@sorted_names_in_file, 'Syspref in sysprefs.sql must be sorted by name' );
118
    is_deeply( \@syspref_names_in_file, \@sorted_names_in_file, 'Syspref in sysprefs.sql must be sorted by name' );
117
    for my $pref (@sysprefs_in_file) {
119
    for my $pref (@sysprefs_in_file) {
118
- 

Return to bug 41746