From 3122bf8d9475f612c121389f4e8a1fca84f48b8d Mon Sep 17 00:00:00 2001 From: Marcel de Rooy Date: Tue, 27 May 2025 15:54:26 +0200 Subject: [PATCH] Bug 40017: Add leader and control field positions to Z3950 search results Content-Type: text/plain; charset=utf-8 Test plan: Run t/Breeding.t Set AdditionalFieldsInZ3950ResultSearch to 000p6, 008, 040$b Do some searches and check the Additional fields column of results. Signed-off-by: Marcel de Rooy --- C4/Breeding.pm | 74 ++++++++++++++++++++++++++------------------------ t/Breeding.t | 71 ++++++++++++++++++++++++++++++++++++++++++++++++ 2 files changed, 109 insertions(+), 36 deletions(-) create mode 100755 t/Breeding.t diff --git a/C4/Breeding.pm b/C4/Breeding.pm index 538436d9a0..cb6811b0e3 100644 --- a/C4/Breeding.pm +++ b/C4/Breeding.pm @@ -368,52 +368,54 @@ sub _do_xslt_proc { sub _add_custom_field_rowdata { my ( $row, $record, $pref_newtags ) = @_; $pref_newtags //= ''; - my $pref_flavour = C4::Context->preference('MarcFlavour'); - - $pref_newtags =~ s/^\s+|\s+$//g; - $pref_newtags =~ s/\h+/ /g; + $pref_newtags =~ s/\h+//g; my @addnumberfields; - - foreach my $field ( split /\,/, $pref_newtags ) { - $field =~ s/^\s+|\s+$//g; # trim whitespace - my ( $tag, $subtags ) = split( /\$/, $field ); - - if ( $record->field($tag) ) { - my @content = (); - + foreach my $field ( split /,/, $pref_newtags ) { + my @content; + my ( $tag, $add_spec ) = ( $field =~ /^(\d+)(|\$[0-9a-z]+|p\d+-\d+|p\d+)$/ ); + next if $tag && exists $row->{$tag}; # Silently ignore double entries in pref + if ( !$tag || ( $tag < 10 && $add_spec =~ /^\$/ ) || ( $tag >= 10 && $add_spec =~ /^p/ ) ) { + warn "Breeding: invalid expression in AdditionalFieldsInZ3950Result(Auth)Search: $field"; + next; + } elsif ( $tag eq '000' ) { + push @content, ( _extract_positions( $record->leader, $add_spec ) ); + } elsif ( $tag =~ /^00\d$/ ) { # control field + my $marcfield = $record->field($tag); + push @content, ( _extract_positions( $marcfield->data, $add_spec ) ); + } else { for my $marcfield ( $record->field($tag) ) { - if ($subtags) { - my $str = ''; - for my $code ( split //, $subtags ) { - if ( $marcfield->subfield($code) ) { - $str .= $marcfield->subfield($code) . ' '; - } - } - if ( not $str eq '' ) { - push @content, $str; - } - } elsif ( $tag == 10 ) { - push @content, ( $pref_flavour eq "MARC21" ? $marcfield->data : $marcfield->as_string ); - } elsif ( $tag < 10 ) { - push @content, $marcfield->data(); - } else { - push @content, $marcfield->as_string(); + foreach my $subfield ( $marcfield->subfields ) { + next unless !$add_spec || $subfield->[0] =~ /[$add_spec]/; + push @content, '[' . $subfield->[0] . ']' . $subfield->[1]; } } - - if (@content) { - $row->{$field} = \@content; - push( @addnumberfields, $field ); - } + } + if (@content) { + $row->{$tag} = [@content]; + push @addnumberfields, $tag; } } - - $row->{'addnumberfields'} = \@addnumberfields; - + $row->{addnumberfields} = [ sort @addnumberfields ]; return $row; } +sub _extract_positions { + my ( $data, $spec ) = @_; + if ( !$spec ) { + return $data; + } elsif ( $spec =~ /p(\d+)$/ ) { + my $pos = $1; + return if $pos >= length($data); + return "[$pos]" . substr( $data, $pos, 1 ); + } elsif ( $spec =~ /p(\d+)-(\d+)/ ) { + my ( $start, $end ) = ( $1, $2 ); + return if $end < $start || $start >= length($data); + return "[$start-$end]" . substr( $data, $start, $end - $start + 1 ); + } + return; +} + sub _isbn_replace { my ($isbn) = @_; return unless defined $isbn; diff --git a/t/Breeding.t b/t/Breeding.t new file mode 100755 index 0000000000..cb9882238c --- /dev/null +++ b/t/Breeding.t @@ -0,0 +1,71 @@ +#!/usr/bin/perl +# +# Copyright 2025 Rijksmuseum, Koha Development Team +# +# 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 Data::Dumper qw(Dumper); +use MARC::Field; +use MARC::Record; +use Test::More tests => 3; +use Test::NoWarnings; + +use t::lib::Mocks; + +use C4::Breeding; + +subtest '_extract_positions' => sub { + plan tests => 5; + my ( $data, $spec ); + + $data = '0123456789'; + is( C4::Breeding::_extract_positions( $data, $spec ), $data, 'Output without spec' ); + $spec = 'p2'; + is( C4::Breeding::_extract_positions( $data, $spec ), '[2]2', 'Output for specific position' ); + $spec = 'p3-5'; + is( C4::Breeding::_extract_positions( $data, $spec ), '[3-5]345', 'Output for range' ); + $spec = 'p5-3'; + is( scalar C4::Breeding::_extract_positions( $data, $spec ), undef, 'Bad range' ); + $spec = 'p20-21'; + is( scalar C4::Breeding::_extract_positions( $data, $spec ), undef, 'Position outside string' ); +}; + +subtest '_add_custom_field_rowdata' => sub { + plan tests => 6; + my ( $row, $pref ); + + my $record = MARC::Record->new; + $record->leader('0123456789'); + $record->append_fields( + MARC::Field->new( '008', 'ABCD' ), + MARC::Field->new( '100', '', '', a => 'Author', b => '100b' ), + MARC::Field->new( '245', '', '', a => '245a', b => '245b1', b => '245b2', c => '245c' ), + ); + + $row = {}; + C4::Breeding::_add_custom_field_rowdata( $row, $record, $pref ); + is( @{ $row->{addnumberfields} }, 0, 'No additional fields when pref is undef' ); + + $row = {}; + $pref = '000p7-9, 008, 100, 100$a, 245$bc, 300$d'; # 100$a should be ignored (double entry) + C4::Breeding::_add_custom_field_rowdata( $row, $record, $pref ); + is( @{ $row->{addnumberfields} }, 4, '4 fields expected' ); + is_deeply( $row->{'000'}, ['[7-9]789'], 'Check leader' ); + is_deeply( $row->{'008'}, ['ABCD'], 'Check full 008' ); + is_deeply( $row->{'100'}, [ '[a]Author', '[b]100b' ], 'Results for first 100 in pref' ); + is_deeply( $row->{'245'}, [ '[b]245b1', '[b]245b2', '[c]245c' ], 'Results for 245$bc' ); +}; -- 2.39.5