Bugzilla – Attachment 192289 Details for
Bug 41746
Add a dev script to insert a new syspref
Home
|
New
|
Browse
|
Search
|
[?]
|
Reports
|
Help
|
New Account
|
Log In
[x]
|
Forgot Password
Login:
[x]
[patch]
Bug 41746: misc/devel/add_syspref.pl
0d67082.patch (text/plain), 11.61 KB, created by
Jonathan Druart
on 2026-02-02 11:12:01 UTC
(
hide
)
Description:
Bug 41746: misc/devel/add_syspref.pl
Filename:
MIME Type:
Creator:
Jonathan Druart
Created:
2026-02-02 11:12:01 UTC
Size:
11.61 KB
patch
obsolete
>From 0d67082afed18a91e330c38b540f895168762175 Mon Sep 17 00:00:00 2001 >From: Jonathan Druart <jonathan.druart@bugs.koha-community.org> >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/ >+ '(?<variable>[^'\\]*(?:\\.[^'\\]*)*)',\s* >+ '(?<value>[^'\\]*(?:\\.[^'\\]*)*)',\s* >+ (?<options>NULL|'(?<options_content>[^'\\]*(?:\\.[^'\\]*)*)'),\s* >+ (?<explanation>NULL|'(?<explanation_content>[^'\\]*(?:\\.[^'\\]*)*)'),\s* >+ (?<type>NULL|'(?<type_content>[^'\\]*(?:\\.[^'\\]*)*)') >+ /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/ >- '(?<variable>[^'\\]*(?:\\.[^'\\]*)*)',\s* >- '(?<value>[^'\\]*(?:\\.[^'\\]*)*)',\s* >- (?<options>NULL|'(?<options_content>[^'\\]*(?:\\.[^'\\]*)*)'),\s* >- (?<explanation>NULL|'(?<explanation_content>[^'\\]*(?:\\.[^'\\]*)*)'),\s* >- (?<type>NULL|'(?<type_content>[^'\\]*(?:\\.[^'\\]*)*)') >- /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 = <STDIN>; >+ 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 >
You cannot view the attachment while viewing its details because your browser does not support IFRAMEs.
View the attachment on a separate page
.
View Attachment As Diff
View Attachment As Raw
Actions:
View
|
Diff
|
Splinter Review
Attachments on
bug 41746
:
192288
| 192289 |
192290
|
192291
|
192292