1 package Koha::Util::MARC;
3 # Copyright 2013 C & P Bibliography Services
5 # This file is part of Koha.
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.
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.
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>.
22 use constant OCLC_REGEX => qr/OCoLC/i; # made it case insensitive, includes the various oclc suffixes too
26 Koha::Util::MARC - utility class with routines for working with MARC records
30 =head2 createMergeHash
32 Create a hash to use when merging MARC records
37 my ( $record, $tagslib ) = @_;
39 return unless $record;
42 my @fields = $record->fields();
44 foreach my $field (@fields) {
45 my $fieldtag = $field->tag();
46 if ( $fieldtag < 10 ) {
49 || ( defined( $tagslib->{$fieldtag} )
50 && $tagslib->{$fieldtag}->{'@'}->{'tab'} >= 0 )
56 value => $field->data(),
61 my @subfields = $field->subfields();
63 foreach my $subfield (@subfields) {
66 || ( defined $tagslib->{$fieldtag}
67 && defined $tagslib->{$fieldtag}->{ @$subfield[0] }
68 && defined $tagslib->{$fieldtag}->{ @$subfield[0] }->{'tab'}
69 && $tagslib->{$fieldtag}->{ @$subfield[0] }->{'tab'} >= 0 )
72 push @subfield_array, {
73 subtag => @$subfield[0],
74 subkey => _createKey(),
75 value => @$subfield[1],
83 !defined($tagslib) || ( defined $tagslib->{$fieldtag}
84 && defined $tagslib->{$fieldtag}->{'tab'}
85 && $tagslib->{$fieldtag}->{'tab'} >= 0 )
93 indicator1 => $field->indicator(1),
94 indicator2 => $field->indicator(2),
95 subfield => [@subfield_array],
106 Create a random value to set it into the input name
111 return int(rand(1000000));
114 =head2 getAuthorityAuthorizedHeading
116 Retrieve the authorized heading from a MARC authority record
120 sub getAuthorityAuthorizedHeading {
121 my ( $record, $schema ) = @_;
122 return unless ( ref $record eq 'MARC::Record' );
123 if ( $schema eq 'unimarc' ) {
125 # construct UNIMARC summary, that is quite different from MARC21 one
127 foreach my $field ( $record->field('2..') ) {
128 return $field->as_string('abcdefghijlmnopqrstuvwxyz');
132 foreach my $field ( $record->field('1..') ) {
133 my $tag = $field->tag();
134 next if "152" eq $tag;
136 # FIXME - 152 is not a good tag to use
137 # in MARC21 -- purely local tags really ought to be
139 if ( $tag eq '100' ) {
140 return $field->as_string('abcdefghjklmnopqrstvxyz68');
142 elsif ( $tag eq '110' ) {
143 return $field->as_string('abcdefghklmnoprstvxyz68');
145 elsif ( $tag eq '111' ) {
146 return $field->as_string('acdefghklnpqstvxyz68');
148 elsif ( $tag eq '130' ) {
149 return $field->as_string('adfghklmnoprstvxyz68');
151 elsif ( $tag eq '148' ) {
152 return $field->as_string('abvxyz68');
154 elsif ( $tag eq '150' ) {
155 return $field->as_string('abvxyz68');
157 elsif ( $tag eq '151' ) {
158 return $field->as_string('avxyz68');
160 elsif ( $tag eq '155' ) {
161 return $field->as_string('abvxyz68');
163 elsif ( $tag eq '180' ) {
164 return $field->as_string('vxyz68');
166 elsif ( $tag eq '181' ) {
167 return $field->as_string('vxyz68');
169 elsif ( $tag eq '182' ) {
170 return $field->as_string('vxyz68');
172 elsif ( $tag eq '185' ) {
173 return $field->as_string('vxyz68');
176 return $field->as_string();
183 =head2 set_marc_field
185 set_marc_field($record, $marcField, $value);
187 Set the value of $marcField to $value in $record. If the field exists, it will
188 be updated. If not, it will be created.
200 the MARC field to modify, a string in the form of 'XXX$y'
211 my ($record, $marcField, $value) = @_;
214 my ($fieldTag, $subfieldCode) = split /\$/, $marcField;
215 if( !$subfieldCode ) {
216 warn "set_marc_field: Invalid marcField format: $marcField\n";
219 my $field = $record->field($fieldTag);
221 $field->update($subfieldCode => $value);
223 $field = MARC::Field->new($fieldTag, ' ', ' ',
224 $subfieldCode => $value);
225 $record->append_fields($field);
230 =head2 find_marc_info
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/ });
235 Returns first or all occurrences of field/subfield in record where regex matches.
236 Subfield is not used for control fields.
243 my $record = $params->{record} or return;
244 my $field = $params->{field} or return;
245 my $subfield = $params->{subfield};
246 my $match = $params->{match};
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;
254 foreach my $sub ( $f->subfield($subfield) ) {
255 push @rv, $sub if !$match || $sub =~ /$match/;
256 last if @rv && !wantarray;
260 return @rv if wantarray;
261 return $rv[0] if @rv;
266 my $id = strip_orgcode( '(code) 123' ); # returns '123'
268 Strips from starting left paren to first right paren and trailing whitespace.
274 $arg =~ s/^\([^)]*\)\s*// if $arg;
280 my $id = oclc_number( $record );
282 Based on applying strip_orgcode on first occurrence of find_marc_info
283 with orgcode matching regex in 035$a.
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,