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

(-)a/Koha/Util/MARC.pm (+67 lines)
Lines 19-24 package Koha::Util::MARC; Link Here
19
19
20
use Modern::Perl;
20
use Modern::Perl;
21
21
22
use constant OCLC_REGEX => qr/OCoLC/i; # made it case insensitive, includes the various oclc suffixes too
23
22
=head1 NAME
24
=head1 NAME
23
25
24
Koha::Util::MARC - utility class with routines for working with MARC records
26
Koha::Util::MARC - utility class with routines for working with MARC records
Lines 225-228 sub set_marc_field { Link Here
225
    }
227
    }
226
}
228
}
227
229
230
=head2 find_marc_info
231
232
    my $first = find_marc_info({ record => $marc, field => $field, subfield => $subfield, match => qr/regex/ });
233
    my @found = find_marc_info({ record => $marc, field => $field, subfield => $subfield, match => qr/regex/ });
234
235
    Returns first or all occurrences of field/subfield in record where regex matches.
236
    Subfield is not used for control fields.
237
    Match is optional.
238
239
=cut
240
241
sub find_marc_info {
242
    my ( $params ) = @_;
243
    my $record = $params->{record} or return;
244
    my $field = $params->{field} or return;
245
    my $subfield = $params->{subfield};
246
    my $match = $params->{match};
247
248
    my @rv;
249
    foreach my $f ( $record->field($field) ) {
250
        if( $f->is_control_field ) {
251
            push @rv, $f->data if !$match || $f->data =~ /$match/;
252
            last if @rv && !wantarray;
253
        } else {
254
            foreach my $sub ( $f->subfield($subfield) ) {
255
                push @rv, $sub if !$match || $sub =~ /$match/;
256
                last if @rv && !wantarray;
257
            }
258
        }
259
    }
260
    return @rv if wantarray;
261
    return $rv[0] if @rv;
262
}
263
264
=head2 strip_orgcode
265
266
    my $id = strip_orgcode( '(code) 123' ); # returns '123'
267
268
    Strips from starting left paren to first right paren and trailing whitespace.
269
270
=cut
271
272
sub strip_orgcode {
273
    my $arg = shift;
274
    $arg =~ s/^\([^)]*\)\s*// if $arg;
275
    return $arg;
276
}
277
278
=head2 oclc_number
279
280
    my $id = oclc_number( $record );
281
282
    Based on applying strip_orgcode on first occurrence of find_marc_info
283
    with orgcode matching regex in 035$a.
284
285
=cut;
286
287
sub oclc_number {
288
    my $record = shift;
289
    return strip_orgcode( scalar find_marc_info({
290
        # Note: Field 035 same for MARC21 and UNIMARC
291
        record => $record, field => '035', subfield => 'a', match => OCLC_REGEX,
292
    }));
293
}
294
228
1;
295
1;
(-)a/t/Koha/Util/MARC.t (-2 / +43 lines)
Lines 17-24 Link Here
17
17
18
use Modern::Perl;
18
use Modern::Perl;
19
19
20
use Test::More tests => 2;
20
use Test::More tests => 3;
21
use MARC::Record;
21
use MARC::Record;
22
use MARC::Field;
22
23
23
BEGIN { use_ok('Koha::Util::MARC'); }
24
BEGIN { use_ok('Koha::Util::MARC'); }
24
25
Lines 41-43 subtest 'set_marc_field' => sub { Link Here
41
    is(scalar @subfields, 1, 'No additional subfield created');
42
    is(scalar @subfields, 1, 'No additional subfield created');
42
    is($subfields[0], 'foobaz', 'Subfield value has been changed');
43
    is($subfields[0], 'foobaz', 'Subfield value has been changed');
43
};
44
};
44
- 
45
46
subtest 'find_marc_info, strip_orgcode, oclc_number' => sub {
47
    plan tests => 9;
48
49
    my $record = MARC::Record->new;
50
    $record->append_fields(
51
        MARC::Field->new( '003', 'some_data' ),
52
        MARC::Field->new( '035', '', '', a => '(test)123', a => '(change)456' ),
53
        MARC::Field->new( '035', '', '', a => '(test) 567', a => '(change) 567' ),
54
    );
55
    is( scalar Koha::Util::MARC::find_marc_info({
56
        record => $record, field => '003',
57
    }), 'some_data', 'control field, scalar' );
58
    is( ( Koha::Util::MARC::find_marc_info({
59
        record => $record, field => '003',
60
    }))[0], 'some_data', 'control field, list' );
61
62
    is( scalar Koha::Util::MARC::find_marc_info({
63
        record => $record, field => '035', subfield => 'a', match => qr/56/,
64
    }), '(change)456', '035a, match, scalar' );
65
    my @list = Koha::Util::MARC::find_marc_info({
66
        record => $record, field => '035', subfield => 'a', match => qr/c.*56/,
67
    });
68
    is_deeply( \@list, [ '(change)456', '(change) 567' ], '035a, match, list' );
69
70
    @list = map { Koha::Util::MARC::strip_orgcode($_) } @list;
71
    is_deeply( \@list, [ '456', '567' ], 'strip the orgcodes' );
72
    @list = map { Koha::Util::MARC::strip_orgcode($_) } ( '() a', '(a)(b) c', '(abc', ' (a)b' );
73
    is_deeply( \@list, [ 'a', '(b) c', '(abc', ' (a)b' ], 'edge cases for strip_orgcode' );
74
75
    is( Koha::Util::MARC::oclc_number(), undef, 'No arg for oclc_number' );
76
    $record->append_fields(
77
        MARC::Field->new( '035', '', '', a => '(OCoLC) 678' ),
78
    );
79
    is( Koha::Util::MARC::oclc_number($record), '678', 'orgcode mixed case' );
80
    $record->insert_fields_ordered(
81
        MARC::Field->new( '035', '', '', a => '(ocolc) 789' ),
82
    );
83
    is( Koha::Util::MARC::oclc_number($record), '789', 'orgcode lower case' );
84
85
};

Return to bug 30678