View | Details | Raw Unified | Return to bug 40017
Collapse All | Expand All

(-)a/C4/Breeding.pm (-36 / +38 lines)
Lines 368-419 sub _do_xslt_proc { Link Here
368
sub _add_custom_field_rowdata {
368
sub _add_custom_field_rowdata {
369
    my ( $row, $record, $pref_newtags ) = @_;
369
    my ( $row, $record, $pref_newtags ) = @_;
370
    $pref_newtags //= '';
370
    $pref_newtags //= '';
371
    my $pref_flavour = C4::Context->preference('MarcFlavour');
371
    $pref_newtags =~ s/\h+//g;
372
373
    $pref_newtags =~ s/^\s+|\s+$//g;
374
    $pref_newtags =~ s/\h+/ /g;
375
372
376
    my @addnumberfields;
373
    my @addnumberfields;
377
374
    foreach my $field ( split /,/, $pref_newtags ) {
378
    foreach my $field ( split /\,/, $pref_newtags ) {
375
        my @content;
379
        $field =~ s/^\s+|\s+$//g;    # trim whitespace
376
        my ( $tag, $add_spec ) = ( $field =~ /^(\d+)(|\$[0-9a-z]+|p\d+-\d+|p\d+)$/ );
380
        my ( $tag, $subtags ) = split( /\$/, $field );
377
        next if $tag && exists $row->{$tag};    # Silently ignore double entries in pref
381
378
        if ( !$tag || ( $tag < 10 && $add_spec =~ /^\$/ ) || ( $tag >= 10 && $add_spec =~ /^p/ ) ) {
382
        if ( $record->field($tag) ) {
379
            warn "Breeding: invalid expression in AdditionalFieldsInZ3950Result(Auth)Search: $field";
383
            my @content = ();
380
            next;
384
381
        } elsif ( $tag eq '000' ) {
382
            push @content, ( _extract_positions( $record->leader, $add_spec ) );
383
        } elsif ( $tag =~ /^00\d$/ ) {          # control field
384
            my $marcfield = $record->field($tag);
385
            push @content, ( _extract_positions( $marcfield->data, $add_spec ) );
386
        } else {
385
            for my $marcfield ( $record->field($tag) ) {
387
            for my $marcfield ( $record->field($tag) ) {
386
                if ($subtags) {
388
                foreach my $subfield ( $marcfield->subfields ) {
387
                    my $str = '';
389
                    next unless !$add_spec || $subfield->[0] =~ /[$add_spec]/;
388
                    for my $code ( split //, $subtags ) {
390
                    push @content, '[' . $subfield->[0] . ']' . $subfield->[1];
389
                        if ( $marcfield->subfield($code) ) {
390
                            $str .= $marcfield->subfield($code) . ' ';
391
                        }
392
                    }
393
                    if ( not $str eq '' ) {
394
                        push @content, $str;
395
                    }
396
                } elsif ( $tag == 10 ) {
397
                    push @content, ( $pref_flavour eq "MARC21" ? $marcfield->data : $marcfield->as_string );
398
                } elsif ( $tag < 10 ) {
399
                    push @content, $marcfield->data();
400
                } else {
401
                    push @content, $marcfield->as_string();
402
                }
391
                }
403
            }
392
            }
404
393
        }
405
            if (@content) {
394
        if (@content) {
406
                $row->{$field} = \@content;
395
            $row->{$tag} = [@content];
407
                push( @addnumberfields, $field );
396
            push @addnumberfields, $tag;
408
            }
409
        }
397
        }
410
    }
398
    }
411
399
    $row->{addnumberfields} = [ sort @addnumberfields ];
412
    $row->{'addnumberfields'} = \@addnumberfields;
413
414
    return $row;
400
    return $row;
415
}
401
}
416
402
403
sub _extract_positions {
404
    my ( $data, $spec ) = @_;
405
    if ( !$spec ) {
406
        return $data;
407
    } elsif ( $spec =~ /p(\d+)$/ ) {
408
        my $pos = $1;
409
        return if $pos >= length($data);
410
        return "[$pos]" . substr( $data, $pos, 1 );
411
    } elsif ( $spec =~ /p(\d+)-(\d+)/ ) {
412
        my ( $start, $end ) = ( $1, $2 );
413
        return if $end < $start || $start >= length($data);
414
        return "[$start-$end]" . substr( $data, $start, $end - $start + 1 );
415
    }
416
    return;
417
}
418
417
sub _isbn_replace {
419
sub _isbn_replace {
418
    my ($isbn) = @_;
420
    my ($isbn) = @_;
419
    return unless defined $isbn;
421
    return unless defined $isbn;
(-)a/t/Breeding.t (-1 / +71 lines)
Line 0 Link Here
0
- 
1
#!/usr/bin/perl
2
#
3
# Copyright 2025 Rijksmuseum, Koha Development Team
4
#
5
# This file is part of Koha.
6
#
7
# Koha is free software; you can redistribute it and/or modify it
8
# under the terms of the GNU General Public License as published by
9
# the Free Software Foundation; either version 3 of the License, or
10
# (at your option) any later version.
11
#
12
# Koha is distributed in the hope that it will be useful, but
13
# WITHOUT ANY WARRANTY; without even the implied warranty of
14
# MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
15
# GNU General Public License for more details.
16
#
17
# You should have received a copy of the GNU General Public License
18
# along with Koha; if not, see <http://www.gnu.org/licenses>.
19
20
use Modern::Perl;
21
use Data::Dumper qw(Dumper);
22
use MARC::Field;
23
use MARC::Record;
24
use Test::More tests => 3;
25
use Test::NoWarnings;
26
27
use t::lib::Mocks;
28
29
use C4::Breeding;
30
31
subtest '_extract_positions' => sub {
32
    plan tests => 5;
33
    my ( $data, $spec );
34
35
    $data = '0123456789';
36
    is( C4::Breeding::_extract_positions( $data, $spec ), $data, 'Output without spec' );
37
    $spec = 'p2';
38
    is( C4::Breeding::_extract_positions( $data, $spec ), '[2]2', 'Output for specific position' );
39
    $spec = 'p3-5';
40
    is( C4::Breeding::_extract_positions( $data, $spec ), '[3-5]345', 'Output for range' );
41
    $spec = 'p5-3';
42
    is( scalar C4::Breeding::_extract_positions( $data, $spec ), undef, 'Bad range' );
43
    $spec = 'p20-21';
44
    is( scalar C4::Breeding::_extract_positions( $data, $spec ), undef, 'Position outside string' );
45
};
46
47
subtest '_add_custom_field_rowdata' => sub {
48
    plan tests => 6;
49
    my ( $row, $pref );
50
51
    my $record = MARC::Record->new;
52
    $record->leader('0123456789');
53
    $record->append_fields(
54
        MARC::Field->new( '008', 'ABCD' ),
55
        MARC::Field->new( '100', '', '', a => 'Author', b => '100b' ),
56
        MARC::Field->new( '245', '', '', a => '245a',   b => '245b1', b => '245b2', c => '245c' ),
57
    );
58
59
    $row = {};
60
    C4::Breeding::_add_custom_field_rowdata( $row, $record, $pref );
61
    is( @{ $row->{addnumberfields} }, 0, 'No additional fields when pref is undef' );
62
63
    $row  = {};
64
    $pref = '000p7-9, 008, 100, 100$a, 245$bc, 300$d';    # 100$a should be ignored (double entry)
65
    C4::Breeding::_add_custom_field_rowdata( $row, $record, $pref );
66
    is( @{ $row->{addnumberfields} }, 4, '4 fields expected' );
67
    is_deeply( $row->{'000'}, ['[7-9]789'],                          'Check leader' );
68
    is_deeply( $row->{'008'}, ['ABCD'],                              'Check full 008' );
69
    is_deeply( $row->{'100'}, [ '[a]Author', '[b]100b' ],            'Results for first 100 in pref' );
70
    is_deeply( $row->{'245'}, [ '[b]245b1', '[b]245b2', '[c]245c' ], 'Results for 245$bc' );
71
};

Return to bug 40017