From 0d67082afed18a91e330c38b540f895168762175 Mon Sep 17 00:00:00 2001 From: Jonathan Druart Date: Mon, 26 Jan 2026 16:35:24 +0100 Subject: [PATCH] Bug 41746: misc/devel/add_syspref.pl --- Koha/Devel/Sysprefs.pm | 142 ++++++++++++++++++------- misc/devel/add_syspref.pl | 182 ++++++++++++++++++++++++++++++++ t/db_dependent/check_sysprefs.t | 6 +- 3 files changed, 292 insertions(+), 38 deletions(-) create mode 100755 misc/devel/add_syspref.pl diff --git a/Koha/Devel/Sysprefs.pm b/Koha/Devel/Sysprefs.pm index cf550cf1a58..fd0ce134284 100644 --- a/Koha/Devel/Sysprefs.pm +++ b/Koha/Devel/Sysprefs.pm @@ -1,7 +1,9 @@ package Koha::Devel::Sysprefs; use Modern::Perl; -use File::Slurp qw(read_file); +use File::Slurp qw(read_file write_file); + +use C4::Context; =head1 NAME @@ -37,6 +39,62 @@ sub new { return $self; } +=head2 extract_syspref_from_line + +my $pref = $syspref_handler->extract_syspref_from_line($line); + +Parse a line from sysprefs.sql and return a hashref containing the different syspref's values + +=cut + +sub extract_syspref_from_line { + my ( $self, $line ) = @_; + + if ( + $line =~ /^INSERT INTO / # first line + || $line =~ /^;$/ # last line + || $line =~ /^--/ # Comment line + ) + { + return; + } + + if ( + $line =~ m/ + '(?[^'\\]*(?:\\.[^'\\]*)*)',\s* + '(?[^'\\]*(?:\\.[^'\\]*)*)',\s* + (?NULL|'(?[^'\\]*(?:\\.[^'\\]*)*)'),\s* + (?NULL|'(?[^'\\]*(?:\\.[^'\\]*)*)'),\s* + (?NULL|'(?[^'\\]*(?:\\.[^'\\]*)*)') + /xms + ) + { + my $variable = $+{variable}; + my $value = $+{value}; + my $options = $+{options_content}; + my $explanation = $+{explanation_content}; + my $type = $+{type_content}; + + if ($options) { + $options =~ s/\\'/'/g; + $options =~ s/\\\\/\\/g; + } + if ($explanation) { + $explanation =~ s/\\'/'/g; + $explanation =~ s/\\n/\n/g; + } + + return { + variable => $variable, + value => $value, + options => $options, + explanation => $explanation, + type => $type, + }; + } + return {}; +} + =head2 get_sysprefs_from_file my @sysprefs = $syspref_handler->get_sysprefs_from_file(); @@ -51,47 +109,59 @@ sub get_sysprefs_from_file { my @lines = read_file( $self->{filepath} ) or die "Can't open $self->{filepath}: $!"; for my $line (@lines) { chomp $line; - next if $line =~ /^INSERT INTO /; # first line - next if $line =~ /^;$/; # last line - next if $line =~ /^--/; # Comment line - if ( - $line =~ m/ - '(?[^'\\]*(?:\\.[^'\\]*)*)',\s* - '(?[^'\\]*(?:\\.[^'\\]*)*)',\s* - (?NULL|'(?[^'\\]*(?:\\.[^'\\]*)*)'),\s* - (?NULL|'(?[^'\\]*(?:\\.[^'\\]*)*)'),\s* - (?NULL|'(?[^'\\]*(?:\\.[^'\\]*)*)') - /xms - ) - { - my $variable = $+{variable}; - my $value = $+{value}; - my $options = $+{options_content}; - my $explanation = $+{explanation_content}; - my $type = $+{type_content}; - - if ($options) { - $options =~ s/\\'/'/g; - $options =~ s/\\\\/\\/g; - } - if ($explanation) { - $explanation =~ s/\\'/'/g; - $explanation =~ s/\\n/\n/g; - } + + # FIXME Explode if already exists? + my $syspref = $self->extract_syspref_from_line($line); + if ( $syspref && exists $syspref->{variable} ) { # FIXME Explode if already exists? - push @sysprefs, { - variable => $variable, - value => $value, - options => $options, - explanation => $explanation, - type => $type, - }; - } else { + push @sysprefs, $syspref; + } elsif ( defined $syspref ) { die "$line does not match"; } } return @sysprefs; } +=head2 add_new_pref + +$syspref_handler->add_new_pref({variable => $variable, value => $value, options => $options, explanation => $explanation, type => $type}); + +Add new syspref to the sysprefs.sql file + +=cut + +sub add_new_pref { + my ( $self, $new_syspref ) = @_; + my @lines = read_file( $self->{filepath} ) or die "Can't open $self->{filepath}: $!"; + my @sysprefs; + for my $line (@lines) { + chomp $line; + + # FIXME Explode if already exists? + my $syspref = $self->extract_syspref_from_line($line); + push @sysprefs, { variable => $syspref ? $syspref->{variable} : undef, line => $line }; + } + + push @sysprefs, + { + variable => $new_syspref->{variable}, + line => sprintf( + "('%s', %s, %s, '%s', '%s'),", $new_syspref->{variable}, + ( defined $new_syspref->{value} ? "'$new_syspref->{value}'" : 'NULL' ), + ( defined $new_syspref->{options} ? "'$new_syspref->{options}'" : 'NULL' ), $new_syspref->{explanation}, + $new_syspref->{type} + ) + }; + @sysprefs = sort { + defined $a->{variable} + && defined $b->{variable} + && ( lc( $a->{variable} ) =~ s/_/ZZZ/gr ) + cmp( + lc( $b->{variable} ) =~ + s/_/ZZZ/gr ) # mysql sorts underscore last, if you modify this qa-test-tools will need adjustments + } @sysprefs; + write_file( $self->{filepath}, join( "\n", map { $_->{line} } @sysprefs ) ); +} + 1; diff --git a/misc/devel/add_syspref.pl b/misc/devel/add_syspref.pl new file mode 100755 index 00000000000..99c3824cf75 --- /dev/null +++ b/misc/devel/add_syspref.pl @@ -0,0 +1,182 @@ +#!/usr/bin/env perl +use Modern::Perl; +use Getopt::Long; +use Pod::Usage; +use Try::Tiny; +use File::Slurp qw( read_file write_file ); + +use Koha::Devel::Sysprefs; + +my ( $bug_number, $variable, $value, $options, $explanation, $type, $help ); + +GetOptions( + 'bug-number=s' => \$bug_number, + 'variable=s' => \$variable, + 'value=s' => \$value, + 'options=s' => \$options, + 'explanation=s' => \$explanation, + 'type=s' => \$type, + 'help|?' => \$help, +) or pod2usage(2); + +pod2usage(1) if $help; + +my $pref = {}; +if ($variable) { + $pref->{variable} = $variable; +} +if ( defined $value ) { + $pref->{value} = $value eq 'NULL' ? undef : $value; +} +if ($options) { + $pref->{options} = $options eq 'NULL' ? undef : $options; +} +if ($explanation) { + $pref->{explanation} = $explanation; +} +if ($type) { + $pref->{type} = $type; +} + +#ill-backends +#ClassSources +#Themes +#Languages +my @choices = qw( + Free + YesNo + Integer + textarea + Choice + multiple + multiple_sortable +); + +while ( + !( + defined $bug_number + && exists $pref->{variable} + && defined $pref->{variable} + && exists $pref->{value} + && exists $pref->{options} + && exists $pref->{explanation} + && defined $pref->{explanation} + && exists $pref->{type} + && defined $pref->{type} + ) + ) +{ + unless ( defined $bug_number ) { + $bug_number = ask_bug(); + } + + unless ( defined $pref->{variable} ) { + $pref->{variable} = ask_variable(); + } + unless ( exists $pref->{value} ) { + $pref->{value} = ask_value(); + } + unless ( defined $type ) { + $pref->{type} = ask_type(); + } + if ( $pref->{type} + && ( $pref->{type} eq 'Choice' || $pref->{type} eq 'multiple' || $pref->{type} eq 'multiple_sortable' ) ) + { + $pref->{options} = ask_options(); + } else { + $pref->{options} = undef; + } + unless ( defined $pref->{explanation} ) { + $pref->{explanation} = ask_explanation(); + } +} + +if ( $pref->{options} && !grep { $pref->{type} eq $_ } qw(Choice multiple multiple_sortable) ) { + pod2usage("Options cannot be set if type is 'Choice' or 'multiple'"); +} + +if ( $pref->{type} eq 'free' ) { + $pref->{type} = 'Free'; +} +if ( $pref->{type} eq 'integer' ) { + $pref->{type} = 'Integer'; +} + +if ( !grep { $_ eq $pref->{type} } @choices ) { + pod2usage( sprintf "Type must be in (%s)", join( ', ', @choices ) ); +} + +my $new_pref_content = sprintf q{$dbh->do( + q{ + INSERT IGNORE INTO systempreferences(variable, value, options, explanation, type) + VALUES('%s', %s, %s, '%s', '%s') + } + ) == 1 && say $out "Added new system preference '%s'"; +}, $pref->{variable}, ( defined $pref->{value} ? qq{'$pref->{value}'} : 'NULL' ), + ( defined $pref->{options} ? qq{'$pref->{options}'} : 'NULL' ), $pref->{explanation}, $pref->{type}, + $pref->{variable}; +my $atomic_filepath = "installer/data/mysql/atomicupdate/bug_${bug_number}.pl"; +say "Adding syspref to sysprefs.sql and creating new atomicupdate file ($atomic_filepath)"; +qx{cp installer/data/mysql/atomicupdate/skeleton.pl $atomic_filepath}; +my $content = read_file($atomic_filepath); +$content =~ s#"BUG_NUMBER"#"$bug_number"#; +$content =~ s#say \$out "Added new system preference 'XXX'";#$new_pref_content#; +write_file( $atomic_filepath, $content ); + +Koha::Devel::Sysprefs->new->add_new_pref($pref); + +sub ask_bug { + my $bug; + while ( !$bug || !$bug =~ /^\d+$/ ) { + $bug = prompt("Bug number? "); + } + return $bug; +} + +sub ask_variable { + return prompt("Syspref name? "); +} + +sub ask_value { + my $input = prompt("Default value? "); + return $input eq 'NULL' ? undef : $input; +} + +sub ask_type { + my $prompt = "Type?\n"; + for my $i ( 0 .. $#choices ) { + $prompt .= "[" . ( $i + 1 ) . "] " . $choices[$i] . "\n"; + } + + my $input; + while ( !$input ) { + $input = prompt($prompt); + + if ( $input =~ /^\d+$/ && $input >= 1 && $input <= scalar @choices ) { + $input = $choices[ $input - 1 ]; + } else { + undef $input; + } + } + return $input; +} + +sub ask_options { + return prompt("Options (separated by pipe)? "); +} + +sub ask_explanation { + my $explanation = prompt("Explanation? "); + $explanation =~ s|'|\\'|g; + return $explanation; +} + +sub prompt { + print shift; + my $response; + while ( !$response ) { + $response = ; + chomp $response; + } + return $response; +} diff --git a/t/db_dependent/check_sysprefs.t b/t/db_dependent/check_sysprefs.t index 0d3a82c4bc9..746e8f3f38f 100755 --- a/t/db_dependent/check_sysprefs.t +++ b/t/db_dependent/check_sysprefs.t @@ -110,8 +110,10 @@ sub check_db { or diag sprintf( "Too many sysprefs in DB: %s", join ", ", @diff ); my @sorted_names_in_file = sort { - $b =~ s/_/ZZZ/g; # mysql sorts underscore last, if you modify this qa-test-tools will need adjustments - lc($a) cmp lc($b) + ( lc($a) =~ s/_/ZZZ/gr ) + cmp( + lc($b) =~ + s/_/ZZZ/gr ) # mysql sorts underscore last, if you modify this qa-test-tools will need adjustments } @syspref_names_in_file; is_deeply( \@syspref_names_in_file, \@sorted_names_in_file, 'Syspref in sysprefs.sql must be sorted by name' ); for my $pref (@sysprefs_in_file) { -- 2.43.0