From f1051836df6e4dde3eb9892e0555a5bc26540ecb Mon Sep 17 00:00:00 2001 From: root Date: Tue, 27 Aug 2024 10:14:44 +0300 Subject: [PATCH] Bug 37738 - Framework update accessibility for existing installations See misc/maintenance/marc_framework_diff.pl --help --- misc/maintenance/marc_framework_diff.pl | 492 ++++++++++++++++++++++++ 1 file changed, 492 insertions(+) create mode 100644 misc/maintenance/marc_framework_diff.pl diff --git a/misc/maintenance/marc_framework_diff.pl b/misc/maintenance/marc_framework_diff.pl new file mode 100644 index 0000000000..88ad6f7ff9 --- /dev/null +++ b/misc/maintenance/marc_framework_diff.pl @@ -0,0 +1,492 @@ +#!/usr/bin/perl + +# Copyright 2024 Hypernova Oy +# +# This file is part of Koha. +# +# Koha is free software; you can redistribute it and/or modify it +# under the terms of the GNU General Public License as published by +# the Free Software Foundation; either version 3 of the License, or +# (at your option) any later version. +# +# Koha is distributed in the hope that it will be useful, but +# WITHOUT ANY WARRANTY; without even the implied warranty of +# MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the +# GNU General Public License for more details. +# +# You should have received a copy of the GNU General Public License +# along with Koha; if not, see . + +use Modern::Perl; +use strict; +use warnings; + +use Getopt::Long qw( GetOptions :config no_ignore_case bundling); +use Data::Printer; +use Pod::Usage qw( pod2usage ); + +use Koha::Database; + +=head1 NAME + +marc_framework_diff.pl - Detect differences in MARC frameworks and reconcile them + +=head1 SYNOPSIS + +marc_framework_diff.pl + + Options: + --help or -h Brief usage message + --verbose or -v Integer, 0-4, Be more verbose + + Utility commands + --list-frameworkcodes List all framework codes in Koha as a csv, with more + verbosity dumps object attributes. + + Diff commands + --diff Activate diffing output. By default selects all + frameworks for diffing. + --attributes-exclude CSV String, eg. "display_order,maxlength". + Exclude these marc framework keys from comparison. + --frameworks-include CSV String, eg. "ACQ,,FA,BKS" + (Empty ,, selects the default framework). + Include these frameworks. + --frameworks-exclude CSV String, eg. "ACQ,FA" + (Empty ,, selects the default framework). + Exclude these frameworks. Can be used with + --frameworks-include + --ignore-undef When comparing values, undefined and "" and 0 compare + as equally undefined/unset/false. + --perly-false When comparing values, "" and 0 compare + as equally undefined/unset/false. + + Update commands + --update Activate the update feature. + --field String, eg. "245". MARC field within the framework. + --subfield String, eg. "a". MARC subfield within the framework. + --attribute String, eg. "hidden". Framework attribute to update. + --value String, eg. "yso_finto_finaf.pl". + Value to set to all of the selected frameworks. + +=head1 EXAMPLES + + marc_framework_diff.pl --list-frameworkcodes -v 1 + + # Update marc frameworks "KI,,KA,EK" field "810$t" attribute "hidden" with "0" + marc_framework_diff.pl --diff --attributes-exclude "display_order,maxlength" \ + --frameworks-include "KI,,KA,EK" --ignore-undef --perly-false \ + --update --field 810 --subfield t --attribute hidden --value 0 + +=cut + +binmode( STDOUT, ":encoding(UTF-8)" ); + +my %a; +GetOptions( + \%a, + 'help|h', + 'verbose|v:i', + + #Utility commands + 'list-frameworkcodes', + + #Diff commands + 'diff', + 'attributes-exclude:s', + 'frameworks-include:s', + 'frameworks-exclude:s', + 'ignore-undef', + 'perly-false', + + #Update commands + 'update', + 'field:s', + 'subfield:s', + 'attribute:s', + 'value:s', +) or pod2usage(2); +$a{verbose} = 0 unless exists $a{verbose}; +p(%a); + +pod2usage(1) if $a{help}; + +my $dbh = Koha::Database->schema->storage->dbh(); # Use DBD::MySQL for minimum headache +$dbh->{ShowErrorStatement} = 1; +$dbh->{RaiseError} = 1; + +my @colWidths = (3, 1, 16, 30); +sub col { + my ($position, $value) = @_; + my $width = $colWidths[$position]; + my $offset = $width - length($value); + return $value . (" " x $offset) if $offset > 0; + return substr($value, 0, $width); +} + +sub handle_cli_param_include_exclude { + my ($biblio_framework_codes) = @_; + + if ($a{'attributes-exclude'}) { + $a{'attributes-exclude'} =~ s/\s//gsm; + $a{'attributes-exclude'} = ','.$a{'attributes-exclude'}.','; + if ($a{verbose} > 1) { + print "- Attributes to exclude: $a{'attributes-exclude'}\n"; + } + } + + if ($a{'frameworks-include'}) { + $a{'frameworks-include'} =~ s/\s//gsm; + $a{'frameworks-include'} = ','.$a{'frameworks-include'}.','; + @$biblio_framework_codes = grep {$a{'frameworks-include'} =~ /,$_,/} @$biblio_framework_codes; + if ($a{verbose} > 1) { + print "- Included: @$biblio_framework_codes\n"; + } + } + + if ($a{'frameworks-exclude'}) { + $a{'frameworks-exclude'} =~ s/\s//gsm; + $a{'frameworks-exclude'} = ','.$a{'frameworks-exclude'}.','; + @$biblio_framework_codes = grep {$a{'frameworks-exclude'} !~ /,$_,/} @$biblio_framework_codes; + if ($a{verbose} > 1) { + print "- Excluded: @$biblio_framework_codes\n"; + } + } + + return $biblio_framework_codes; +} + +sub _check_where_filter { + my ($sql_where_filter) = @_; + $sql_where_filter = "" unless $sql_where_filter; + $sql_where_filter = "WHERE $sql_where_filter" if $sql_where_filter and $sql_where_filter !~ /WHERE/; + return $sql_where_filter; +} + +sub fetch_biblio_framework_codes { + my $sql = "SELECT DISTINCT(frameworkcode) FROM biblio_framework ORDER BY frameworkcode ASC;"; + print "SQL:> " . sql_dump($sql) . "\n" if $a{verbose}; + my $biblio_framework_codes = $dbh->selectcol_arrayref($sql); + push(@$biblio_framework_codes, ''); #The default framework is no longer in the biblio_frameworks-table + return $biblio_framework_codes; +} +sub fetch_biblio_frameworks { + my ($sql_where_filter) = @_; + $sql_where_filter = _check_where_filter($sql_where_filter); + my $sql = "SELECT * FROM biblio_framework $sql_where_filter ORDER BY frameworkcode ASC;"; + print "SQL:> " . sql_dump($sql) . "\n" if $a{verbose}; + my $biblio_frameworks = $dbh->selectall_arrayref($sql, { Slice => {} }); + push(@$biblio_frameworks, {frameworkcode => '', frameworktext => 'Default'}) if $sql_where_filter =~ /''/; #The default framework is no longer in the biblio_frameworks-table + return $biblio_frameworks; +} +sub fetch_marc_tag_structure { + my ($sql_where_filter) = @_; + $sql_where_filter = _check_where_filter($sql_where_filter); + my $sql = "SELECT * FROM marc_tag_structure $sql_where_filter GROUP BY frameworkcode ASC, tagfield ASC;"; + print "SQL:> " . sql_dump($sql) . "\n" if $a{verbose}; + return $dbh->selectall_arrayref($sql, { Slice => {} }); +} +sub fetch_marc_subfield_structure { + my ($sql_where_filter) = @_; + $sql_where_filter = _check_where_filter($sql_where_filter); + my $sql = "SELECT * FROM marc_subfield_structure $sql_where_filter GROUP BY frameworkcode ASC, tagfield ASC, tagsubfield ASC;"; + print "SQL:> " . sql_dump($sql) . "\n" if $a{verbose}; + return $dbh->selectall_arrayref($sql, { Slice => {} }); +} +sub fetch_data { + my $biblio_framework_codes = fetch_biblio_framework_codes(); + $biblio_framework_codes = handle_cli_param_include_exclude($biblio_framework_codes); + my $sql_where_filter = "WHERE frameworkcode IN ('" . join("','", @$biblio_framework_codes) . "')"; + + my $biblio_frameworks = fetch_biblio_frameworks($sql_where_filter); + if ($a{verbose} > 1) { + print "Biblio frameworks:\n"; + p($biblio_frameworks); + } + + my $marc_field_structure = fetch_marc_tag_structure($sql_where_filter); + if ($a{verbose} > 3) { # This is too massive info dump + print "MARC field structure:\n"; + p($marc_field_structure); + } + + my $marc_subfield_structure = fetch_marc_subfield_structure($sql_where_filter); + if ($a{verbose} > 3) { # This is too massive info dump + print "MARC subfield structure:\n"; + p($marc_subfield_structure); + } + + my $distinct_fields_and_subfields = $dbh->selectall_arrayref("SELECT tagfield, tagsubfield FROM marc_subfield_structure $sql_where_filter GROUP BY tagfield, tagsubfield ORDER BY tagfield ASC, tagsubfield ASC", { Slice => {} }); + if ($a{verbose} > 3) { + print "distinct_fields_and_subfields:\n"; + p($distinct_fields_and_subfields); + } + + return ($biblio_frameworks, $marc_field_structure, $marc_subfield_structure, $distinct_fields_and_subfields); +} + +sub prepare_data_for_comparison { + my ($biblio_frameworks, $marc_field_structure, $marc_subfield_structure, $distinct_fields_and_subfields) = @_; + my $d = MFWDiff->new(); + + for my $fw (@$biblio_frameworks) { + $d->add_framework($fw); + } + + for my $dfsfs (@$distinct_fields_and_subfields) { + $d->push_comparison_slots($dfsfs->{tagfield}, $dfsfs->{tagsubfield}); + } + + for my $mfs (@$marc_field_structure) { + $d->push_field_structure($mfs->{tagfield}, $mfs); + } + + for my $mss (@$marc_subfield_structure) { + $d->push_subfield_structure($mss->{tagfield}, $mss->{tagsubfield}, $mss); + } + + return $d; +} + +sub diff_comparison { + my ($d) = @_; + + for my $field_code (sort keys %{$d->{fields}}) { + for my $attr (sort keys %{$d->{fields}->{$field_code}->{attr}}) { + for my $fw_seek ($d->get_framework_codes()) { + for my $fw_comp ($d->get_framework_codes()) { + next if ($fw_seek eq $fw_comp); + next if ($attr eq 'frameworkcode'); + next if ($a{'attributes-exclude'} && $a{'attributes-exclude'} =~ /$attr/); + if ($d->field_values_diff($field_code, $attr, $fw_seek, $fw_comp)) { + $d->add_field_diff($field_code, $attr, $fw_seek, $fw_comp); + } + } + } + } + + for my $subfield_code (sort keys %{$d->{fields}->{$field_code}->{subs}}) { + for my $attr (sort keys %{$d->{fields}->{$field_code}->{subs}->{$subfield_code}}) { + for my $fw_seek ($d->get_framework_codes()) { + for my $fw_comp ($d->get_framework_codes()) { + next if ($fw_seek eq $fw_comp); + next if ($attr eq 'frameworkcode'); + next if ($a{'attributes-exclude'} && $a{'attributes-exclude'} =~ /$attr/); + if ($d->subfield_values_diff($field_code, $subfield_code, $attr, $fw_seek, $fw_comp)) { + $d->add_subfield_diff($field_code, $subfield_code, $attr, $fw_seek, $fw_comp); + } + } + } + } + } + } + return $d; +} + +sub print_diff { + my ($d) = @_; + + print "|" . join("|", col(0, "FLD"), col(1, "S"), col(2, "Attribute")) . "|"; + for my $fw ($d->get_framework_codes()) { + print col(3, ($fw ? $fw : 'Default')) . "|"; + } + print "\n+---+-+-----------+-------------------------------\n"; + + for my $field_code (sort keys %{$d->{fields}}) { + for my $attr (sort keys %{$d->{fields}->{$field_code}->{attr}}) { + my $show_diff = 0; + my @sb; + for my $fw ($d->get_framework_codes()) { + if ($d->{fields}->{$field_code}->{attr}->{$attr}->{$fw}->{diff}) { + $show_diff++; + push(@sb, col(3, scalar(@{$d->{fields}->{$field_code}->{attr}->{$attr}->{$fw}->{diff}}) . '*' . $d->field_value($field_code, $attr, $fw))); + } + else { + push(@sb, col(3, "")); + } + } + print "|" . join("|", col(0, $field_code), col(1, " "), col(2, $attr)) . "|" . join("|", @sb) . "|\n" if $show_diff; + } + + for my $subfield_code (sort keys %{$d->{fields}->{$field_code}->{subs}}) { + for my $attr (sort keys %{$d->{fields}->{$field_code}->{subs}->{$subfield_code}}) { + my $show_diff = 0; + my @sb; + for my $fw ($d->get_framework_codes()) { + if ($d->{fields}->{$field_code}->{subs}->{$subfield_code}->{$attr}->{$fw}->{diff}) { + $show_diff++; + push(@sb, col(3, scalar(@{$d->{fields}->{$field_code}->{subs}->{$subfield_code}->{$attr}->{$fw}->{diff}}) . '*' . $d->subfield_value($field_code, $subfield_code, $attr, $fw))); + } + else { + push(@sb, col(3, "")); + } + } + print "|" . join("|", col(0, $field_code), col(1, $subfield_code), col(2, $attr)) . "|" . join("|", @sb) . "|\n" if $show_diff; + } + } + } +} + +sub list_frameworkcodes { + if ($a{verbose} == 0) { + my $biblio_framework_codes = fetch_biblio_framework_codes(); + print join(",", @$biblio_framework_codes)."\n"; + } + else { + my $biblio_frameworks = fetch_biblio_frameworks(""); + p($biblio_frameworks); + } +} + +sub sql_dump { + my ($sql, @params) = @_; + $sql . ' "' . join('","', @params) . '"'; +} + +sub update { + my $biblio_framework_codes = fetch_biblio_framework_codes(); + $biblio_framework_codes = handle_cli_param_include_exclude($biblio_framework_codes); + my $sql_frameworkcode_filter = "frameworkcode IN ('" . join("','", @$biblio_framework_codes) . "')"; + + my $rv; + my $sql; + if ($a{field} && not($a{subfield})) { + $sql = "UPDATE marc_tag_structure SET ".$dbh->quote_identifier($a{attribute})." = ? WHERE $sql_frameworkcode_filter AND tagfield = ?;"; + print "SQL:> " . sql_dump($sql, $a{value}, $a{field}) . "\n" if $a{verbose}; + $rv = $dbh->do($sql, undef, $a{value}, $a{field}); + } + elsif ($a{field} && $a{subfield}) { + $sql = "UPDATE marc_subfield_structure SET ".$dbh->quote_identifier($a{attribute})." = ? WHERE $sql_frameworkcode_filter AND tagfield = ? AND tagsubfield = ?;"; + print "SQL:> " . sql_dump($sql, $a{value}, $a{field}, $a{subfield}) . "\n" if $a{verbose}; + $rv = $dbh->do($sql, undef, $a{value}, $a{field}, $a{subfield}); + } + print "SQL:> $rv rows affected\n" if ($rv >= 0); +} +list_frameworkcodes() if $a{'list-frameworkcodes'}; +update() if $a{update}; +print_diff(diff_comparison(prepare_data_for_comparison(fetch_data()))) if $a{diff}; + +package MFWDiff; + +=head2 MFWDiff + +Data structure to present all the frameworks in a easily comparable fashion. + +field -> 'attr' -> attribute -> framework -> 'value' -> value + -> 'diff' -> [framework, framework, ...] + 'subs' -> subfield -> attribute -> framework -> 'value' -> value + -> 'diff' -> [framework, framework, ...] + +=cut + +sub new { + my $self = {}; + return bless($self, $_[0]); +} + +sub field { + return $_[0]->{fields}->{$_[1]}; +} + +sub field_value { + my ($s, $field_code, $attribute, $frameworkcode) = @_; + #return '_mssin_' unless $s->{fields}->{$field_code}->{attr}->{$attribute}->{$frameworkcode}; + return '_mssin_' unless $s->{fields}->{$field_code}->{attr}->{$attribute}->{$frameworkcode}->{value}; + return $s->{fields}->{$field_code}->{attr}->{$attribute}->{$frameworkcode}->{value}; +} + +sub subfield_value { + my ($s, $field_code, $subfield_code, $attribute, $frameworkcode) = @_; + #return '_mssin_' unless $s->{fields}->{$field_code}->{subs}->{$subfield_code}->{$attribute}->{$frameworkcode}; + return '_mssin_' unless $s->{fields}->{$field_code}->{subs}->{$subfield_code}->{$attribute}->{$frameworkcode}->{value}; + return $s->{fields}->{$field_code}->{subs}->{$subfield_code}->{$attribute}->{$frameworkcode}->{value}; +} + +sub add_field_diff { + my ($s, $field_code, $attribute, $frameworkcode_seeker, $frameworkcode_comparator) = @_; + $s->{fields}->{$field_code}->{attr}->{$attribute}->{$frameworkcode_seeker}->{diff} = [] unless $s->{fields}->{$field_code}->{attr}->{$attribute}->{$frameworkcode_seeker}->{diff}; + push(@{$s->{fields}->{$field_code}->{attr}->{$attribute}->{$frameworkcode_seeker}->{diff}}, $frameworkcode_comparator); + print("Diff: '$field_code'->'attr'->'$attribute'->'$frameworkcode_seeker' ne '$frameworkcode_comparator'\n") if $a{verbose} > 1; +} + +sub add_subfield_diff { + my ($s, $field_code, $subfield_code, $attribute, $frameworkcode_seeker, $frameworkcode_comparator) = @_; + $s->{fields}->{$field_code}->{subs}->{$subfield_code}->{$attribute}->{$frameworkcode_seeker}->{diff} = [] unless $s->{fields}->{$field_code}->{subs}->{$subfield_code}->{$attribute}->{$frameworkcode_seeker}->{diff}; + push(@{$s->{fields}->{$field_code}->{subs}->{$subfield_code}->{$attribute}->{$frameworkcode_seeker}->{diff}}, $frameworkcode_comparator); + print("Diff: '$field_code\$$subfield_code'->'attr'->'$attribute'->'$frameworkcode_seeker' ne '$frameworkcode_comparator'\n") if $a{verbose} > 1; +} + +sub field_values_diff { + my ($s, $field_code, $attr, $fw_seek, $fw_comp) = @_; + + if ($a{'perly-false'}) { + return 0 if (not($s->{fields}->{$field_code}->{attr}->{$attr}->{$fw_seek}->{value}) && not($s->{fields}->{$field_code}->{attr}->{$attr}->{$fw_comp}->{value})); + } + + return $s->field_value($field_code, $attr, $fw_seek) ne $s->field_value($field_code, $attr, $fw_comp); +} + +sub subfield_values_diff { + my ($s, $field_code, $subfield_code, $attr, $fw_seek, $fw_comp) = @_; + + if ($a{'perly-false'}) { + return 0 if (not($s->{fields}->{$field_code}->{subs}->{$subfield_code}->{$attr}->{$fw_seek}->{value}) && not($s->{fields}->{$field_code}->{subs}->{$subfield_code}->{$attr}->{$fw_comp}->{value})); + } + + return $s->subfield_value($field_code, $subfield_code, $attr, $fw_seek) ne $s->subfield_value($field_code, $subfield_code, $attr, $fw_comp); +} + +sub push_comparison_slots { + my ($s, $field_code, $subfield_code) = @_; + $s->{fields}->{$field_code} = {} unless $s->{fields}->{$field_code}; + $s->{fields}->{$field_code}->{attr} = {} unless $s->{fields}->{$field_code}->{attr}; + $s->{fields}->{$field_code}->{subs} = {} unless $s->{fields}->{$field_code}->{subs}; + $s->{fields}->{$field_code}->{subs}->{$subfield_code} = {}; +} + +sub push_field_structure { + my ($s, $field_code, $mfs) = @_; + unless ($s->{fields}->{$field_code}) { + warn "push_field_structure($field_code fw='".$mfs->{frameworkcode}."'):> Missing field_code?"; + } + + while (my ($k, $v) = each(%$mfs)) { + $s->{fields}->{$field_code}->{attr}->{$k} = {} unless $s->{fields}->{$field_code}->{attr}->{$k}; + $s->{fields}->{$field_code}->{attr}->{$k}->{$mfs->{frameworkcode}} = {} unless $s->{fields}->{$field_code}->{attr}->{$k}->{$mfs->{frameworkcode}}; + if ($a{'ignore-undef'} || $a{'perly-false'}) { + $s->{fields}->{$field_code}->{attr}->{$k}->{$mfs->{frameworkcode}}->{value} = (defined $v) ? $v : ''; + } + else { + $s->{fields}->{$field_code}->{attr}->{$k}->{$mfs->{frameworkcode}}->{value} = (defined $v) ? $v : '_undef_'; + } + } +} + +sub push_subfield_structure { + my ($s, $field_code, $subfield_code, $mss) = @_; + unless ($s->{fields}->{$field_code}) { + warn "push_subfield_structure($field_code\$$subfield_code fw='".$mss->{frameworkcode}."'):> Missing field_code?"; + } + unless ($s->{fields}->{$field_code}->{subs}->{$subfield_code}) { + warn "push_subfield_structure($field_code\$$subfield_code fw='".$mss->{frameworkcode}."'):> Missing subfield_code?"; + } + while (my ($k, $v) = each(%$mss)) { + $s->{fields}->{$field_code}->{subs}->{$subfield_code}->{$k} = {} unless $s->{fields}->{$field_code}->{subs}->{$subfield_code}->{$k}; + $s->{fields}->{$field_code}->{subs}->{$subfield_code}->{$k}->{$mss->{frameworkcode}} = {} unless $s->{fields}->{$field_code}->{subs}->{$subfield_code}->{$k}->{$mss->{frameworkcode}}; + if ($a{'ignore-undef'} || $a{'perly-false'}) { + $s->{fields}->{$field_code}->{subs}->{$subfield_code}->{$k}->{$mss->{frameworkcode}}->{value} = (defined $v) ? $v : ''; + } + else { + $s->{fields}->{$field_code}->{subs}->{$subfield_code}->{$k}->{$mss->{frameworkcode}}->{value} = (defined $v) ? $v : '_undef_'; + } + } +} + +sub add_framework { + my ($s, $framework) = @_; + $s->{frameworks} = {} unless $s->{frameworks}; + $s->{frameworks}->{$framework->{frameworkcode}} = $framework; +} +# Use en external frameworks list, because not all frameworks have all fields/subfields +sub get_framework_codes { + return sort keys %{$_[0]->{frameworks}}; +} \ No newline at end of file -- 2.39.2