Koha/Util/MARC.pm

   1 package Koha::Util::MARC;
   2
   3 # Copyright 2013 C & P Bibliography Services
   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
  22 use constant OCLC_REGEX => qr/OCoLC/i; # made it case insensitive, includes the various oclc suffixes too
  23
  24 =head1 NAME
  25
  26 Koha::Util::MARC - utility class with routines for working with MARC records
  27
  28 =head1 METHODS
  29
  30 =head2 createMergeHash
  31
  32 Create a hash to use when merging MARC records
  33
  34 =cut
  35
  36 sub createMergeHash {
  37     my ( $record, $tagslib ) = @_;
  38
  39     return unless $record;
  40
  41     my @array;
  42     my @fields = $record->fields();
  43
  44     foreach my $field (@fields) {
  45         my $fieldtag = $field->tag();
  46         if ( $fieldtag < 10 ) {
  47             if (
  48                 !defined($tagslib)
  49                 || ( defined( $tagslib->{$fieldtag} )
  50                     && $tagslib->{$fieldtag}->{'@'}->{'tab'} >= 0 )
  51               )
  52             {
  53                 push @array, {
  54                     tag   => $fieldtag,
  55                     key   => _createKey(),
  56                     value => $field->data(),
  57                 };
  58             }
  59         }
  60         else {
  61             my @subfields = $field->subfields();
  62             my @subfield_array;
  63             foreach my $subfield (@subfields) {
  64                 if (
  65                     !defined($tagslib)
  66                     || (   defined $tagslib->{$fieldtag}
  67                         && defined $tagslib->{$fieldtag}->{ @$subfield[0] }
  68                         && defined $tagslib->{$fieldtag}->{ @$subfield[0] }->{'tab'}
  69                         && $tagslib->{$fieldtag}->{ @$subfield[0] }->{'tab'} >= 0 )
  70                   )
  71                 {
  72                     push @subfield_array, {
  73                         subtag => @$subfield[0],
  74                         subkey => _createKey(),
  75                         value  => @$subfield[1],
  76                     };
  77                 }
  78
  79             }
  80
  81             if (
  82                 (
  83                     !defined($tagslib) || ( defined $tagslib->{$fieldtag}
  84                         && defined $tagslib->{$fieldtag}->{'tab'}
  85                         && $tagslib->{$fieldtag}->{'tab'} >= 0 )
  86                 )
  87                 && @subfield_array
  88               )
  89             {
  90                 push @array, {
  91                       tag        => $fieldtag,
  92                       key        => _createKey(),
  93                       indicator1 => $field->indicator(1),
  94                       indicator2 => $field->indicator(2),
  95                       subfield   => [@subfield_array],
  96                   };
  97             }
  98
  99         }
 100     }
 101     return [@array];
 102 }
 103
 104 =head2 _createKey
 105
 106 Create a random value to set it into the input name
 107
 108 =cut
 109
 110 sub _createKey {
 111     return int(rand(1000000));
 112 }
 113
 114 =head2 getAuthorityAuthorizedHeading
 115
 116 Retrieve the authorized heading from a MARC authority record
 117
 118 =cut
 119
 120 sub getAuthorityAuthorizedHeading {
 121     my ( $record, $schema ) = @_;
 122     return unless ( ref $record eq 'MARC::Record' );
 123     if ( $schema eq 'unimarc' ) {
 124
 125         # construct UNIMARC summary, that is quite different from MARC21 one
 126         # accepted form
 127         foreach my $field ( $record->field('2..') ) {
 128             return $field->as_string('abcdefghijlmnopqrstuvwxyz');
 129         }
 130     }
 131     else {
 132         foreach my $field ( $record->field('1..') ) {
 133             my $tag = $field->tag();
 134             next if "152" eq $tag;
 135
 136             # FIXME - 152 is not a good tag to use
 137             # in MARC21 -- purely local tags really ought to be
 138             # 9XX
 139             if ( $tag eq '100' ) {
 140                 return $field->as_string('abcdefghjklmnopqrstvxyz68');
 141             }
 142             elsif ( $tag eq '110' ) {
 143                 return $field->as_string('abcdefghklmnoprstvxyz68');
 144             }
 145             elsif ( $tag eq '111' ) {
 146                 return $field->as_string('acdefghklnpqstvxyz68');
 147             }
 148             elsif ( $tag eq '130' ) {
 149                 return $field->as_string('adfghklmnoprstvxyz68');
 150             }
 151             elsif ( $tag eq '148' ) {
 152                 return $field->as_string('abvxyz68');
 153             }
 154             elsif ( $tag eq '150' ) {
 155                 return $field->as_string('abvxyz68');
 156             }
 157             elsif ( $tag eq '151' ) {
 158                 return $field->as_string('avxyz68');
 159             }
 160             elsif ( $tag eq '155' ) {
 161                 return $field->as_string('abvxyz68');
 162             }
 163             elsif ( $tag eq '180' ) {
 164                 return $field->as_string('vxyz68');
 165             }
 166             elsif ( $tag eq '181' ) {
 167                 return $field->as_string('vxyz68');
 168             }
 169             elsif ( $tag eq '182' ) {
 170                 return $field->as_string('vxyz68');
 171             }
 172             elsif ( $tag eq '185' ) {
 173                 return $field->as_string('vxyz68');
 174             }
 175             else {
 176                 return $field->as_string();
 177             }
 178         }
 179     }
 180     return;
 181 }
 182
 183 =head2 set_marc_field
 184
 185     set_marc_field($record, $marcField, $value);
 186
 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.
 189
 190 =head3 Parameters
 191
 192 =over 4
 193
 194 =item C<$record>
 195
 196 MARC::Record object
 197
 198 =item C<$marcField>
 199
 200 the MARC field to modify, a string in the form of 'XXX$y'
 201
 202 =item C<$value>
 203
 204 the value
 205
 206 =back
 207
 208 =cut
 209
 210 sub set_marc_field {
 211     my ($record, $marcField, $value) = @_;
 212
 213     if ($marcField) {
 214         my ($fieldTag, $subfieldCode) = split /\$/, $marcField;
 215         if( !$subfieldCode ) {
 216             warn "set_marc_field: Invalid marcField format: $marcField\n";
 217             return;
 218         }
 219         my $field = $record->field($fieldTag);
 220         if ($field) {
 221             $field->update($subfieldCode => $value);
 222         } else {
 223             $field = MARC::Field->new($fieldTag, ' ', ' ',
 224                 $subfieldCode => $value);
 225             $record->append_fields($field);
 226         }
 227     }
 228 }
 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
 295 1;