From 098b98e3a1d1c3ecf44231749474095e34a058a3 Mon Sep 17 00:00:00 2001 From: Johanna Raisa Date: Wed, 12 Jun 2024 12:26:01 +0300 Subject: [PATCH] Bug 37061: allow to configure how is data copied from host to component parts This patch adds a new system preference to allow to configure how is data copied from host to component parts. The rules are defined in YAML format. If left empty, the default behavior is to copy the host data to the component parts as hard coded in the code. Test plan: 1) Apply the patch 2) Run updatedatabase.pl 3) Go to Administration -> Global system preferences 4) Search for PrepareHostField 5) Fill the rules in YAML format as in the example in the description 6) Save 7) Create a new child record 8) See that the data is copied from host to the component parts according to the rules 9) prove t/db_dependent/Biblio.t Sponsored-by: Koha-Suomi Oy Signed-off-by: Lin Wei Li --- C4/Biblio.pm | 29 ++++++++-- .../data/mysql/atomicupdate/bug_37061.pl | 19 +++++++ .../admin/preferences/cataloguing.pref | 14 +++++ t/db_dependent/Biblio.t | 54 ++++++++++++++++++- 4 files changed, 110 insertions(+), 6 deletions(-) create mode 100755 installer/data/mysql/atomicupdate/bug_37061.pl diff --git a/C4/Biblio.pm b/C4/Biblio.pm index 5aac230879..5da000c127 100644 --- a/C4/Biblio.pm +++ b/C4/Biblio.pm @@ -3006,16 +3006,37 @@ Generate the host item entry for an analytic child entry sub prepare_host_field { my ( $hostbiblio, $marcflavour ) = @_; $marcflavour ||= C4::Context->preference('marcflavour'); - - my $biblio = Koha::Biblios->find($hostbiblio); - my $host = $biblio->metadata->record; + my $biblio = Koha::Biblios->find($hostbiblio); + my $host = $biblio->metadata->record; + my $prepared_host_field = C4::Context->yaml_preference('PrepareHostField') || q{}; # unfortunately as_string does not 'do the right thing' # if field returns undef my %sfd; my $field; my $host_field; - if ( $marcflavour eq 'MARC21' ) { + + if ($prepared_host_field) { + foreach my $key ( keys %$prepared_host_field ) { + my ( $tag, $subfields ) = split( /\$/, $key ); + my ( $part_field, $part_subfield ) = split( /\$/, $prepared_host_field->{$key} ); + my $field = $host->field($tag); + if ($field) { + if ( $field->is_control_field ) { + $sfd{$part_subfield} = $field->data(); + } else { + my $s = $field->as_string($subfields); + if ($s) { + $sfd{$part_subfield} = $s; + } + } + } + if (%sfd) { + $host_field = MARC::Field->new( $part_field, '0', ' ', %sfd ); + } + } + return $host_field; + } elsif ( $marcflavour eq 'MARC21' ) { if ( $field = $host->field('100') || $host->field('110') || $host->field('11') ) { my $s = $field->as_string('ab'); if ($s) { diff --git a/installer/data/mysql/atomicupdate/bug_37061.pl b/installer/data/mysql/atomicupdate/bug_37061.pl new file mode 100755 index 0000000000..7486193945 --- /dev/null +++ b/installer/data/mysql/atomicupdate/bug_37061.pl @@ -0,0 +1,19 @@ +use Modern::Perl; + +return { + bug_number => "37061", + description => "Add a new system preference PrepareHostField", + up => sub { + my ($args) = @_; + my ( $dbh, $out ) = @$args{qw(dbh out)}; + + # Do you stuffs here + $dbh->do( + q{ + INSERT IGNORE INTO systempreferences (variable, value, options, type, explanation) + VALUES ('PrepareHostField', '', '', 'Textarea', 'Define YAML rules for copying host data to component parts.');} + ); + + say $out "Added new system preference 'PrepareHostField'"; + }, +}; 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 9c62cae068..5cbad9a0c2 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 @@ -359,6 +359,20 @@ Cataloging: dsc: descending. az: from A to Z. za: from Z to A. + - + - "Define rules for copying host data to component parts.
" + - pref: PrepareHostField + type: textarea + syntax: text/x-yaml + class: code + - "Example:
" + - "001: 773$w
" + - "020$a: 773$z
" + - "022$a: 773$x
" + - "028$ba: 773$o
" + - "245$abnpc: 773$t
" + - "264$abc: 773$d
" + - "300$ae: 773$h" Importing: - - When matching on ISBN with the record import tool, diff --git a/t/db_dependent/Biblio.t b/t/db_dependent/Biblio.t index 1f08417b93..fe3899bf56 100755 --- a/t/db_dependent/Biblio.t +++ b/t/db_dependent/Biblio.t @@ -17,7 +17,7 @@ use Modern::Perl; -use Test::More tests => 25; +use Test::More tests => 26; use Test::MockModule; use Test::Warn; use List::MoreUtils qw( uniq ); @@ -33,11 +33,12 @@ use Koha::Cache::Memory::Lite; use Koha::MarcSubfieldStructures; use C4::Linker::Default qw( get_link ); +use YAML::XS; BEGIN { use_ok( 'C4::Biblio', - qw( AddBiblio GetMarcFromKohaField BiblioAutoLink GetMarcSubfieldStructure GetMarcSubfieldStructureFromKohaField LinkBibHeadingsToAuthorities GetBiblioData ModBiblio GetMarcISSN GetMarcISBN GetMarcPrice GetFrameworkCode GetMarcUrls IsMarcStructureInternal GetMarcStructure GetXmlBiblio DelBiblio ) + qw( AddBiblio GetMarcFromKohaField BiblioAutoLink GetMarcSubfieldStructure GetMarcSubfieldStructureFromKohaField LinkBibHeadingsToAuthorities GetBiblioData ModBiblio GetMarcISSN GetMarcISBN GetMarcPrice GetFrameworkCode GetMarcUrls IsMarcStructureInternal GetMarcStructure GetXmlBiblio DelBiblio prepare_host_field ) ); } @@ -1378,6 +1379,55 @@ subtest 'AddBiblio/ModBiblio calling ModBiblioMarc for field 005' => sub { ok( $field && $field->data, 'Record contains field 005 after ModBiblio' ); }; +subtest 'Prepare host field test' => sub { + plan tests => 3; + + # PrepareHostField system preference is set + my $prepare_host_fields = { + "001" => "773\$w", + "245" => "773\$t", + }; + + # Mock the system preference PrepareHostField + t::lib::Mocks::mock_preference( 'PrepareHostField', YAML::XS::Dump($prepare_host_fields) ); + + my $record = MARC::Record->new; + my $field = MARC::Field->new( '245', '', '', 'a' => 'Example' ); + $record->append_fields($field); + C4::Biblio::AddBiblio( $record, '' ); + my ($biblionumber) = C4::Biblio::AddBiblio( $record, '' ); + my $host_field = C4::Biblio::prepare_host_field( $biblionumber, '' ); + my $comp_record = MARC::Record->new; + $comp_record->append_fields($host_field); + is( $comp_record->subfield( '773', 't' ), 'Example', 'System preference host field is correct' ); + + t::lib::Mocks::mock_preference( 'PrepareHostField', '' ); + + #MARC21 + t::lib::Mocks::mock_preference( 'marcflavour', 'MARC21' ); + my $marc_record = MARC::Record->new; + my $marc_field = MARC::Field->new( '245', '', '', 'a' => 'Example' ); + $marc_record->append_fields($marc_field); + C4::Biblio::AddBiblio( $marc_record, '' ); + my ($biblio_number) = C4::Biblio::AddBiblio( $marc_record, '' ); + my $host_marc_field = C4::Biblio::prepare_host_field( $biblio_number, '' ); + my $compiled_record = MARC::Record->new; + $compiled_record->append_fields($host_marc_field); + is( $compiled_record->subfield( '773', 't' ), 'Example', 'MARC21 host field is correct' ); + + # UNIMARC + t::lib::Mocks::mock_preference( 'marcflavour', 'UNIMARC' ); + my $unimarc_record = MARC::Record->new; + my $unimarc_field = MARC::Field->new( '200', '', '', 'a' => 'Example' ); + $unimarc_record->append_fields($unimarc_field); + my ($unimarc_biblionumber) = C4::Biblio::AddBiblio( $unimarc_record, '' ); + my $unimarc_host_field = C4::Biblio::prepare_host_field( $unimarc_biblionumber, '' ); + my $unimarc_comp_record = MARC::Record->new; + $unimarc_comp_record->append_fields($unimarc_host_field); + is( $unimarc_comp_record->subfield( '461', 't' ), 'Example', 'UNIMARC host field is correct' ); + +}; + # Cleanup Koha::Caches->get_instance->clear_from_cache("MarcSubfieldStructure-"); $schema->storage->txn_rollback; -- 2.43.0