diff --git a/C4/Installer.pm b/C4/Installer.pm index 7dd124fba5..1391ed791d 100644 --- a/C4/Installer.pm +++ b/C4/Installer.pm @@ -460,10 +460,8 @@ sub set_marcflavour_syspref { # marc_cleaned finds the marcflavour, without the variant. my $marc_cleaned = 'MARC21'; $marc_cleaned = 'UNIMARC' if $marcflavour =~ /unimarc/i; - my $request = - $self->{'dbh'}->prepare( - "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');" - ); + my $request = $self->{'dbh'} + ->prepare("INSERT IGNORE INTO `systempreferences` (variable, value) VALUES('marcflavour', '$marc_cleaned')"); $request->execute; } diff --git a/Koha/Config/SysPrefs.pm b/Koha/Config/SysPrefs.pm index ec92745e00..1c87e2ce03 100644 --- a/Koha/Config/SysPrefs.pm +++ b/Koha/Config/SysPrefs.pm @@ -18,11 +18,14 @@ package Koha::Config::SysPrefs; # along with Koha; if not, see . use Modern::Perl; - -use Koha::Database; +use YAML::XS qw(LoadFile); use Koha::Config::SysPref; +use Koha::Config; + +use C4::Templates qw(themelanguage); + use base qw(Koha::Objects); =head1 NAME @@ -31,11 +34,160 @@ Koha::Config::SysPrefs - Koha System Preference object set class =head1 API -=head2 Class Methods +=head2 Instance methods + +=head3 get_pref_files + +my $files = Koha::config::SysPrefs->get_pref_files(); + +Return a hashref containing the list of the yml/pref files in admin/preferences =cut -=head3 type +sub get_pref_files { + my ( $self, $lang ) = @_; + + my $htdocs = Koha::Config->get_instance->get('intrahtdocs'); + my ($theme) = C4::Templates::themelanguage( $htdocs, 'admin/preferences/admin.pref', 'intranet', undef, $lang ); + + my $pref_files = {}; + foreach my $file ( glob("$htdocs/$theme/$lang/modules/admin/preferences/*.pref") ) { + my ($tab) = ( $file =~ /([a-z0-9_-]+)\.pref$/ ); + + # There is a local_use.pref file but it should not be needed + next if $tab eq 'local_use'; + $pref_files->{$tab} = $file; + } + + return $pref_files; +} + +=head3 get_all_from_yml + +my $all_sysprefs = Koha::Config::SysPrefs->get_all_from_yml; + +Return the system preferences information contained in the yml/pref files +The result is cached! + +eg. for AcqCreateItem +{ + category_name "Policy", + choices { + cataloguing "cataloging the record.", + ordering "placing an order.", + receiving "receiving an order." + }, + chunks [ + [0] "Create an item when", + [1] { + choices var{choices}, + pref "AcqCreateItem" + }, + [2] "This is only the default behavior, and can be changed per-basket." + ], + default undef, + description [ + [0] "Create an item when", + [1] "This is only the default behavior, and can be changed per-basket." + ], + name "AcqCreateItem", + tab_id "acquisitions", + tab_name "Acquisitions", + type "select" +} + +=cut + +sub get_all_from_yml { + my ( $self, $lang ) = @_; + + $lang //= "en"; + + my $cache = Koha::Caches->get_instance("sysprefs"); + my $cache_key = "all:${lang}"; + my $all_prefs = $cache->get_from_cache($cache_key); + + unless ($all_prefs) { + + my $pref_files = Koha::Config::SysPrefs->new->get_pref_files($lang); + + $all_prefs = {}; + + while ( my ( $tab, $filepath ) = each %$pref_files ) { + my $yml = LoadFile($filepath); + + if ( scalar keys %$yml != 1 ) { + + # FIXME Move this to an xt test + die "malformed pref file ($filepath), only one top level key expected"; + } + + for my $tab_name ( sort keys %$yml ) { + for my $category_name ( sort keys %{ $yml->{$tab_name} } ) { + for my $pref_entry ( @{ $yml->{$tab_name}->{$category_name} } ) { + my $pref = { + tab_id => $tab, + tab_name => $tab_name, + category_name => $category_name, + }; + for my $entry (@$pref_entry) { + push @{ $pref->{chunks} }, $entry; + if ( ref $entry ) { + + # get class if type is not defined + # e.g. for OPACHoldsIfAvailableAtPickupExceptions + my $type = $entry->{type} || $entry->{class}; + if ( exists $entry->{choices} ) { + $type = "select"; + } + $type ||= "input"; + if ( $pref->{name} ) { + push @{ $pref->{grouped_prefs} }, { + name => $entry->{pref}, + choices => $entry->{choices}, + default => $entry->{default}, + type => $type, + }; + push @{ $pref->{description} }, $entry->{pref}; + } else { + $pref->{name} = $entry->{pref}; + $pref->{choices} = $entry->{choices}; + $pref->{default} = $entry->{default}; + $pref->{type} = $type; + } + } else { + unless ( defined $entry ) { + die sprintf "Invalid description for pref %s", $pref->{name}; + } + push @{ $pref->{description} }, $entry; + } + } + unless ( $pref->{name} ) { + + # At least one "NOTE:" is expected here + next; + } + $all_prefs->{ $pref->{name} } = $pref; + if ( $pref->{grouped_prefs} ) { + for my $grouped_pref ( @{ $pref->{grouped_prefs} } ) { + $all_prefs->{ $grouped_pref->{name} } = { %$pref, %$grouped_pref }; + } + } + } + } + } + } + + $cache->set_in_cache( $cache_key, $all_prefs ); + } + return $all_prefs; +} + +=head2 Class methods + +=cut + +=head3 _type =cut diff --git a/Koha/Devel/Sysprefs.pm b/Koha/Devel/Sysprefs.pm new file mode 100644 index 0000000000..056bfafa01 --- /dev/null +++ b/Koha/Devel/Sysprefs.pm @@ -0,0 +1,108 @@ +package Koha::Devel::Sysprefs; + +use Modern::Perl; +use File::Slurp qw(read_file write_file); + +use C4::Context; + +=head1 NAME + +Koha::Devel::Sysprefs + +=head1 DESCRIPTION + +Handle system preferences operations for developers. + +=cut + +=head1 API + +=cut + +=head2 new + +my $syspref_handler = Koha::Devel::Sysprefs->new(); + +Constructor + +=cut + +sub new { + my ( $class, $args ) = @_; + $args ||= {}; + + unless ( $args->{filepath} ) { + $args->{filepath} = sprintf "%s/installer/data/mysql/mandatory/sysprefs.sql", + C4::Context->config('intranetdir'); + } + my $self = bless $args, $class; + 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* + '(?[^'\\]*(?:\\.[^'\\]*)*)' + /xms + ) + { + my $variable = $+{variable}; + my $value = $+{value}; + + return { + variable => $variable, + value => $value, + }; + } else { + warn "Invalid line: $line"; + } + return {}; +} + +=head2 get_sysprefs_from_file + +my @sysprefs = $syspref_handler->get_sysprefs_from_file(); + +Return an array of sysprefs from the SQL file used to populate the system preferences DB table. + +=cut + +sub get_sysprefs_from_file { + my ($self) = @_; + my @sysprefs; + my @lines = read_file( $self->{filepath} ) or die "Can't open $self->{filepath}: $!"; + for my $line (@lines) { + chomp $line; + + # FIXME Explode if already exists? + my $syspref = $self->extract_syspref_from_line($line); + if ( $syspref && exists $syspref->{variable} ) { + push @sysprefs, $syspref; + } elsif ( defined $syspref ) { + die "$line does not match"; + } + } + return @sysprefs; +} + +1; diff --git a/installer/data/mysql/atomicupdate/bug_41834.pl b/installer/data/mysql/atomicupdate/bug_41834.pl new file mode 100755 index 0000000000..7464b17818 --- /dev/null +++ b/installer/data/mysql/atomicupdate/bug_41834.pl @@ -0,0 +1,71 @@ +use Modern::Perl; +use Koha::Installer::Output qw(say_warning say_success say_info); +use File::Slurp qw(read_file); + +return { + bug_number => "41834", + description => "NULL systempreferences's options, explanation and type", + up => sub { + my ($args) = @_; + my ( $dbh, $out ) = @$args{qw(dbh out)}; + + # First fix some discrepancies + + # from updatedatabase.pl 20.12.00.009 + # UseICUStyleQUotes vs UseICUStyleQuotes + $dbh->do( + q{ + UPDATE systempreferences + SET variable="UseICUStyleQuotes" + WHERE BINARY variable="UseICUStyleQUotes" + } + ); + + # from db_revs/211200012.pl + # Syspref was not deleted if no value set + $dbh->do( + q{ + DELETE FROM systempreferences WHERE variable='OpacMoreSearches' + } + ); + + # from db_revs/211200020.pl + # Syspref was not deleted if no value set + $dbh->do( + q{ + DELETE FROM systempreferences WHERE variable='OPACMySummaryNote' + } + ); + + # Then remove NULL the 3 columns for sysprefs listed in sysprefs.sql + my $sysprefs_filepath = sprintf "%s/installer/data/mysql/mandatory/sysprefs.sql", + C4::Context->config('intranetdir'); + my @lines = read_file($sysprefs_filepath) or die "Can't open $sysprefs_filepath: $!"; + my @sysprefs; + 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* + /xms + ) + { + push @sysprefs, $+{variable}; + } else { + die "$line does not match"; + } + } + + my $updated = $dbh->do( + q{ + UPDATE systempreferences + SET options=NULL, explanation=NULL, type=NULL + WHERE variable IN (} . join( q{,}, map { q{?} } @sysprefs ) . q{)}, undef, @sysprefs + ); + + say $out sprintf "Updated %s system preferences", $updated; + }, +}; diff --git a/koha-tmpl/intranet-tmpl/prog/en/modules/admin/preferences/cataloguing.pref b/koha-tmpl/intranet-tmpl/prog/en/modules/admin/preferences/cataloguing.pref index e2831bcb38..816dcb9695 100644 --- a/koha-tmpl/intranet-tmpl/prog/en/modules/admin/preferences/cataloguing.pref +++ b/koha-tmpl/intranet-tmpl/prog/en/modules/admin/preferences/cataloguing.pref @@ -76,7 +76,7 @@ Cataloging: 1: Show 0: "Don't show" - buttons on the bibliographic details page to print item spine labels. - - + Record structure: - - "Fill in the default language for field 008 Range 35-37 of MARC21 records (e.g. eng, nor, ger, see MARC Code List for Languages):" diff --git a/koha-tmpl/intranet-tmpl/prog/en/modules/admin/preferences/circulation.pref b/koha-tmpl/intranet-tmpl/prog/en/modules/admin/preferences/circulation.pref index 29d80b0e20..804e088c17 100644 --- a/koha-tmpl/intranet-tmpl/prog/en/modules/admin/preferences/circulation.pref +++ b/koha-tmpl/intranet-tmpl/prog/en/modules/admin/preferences/circulation.pref @@ -696,7 +696,6 @@ Circulation: multiple: intransit: In-transit checkedout: Checked out - - - - pref: BlockReturnOfLostItems choices: @@ -921,7 +920,6 @@ Circulation: 1: in random order. 0: in that order. - "
NOTE: This system preference requires the misc/cronjobs/holds/build_holds_queue.pl cronjob. Ask your system administrator to schedule it." - - - - pref: canreservefromotherbranches choices: @@ -1431,7 +1429,6 @@ Circulation: date: Date pages: Pages chapters: Chapters - - - - "For records that are only record level requestable, make the following fields mandatory:" - pref: ArticleRequestsMandatoryFieldsRecordOnly @@ -1443,7 +1440,6 @@ Circulation: date: Date pages: Pages chapters: Chapters - - - - "For records that are only item level requestable, make the following fields mandatory:" - pref: ArticleRequestsMandatoryFieldsItemOnly @@ -1455,7 +1451,6 @@ Circulation: date: Date pages: Pages chapters: Chapters - - - - "The following article request formats are supported:" - pref: ArticleRequestsSupportedFormats @@ -1524,7 +1519,7 @@ Circulation: - - Mark a recall as problematic if it has been waiting to be picked up for - pref: RecallsMaxPickUpDelay - - class: integer + class: integer - days. - - pref: UseRecalls diff --git a/t/db_dependent/check_sysprefs.t b/t/db_dependent/check_sysprefs.t index afe4eccc50..3a29375a82 100755 --- a/t/db_dependent/check_sysprefs.t +++ b/t/db_dependent/check_sysprefs.t @@ -19,193 +19,123 @@ use Modern::Perl; -use File::Slurp qw(read_file); -use C4::Context; use Array::Utils qw(array_minus); use Test::NoWarnings; use Test::More tests => 3; -our $dbh = C4::Context->dbh; -my $intranetdir = C4::Context->config('intranetdir'); -my $root_dir = $intranetdir . '/installer/data/mysql/mandatory'; -my $syspref_filepath = "$root_dir/sysprefs.sql"; +use C4::Context; -my @lines = read_file($syspref_filepath) or die "Can't open $syspref_filepath: $!"; -my @sysprefs_in_file = get_sysprefs_from_file(@lines); +use Koha::Devel::Sysprefs; +use Koha::Config::SysPrefs; + +our $dbh = C4::Context->dbh; +my $intranetdir = C4::Context->config('intranetdir'); + +my @exceptions = qw( + marcflavour + ElasticsearchIndexStatus_authorities + ElasticsearchIndexStatus_biblios + OPACdidyoumean + UsageStatsID + UsageStatsLastUpdateTime + UsageStatsPublicID +); + +my @sysprefs_in_sql_file = Koha::Devel::Sysprefs->new->get_sysprefs_from_file(); subtest 'Compare database with sysprefs.sql file' => sub { - ok( scalar(@sysprefs_in_file), "Found sysprefs" ); + ok( scalar(@sysprefs_in_sql_file), "Found sysprefs" ); - check_db(@sysprefs_in_file); + check_db(@sysprefs_in_sql_file); }; subtest 'Compare sysprefs.sql with YAML files' => sub { plan tests => 2; - my $yaml_prefs = get_syspref_from_yaml(); - my @yaml_mod = @$yaml_prefs; - @yaml_mod = grep !/marcflavour/, @yaml_mod; # Added by web installer + my $yaml_prefs = Koha::Config::SysPrefs->get_all_from_yml; + my @syspref_names_in_yaml_files = keys %$yaml_prefs; + @syspref_names_in_yaml_files = array_minus @syspref_names_in_yaml_files, @exceptions; - my @syspref_names_in_file = map { $_->{variable} } @sysprefs_in_file; - @syspref_names_in_file = grep !/ElasticsearchIndexStatus_authorities/, - @syspref_names_in_file; # Not to be changed manually - @syspref_names_in_file = grep !/ElasticsearchIndexStatus_biblios/, - @syspref_names_in_file; # Not to be changed manually - @syspref_names_in_file = grep !/OPACdidyoumean/, @syspref_names_in_file; # Separate configuration page - @syspref_names_in_file = grep !/UsageStatsID/, @syspref_names_in_file; # Separate configuration page - @syspref_names_in_file = grep !/UsageStatsLastUpdateTime/, @syspref_names_in_file; # Separate configuration page - @syspref_names_in_file = grep !/UsageStatsPublicID/, @syspref_names_in_file; # Separate configuration page + my @syspref_names_in_sql_file = map { $_->{variable} } @sysprefs_in_sql_file; + @syspref_names_in_sql_file = array_minus @syspref_names_in_sql_file, @exceptions; - my @missing_yaml = array_minus( @syspref_names_in_file, @yaml_mod ); + my @missing_yaml = array_minus( @syspref_names_in_sql_file, @syspref_names_in_yaml_files ); is( scalar @missing_yaml, 0, "No system preference entries missing from sysprefs.sql" ); if ( scalar @missing_yaml > 0 ) { diag "System preferences missing from YAML:\n * " . join( "\n * ", @missing_yaml ) . "\n"; } - my @missing_sysprefs = array_minus( @yaml_mod, @syspref_names_in_file ); + my @missing_sysprefs = array_minus( @syspref_names_in_yaml_files, @syspref_names_in_sql_file ); is( scalar @missing_sysprefs, 0, "No system preference entries missing from YAML files" ); if ( scalar @missing_sysprefs > 0 ) { diag "System preferences missing from sysprefs.sql:\n * " . join( "\n * ", @missing_sysprefs ) . "\n"; } }; -# Get sysprefs from SQL file populating sysprefs table with INSERT statement. -# -# Example: -# INSERT INTO `systempreferences` (variable,value,explanation,options,type) -# VALUES('AmazonLocale','US','Use to set the Locale of your Amazon.com Web Services', -# 'US|CA|DE|FR|JP|UK','Choice') -# -sub get_sysprefs_from_file { - my @lines = @_; - my @sysprefs; - 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? - push @sysprefs, { - variable => $variable, - value => $value, - options => $options, - explanation => $explanation, - type => $type, - }; - } else { - die "$line does not match"; - } - } - return @sysprefs; -} - -# Get system preferences from YAML files -sub get_syspref_from_yaml { - my @prefs; - foreach my $file ( glob( $intranetdir . "/koha-tmpl/intranet-tmpl/prog/en/modules/admin/preferences/*.pref" ) ) { - if ( open( my $fh, '<:encoding(UTF-8)', $file ) ) { - while ( my $row = <$fh> ) { - chomp $row; - my $pref; - if ( $row =~ /pref: (.*)/ ) { - $pref = $1; - $pref =~ s/["']//ig; - push @prefs, $pref; - } - } - } else { - warn "Could not open file '$file' $!"; - } - } - return \@prefs; -} - sub check_db { my @sysprefs_from_file = @_; # FIXME FrameworksLoaded is a temporary syspref created during the installation process # We should either rewrite the code to avoid its need, or delete it once the installation is finished. - my $sysprefs_in_db = $dbh->selectall_hashref( + my $sysprefs_in_db = $dbh->selectall_arrayref( q{ SELECT * from systempreferences - WHERE variable <> 'FrameworksLoaded' - }, 'variable' + WHERE variable NOT IN ('marcflavour', 'Version', 'FrameworksLoaded') + ORDER BY variable + }, { Slice => {} } ); + my $yaml_prefs = Koha::Config::SysPrefs->get_all_from_yml; + # Checking the number of sysprefs in the database - my @syspref_names_in_db = keys %$sysprefs_in_db; - my @syspref_names_in_file = map { $_->{variable} } @sysprefs_in_file; - my @diff = array_minus @syspref_names_in_db, @syspref_names_in_file; - is_deeply( [ sort @diff ], [ 'Version', 'marcflavour' ] ) + my @syspref_names_in_db = map { $_->{variable} } @$sysprefs_in_db; + my @syspref_names_in_sql_file = map { $_->{variable} } @sysprefs_in_sql_file; + my @diff = array_minus @syspref_names_in_db, @syspref_names_in_sql_file; + is( scalar(@diff), 0 ) 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) - } @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) { - my $in_db = $sysprefs_in_db->{ $pref->{variable} }; + is_deeply( \@syspref_names_in_sql_file, \@syspref_names_in_db, 'Syspref in sysprefs.sql must be sorted by name' ); + for my $pref (@sysprefs_in_sql_file) { + my ($in_db) = grep { $_->{variable} eq $pref->{variable} } @$sysprefs_in_db; my %db_copy = %$in_db; my %file_copy = %$pref; delete $db_copy{value}; delete $file_copy{value}; - if ( $pref->{variable} =~ m{^ElasticsearchIndexStatus_} ) { - - # Exception for the 2 sysprefs ElasticsearchIndexStatus_authorities and ElasticsearchIndexStatus_biblios - # They do not have a type defined - # Will deal with them on a follow-up bugs - next; - } + delete $db_copy{options}; + delete $db_copy{explanation}; + delete $db_copy{type}; # Do not compare values, they can differ (new vs existing installs) is_deeply( \%db_copy, \%file_copy, sprintf "Comparing %s", $pref->{variable} ); - if ( !defined $pref->{type} ) { - fail( sprintf "%s does not have a type in file!", $pref->{variable} ); + if ( defined $in_db->{options} ) { + fail( sprintf "%s has 'options' set in DB, must be NULL!", $in_db->{variable} ); } - if ( !defined $in_db->{type} ) { - fail( sprintf "%s does not have a type in DB!", $in_db->{variable} ); + if ( defined $in_db->{explanation} ) { + fail( sprintf "%s has 'explanation' set in DB, must be NULL!", $in_db->{variable} ); } - if ( $pref->{type} && $pref->{type} eq 'YesNo' ) { - like( - $pref->{value}, qr{^(0|1)$}, - sprintf( "Pref %s must be 0 or 1, found=%s in file", $pref->{variable}, $pref->{value} ), - ); - like( - $in_db->{value}, qr{^(0|1)$}, - sprintf( "Pref %s must be 0 or 1, found=%s in DB", $in_db->{variable}, $in_db->{value} ), - ); + if ( defined $in_db->{type} ) { + fail( sprintf "%s has 'type' set in DB, must be NULL!", $in_db->{variable} ); } - # TODO Check on valid 'type' - #like($pref->{type}, qr{^()$}); + next if grep { $_ eq $pref->{variable} } @exceptions; + + my $yaml_pref = $yaml_prefs->{ $pref->{variable} }; + if ( $yaml_pref->{type} eq 'select' && ref( $yaml_pref->{choices} ) ) { + my @choices = sort keys %{ $yaml_pref->{choices} }; + if ( scalar(@choices) == 2 && $choices[0] eq "0" && $choices[1] eq "1" ) { + like( + $pref->{value}, qr{^(0|1)$}, + sprintf( "Pref %s must be 0 or 1, found=%s in file", $pref->{variable}, $pref->{value} ), + ); + like( + $in_db->{value}, qr{^(0|1)$}, + sprintf( "Pref %s must be 0 or 1, found=%s in DB", $in_db->{variable}, $in_db->{value} ), + ); + + } + } } }