From f6159ffdc7aa192aaf577bdd0360c31dad9be270 Mon Sep 17 00:00:00 2001 From: Marcel de Rooy Date: Mon, 9 May 2022 10:19:57 +0000 Subject: [PATCH] Bug 30678: (follow-up) Add oclc_number routine and friends As requested by QA, we should match the orgcode. Adding a few small routines in a Util module. Test plan: Run t/Koha/Util/MARC.t Signed-off-by: Marcel de Rooy Signed-off-by: David Nind --- Koha/Util/MARC.pm | 67 ++++++++++++++++++++++++++++++++++++++++++++++ t/Koha/Util/MARC.t | 44 +++++++++++++++++++++++++++++- 2 files changed, 110 insertions(+), 1 deletion(-) diff --git a/Koha/Util/MARC.pm b/Koha/Util/MARC.pm index 3648888b30..8fb147e4b6 100644 --- a/Koha/Util/MARC.pm +++ b/Koha/Util/MARC.pm @@ -19,6 +19,8 @@ package Koha::Util::MARC; use Modern::Perl; +use constant OCLC_REGEX => qr/OCoLC/i; # made it case insensitive, includes the various oclc suffixes too + =head1 NAME Koha::Util::MARC - utility class with routines for working with MARC records @@ -225,4 +227,69 @@ sub set_marc_field { } } +=head2 find_marc_info + + my $first = find_marc_info({ record => $marc, field => $field, subfield => $subfield, match => qr/regex/ }); + my @found = find_marc_info({ record => $marc, field => $field, subfield => $subfield, match => qr/regex/ }); + + Returns first or all occurrences of field/subfield in record where regex matches. + Subfield is not used for control fields. + Match is optional. + +=cut + +sub find_marc_info { + my ( $params ) = @_; + my $record = $params->{record} or return; + my $field = $params->{field} or return; + my $subfield = $params->{subfield}; + my $match = $params->{match}; + + my @rv; + foreach my $f ( $record->field($field) ) { + if( $f->is_control_field ) { + push @rv, $f->data if !$match || $f->data =~ /$match/; + last if @rv && !wantarray; + } else { + foreach my $sub ( $f->subfield($subfield) ) { + push @rv, $sub if !$match || $sub =~ /$match/; + last if @rv && !wantarray; + } + } + } + return @rv if wantarray; + return $rv[0] if @rv; +} + +=head2 strip_orgcode + + my $id = strip_orgcode( '(code) 123' ); # returns '123' + + Strips from starting left paren to first right paren and trailing whitespace. + +=cut + +sub strip_orgcode { + my $arg = shift; + $arg =~ s/^\([^)]*\)\s*// if $arg; + return $arg; +} + +=head2 oclc_number + + my $id = oclc_number( $record ); + + Based on applying strip_orgcode on first occurrence of find_marc_info + with orgcode matching regex in 035$a. + +=cut; + +sub oclc_number { + my $record = shift; + return strip_orgcode( scalar find_marc_info({ + # Note: Field 035 same for MARC21 and UNIMARC + record => $record, field => '035', subfield => 'a', match => OCLC_REGEX, + })); +} + 1; diff --git a/t/Koha/Util/MARC.t b/t/Koha/Util/MARC.t index f278386c18..95e9c21397 100755 --- a/t/Koha/Util/MARC.t +++ b/t/Koha/Util/MARC.t @@ -17,8 +17,9 @@ use Modern::Perl; -use Test::More tests => 2; +use Test::More tests => 3; use MARC::Record; +use MARC::Field; BEGIN { use_ok('Koha::Util::MARC'); } @@ -41,3 +42,44 @@ subtest 'set_marc_field' => sub { is(scalar @subfields, 1, 'No additional subfield created'); is($subfields[0], 'foobaz', 'Subfield value has been changed'); }; + +subtest 'find_marc_info, strip_orgcode, oclc_number' => sub { + plan tests => 9; + + my $record = MARC::Record->new; + $record->append_fields( + MARC::Field->new( '003', 'some_data' ), + MARC::Field->new( '035', '', '', a => '(test)123', a => '(change)456' ), + MARC::Field->new( '035', '', '', a => '(test) 567', a => '(change) 567' ), + ); + is( scalar Koha::Util::MARC::find_marc_info({ + record => $record, field => '003', + }), 'some_data', 'control field, scalar' ); + is( ( Koha::Util::MARC::find_marc_info({ + record => $record, field => '003', + }))[0], 'some_data', 'control field, list' ); + + is( scalar Koha::Util::MARC::find_marc_info({ + record => $record, field => '035', subfield => 'a', match => qr/56/, + }), '(change)456', '035a, match, scalar' ); + my @list = Koha::Util::MARC::find_marc_info({ + record => $record, field => '035', subfield => 'a', match => qr/c.*56/, + }); + is_deeply( \@list, [ '(change)456', '(change) 567' ], '035a, match, list' ); + + @list = map { Koha::Util::MARC::strip_orgcode($_) } @list; + is_deeply( \@list, [ '456', '567' ], 'strip the orgcodes' ); + @list = map { Koha::Util::MARC::strip_orgcode($_) } ( '() a', '(a)(b) c', '(abc', ' (a)b' ); + is_deeply( \@list, [ 'a', '(b) c', '(abc', ' (a)b' ], 'edge cases for strip_orgcode' ); + + is( Koha::Util::MARC::oclc_number(), undef, 'No arg for oclc_number' ); + $record->append_fields( + MARC::Field->new( '035', '', '', a => '(OCoLC) 678' ), + ); + is( Koha::Util::MARC::oclc_number($record), '678', 'orgcode mixed case' ); + $record->insert_fields_ordered( + MARC::Field->new( '035', '', '', a => '(ocolc) 789' ), + ); + is( Koha::Util::MARC::oclc_number($record), '789', 'orgcode lower case' ); + +}; -- 2.30.2