C4/Heading/MARC21.pm

   1 package C4::Heading::MARC21;
   2
   3 # Copyright (C) 2008 LibLime
   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 strict;
  21 use warnings;
  22 use MARC::Field;
  23
  24
  25 =head1 NAME
  26
  27 C4::Heading::MARC21
  28
  29 =head1 SYNOPSIS
  30
  31 use C4::Heading::MARC21;
  32
  33 =head1 DESCRIPTION
  34
  35 This is an internal helper class used by
  36 C<C4::Heading> to parse headings data from
  37 MARC21 records.  Object of this type
  38 do not carry data, instead, they only
  39 dispatch functions.
  40
  41 =head1 DATA STRUCTURES
  42
  43 FIXME - this should be moved to a configuration file.
  44
  45 =head2 bib_heading_fields
  46
  47 =cut
  48
  49 my $bib_heading_fields = {
  50     '100' => {
  51         auth_type  => 'PERSO_NAME',
  52         subfields  => 'abcdfghjklmnopqrst',
  53         main_entry => 1
  54     },
  55     '110' => {
  56         auth_type  => 'CORPO_NAME',
  57         subfields  => 'abcdfghklmnoprst',
  58         main_entry => 1
  59     },
  60     '111' => {
  61         auth_type  => 'MEETI_NAME',
  62         subfields  => 'acdefghklnpqst',
  63         main_entry => 1
  64     },
  65     '130' => {
  66         auth_type  => 'UNIF_TITLE',
  67         subfields  => 'adfghklmnoprst',
  68         main_entry => 1
  69     },
  70     '147' => {
  71         auth_type => 'NAME_EVENT',
  72         subfields => 'acdgvxyz68',
  73         main_entry => 1
  74     },
  75     '148' => {
  76         auth_type => 'CHRON_TERM',
  77         subfields => 'abvxyz68',
  78         main_entry => 1
  79     },
  80     '150' => {
  81         auth_type => 'TOPIC_TERM',
  82         subfields => 'abgvxyz68',
  83         main_entry => 1
  84     },
  85     '151' => {
  86         auth_type => 'GEOGR_NAME',
  87         subfields => 'avxyz68',
  88         main_entry => 1
  89     },
  90     '155' => {
  91         auth_type => 'GENRE/FORM',
  92         subfields => 'abvxyz68',
  93         main_entry => 1
  94     },
  95     '162' => {
  96         auth_type => 'MED_PERFRM',
  97         subfields => 'a68',
  98         main_entry => 1
  99     },
 100     '180' => {
 101         auth_type => 'TOPIC_TERM',
 102         subfields => 'vxyz68'
 103     },
 104     '181' => {
 105         auth_type => 'GEOGR_NAME',
 106         subfields => 'vxyz68'
 107     },
 108     '182' => {
 109         auth_type => 'CHRON_TERM',
 110         subfields => 'vxyz68'
 111     },
 112     '185' => {
 113         auth_type => 'GENRE/FORM',
 114         subfields => 'vxyz68'
 115     },
 116     '440' => { auth_type => 'UNIF_TITLE', subfields => 'anp', series => 1 },
 117     '600' => {
 118         auth_type => 'PERSO_NAME',
 119         subfields => 'abcdfghjklmnopqrstvxyz',
 120         subject   => 1
 121     },
 122     '610' => {
 123         auth_type => 'CORPO_NAME',
 124         subfields => 'abcdfghklmnoprstvxyz',
 125         subject   => 1
 126     },
 127     '611' => {
 128         auth_type => 'MEETI_NAME',
 129         subfields => 'acdefghklnpqstvxyz',
 130         subject   => 1
 131     },
 132     '630' => {
 133         auth_type => 'UNIF_TITLE',
 134         subfields => 'adfghklmnoprstvxyz',
 135         subject   => 1
 136     },
 137     '648' => { auth_type => 'CHRON_TERM', subfields => 'avxyz',  subject => 1 },
 138     '650' => { auth_type => 'TOPIC_TERM', subfields => 'abvxyz', subject => 1 },
 139     '651' => { auth_type => 'GEOGR_NAME', subfields => 'avxyz',  subject => 1 },
 140     '655' => { auth_type => 'GENRE/FORM', subfields => 'avxyz',  subject => 1 },
 141     '690' => { auth_type => 'TOPIC_TERM', subfields => 'abvxyz', subject => 1 },
 142     '691' => { auth_type => 'GEOGR_NAME', subfields => 'avxyz',  subject => 1 },
 143     '696' => { auth_type => 'PERSO_NAME', subfields => 'abcdfghjklmnopqrst' },
 144     '697' => { auth_type => 'CORPO_NAME', subfields => 'abcdfghklmnoprst' },
 145     '698' => { auth_type => 'MEETI_NAME', subfields => 'acdfghjklnpqst' },
 146     '699' => { auth_type => 'UNIF_TITLE', subfields => 'adfghklmnoprst' },
 147     '700' => { auth_type => 'PERSO_NAME', subfields => 'abcdfghjklmnopqrst' },
 148     '710' => { auth_type => 'CORPO_NAME', subfields => 'abcdfghklmnoprst' },
 149     '711' => { auth_type => 'MEETI_NAME', subfields => 'acdefghklnpqst' },
 150     '730' => { auth_type => 'UNIF_TITLE', subfields => 'adfghklmnoprst' },
 151     '800' => {
 152         auth_type => 'PERSO_NAME',
 153         subfields => 'abcdfghjklmnopqrst',
 154         series    => 1
 155     },
 156     '810' => {
 157         auth_type => 'CORPO_NAME',
 158         subfields => 'abcdfghklmnoprst',
 159         series    => 1
 160     },
 161     '811' =>
 162       { auth_type => 'MEETI_NAME', subfields => 'acdefghklnpqst', series => 1 },
 163     '830' =>
 164       { auth_type => 'UNIF_TITLE', subfields => 'adfghklmnoprst', series => 1 },
 165 };
 166
 167 my $auth_heading_fields = {
 168     '100' => {
 169         auth_type  => 'PERSO_NAME',
 170         subfields  => 'abcdfghjklmnopqrstvxyz68',
 171         main_entry => 1
 172     },
 173     '110' => {
 174         auth_type  => 'CORPO_NAME',
 175         subfields  => 'abcdfghklmnoprstvxyz68',
 176         main_entry => 1
 177     },
 178     '111' => {
 179         auth_type  => 'MEETI_NAME',
 180         subfields  => 'acdefghklnpqstvxyz68',
 181         main_entry => 1
 182     },
 183     '130' => {
 184         auth_type  => 'UNIF_TITLE',
 185         subfields  => 'adfghklmnoprstvxyz68',
 186         main_entry => 1
 187     },
 188     '147' => {
 189         auth_type  => 'NAME_EVENT',
 190         subfields  => 'acdgvxyz68',
 191         main_entry => 1
 192     },
 193     '148' => {
 194         auth_type  => 'CHRON_TERM',
 195         subfields  => 'abvxyz68',
 196         main_entry => 1
 197     },
 198     '150' => {
 199         auth_type  => 'TOPIC_TERM',
 200         subfields  => 'abgvxyz68',
 201         main_entry => 1
 202     },
 203     '151' => {
 204         auth_type  => 'GEOG_NAME',
 205         subfields  => 'avxyz68',
 206         main_entry => 1
 207     },
 208     '155' => {
 209         auth_type  => 'GENRE/FORM',
 210         subfields  => 'abvxyz68',
 211         main_entry => 1
 212     },
 213     '162' => {
 214         auth_type  => 'MED_PERFRM',
 215         subfields  => 'a68',
 216         main_entry => 1
 217     },
 218     '180' => {
 219         auth_type => 'TOPIC_TERM',
 220         subfields => 'vxyz68',
 221     },
 222     '181' => {
 223         auth_type => 'GEOGR_NAME',
 224         subfields => 'vxyz68',
 225     },
 226     '182' => {
 227         auth_type => 'CHRON_TERM',
 228         subfields => 'vxyz68',
 229     },
 230     '185' => {
 231         auth_type => 'GENRE/FORM',
 232         subfields => 'vxyz68',
 233     },
 234 };
 235
 236 =head2 subdivisions
 237
 238 =cut
 239
 240 my %subdivisions = (
 241     'v' => 'formsubdiv',
 242     'x' => 'generalsubdiv',
 243     'y' => 'chronologicalsubdiv',
 244     'z' => 'geographicsubdiv',
 245 );
 246
 247 =head1 METHODS
 248
 249 =head2 new
 250
 251   my $marc_handler = C4::Heading::MARC21->new();
 252
 253 =cut
 254
 255 sub new {
 256     my $class = shift;
 257     return bless {}, $class;
 258 }
 259
 260 =head2 valid_heading_tag
 261
 262 =cut
 263
 264 sub valid_heading_tag {
 265     my $self          = shift;
 266     my $tag           = shift;
 267     my $frameworkcode = shift;
 268     my $auth          = shift;
 269     my $heading_fields = $auth ? { %$auth_heading_fields } : { %$bib_heading_fields };
 270
 271     if ( exists $heading_fields->{$tag} ) {
 272         return 1;
 273     }
 274     else {
 275         return 0;
 276     }
 277
 278 }
 279
 280 =head2 valid_heading_subfield
 281
 282 =cut
 283
 284 sub valid_heading_subfield {
 285     my $self          = shift;
 286     my $tag           = shift;
 287     my $subfield      = shift;
 288     my $auth          = shift;
 289
 290     my $heading_fields = $auth ? { %$auth_heading_fields } : { %$bib_heading_fields };
 291
 292     if ( exists $heading_fields->{$tag} ) {
 293         return 1 if ($heading_fields->{$tag}->{subfields} =~ /$subfield/);
 294     }
 295     return 0;
 296 }
 297
 298 =head2 get_valid_bib_heading_subfields
 299
 300 =cut
 301
 302 sub get_valid_bib_heading_subfields {
 303     my $self          = shift;
 304     my $tag           = shift;
 305
 306     return $bib_heading_fields->{$tag}->{subfields} // undef;
 307 }
 308
 309 =head2 get_auth_heading_subfields_to_report
 310
 311 =cut
 312
 313 sub get_auth_heading_subfields_to_report {
 314     my $self          = shift;
 315     my $tag           = shift;
 316
 317     my $subfields = $auth_heading_fields->{$tag}->{subfields} // '';
 318     $subfields =~ s/[68]//;
 319     return $subfields;
 320 }
 321
 322 =head2 parse_heading
 323
 324 Given a field and an indicator to specify if it is an authority field or biblio field we return
 325 the correct type, thesauarus, search form, and display form of the heading.
 326
 327 =cut
 328
 329 sub parse_heading {
 330     my $self  = shift;
 331     my $field = shift;
 332     my $auth  = shift;
 333
 334     my $tag        = $field->tag;
 335     my $heading_fields = $auth ? { %$auth_heading_fields } : { %$bib_heading_fields };
 336
 337     my $field_info = $heading_fields->{$tag};
 338     my $auth_type = $field_info->{'auth_type'};
 339     my $thesaurus =
 340       $tag =~ m/6../
 341       ? _get_subject_thesaurus($field)
 342       : undef;    # We can't know the thesaurus for non-subject fields
 343     my $search_heading =
 344       _get_search_heading( $field, $field_info->{'subfields'} );
 345     my $display_heading =
 346       _get_display_heading( $field, $field_info->{'subfields'} );
 347
 348     return ( $auth_type, $thesaurus, $search_heading, $display_heading,
 349         'exact' );
 350 }
 351
 352 =head1 INTERNAL FUNCTIONS
 353
 354 =head2 _get_subject_thesaurus
 355
 356 =cut
 357
 358 sub _get_subject_thesaurus {
 359     my $field = shift;
 360     my $ind2  = $field->indicator(2);
 361
 362     # NOTE: sears and aat do not appear
 363     # here as they do not have indicator values
 364     # though the 008 in the authority records
 365     # do have values for them
 366
 367     my $thesaurus = "notdefined";
 368     if ( $ind2 eq '0' ) {
 369         $thesaurus = "lcsh";
 370     }
 371     elsif ( $ind2 eq '1' ) {
 372         $thesaurus = "lcac";
 373     }
 374     elsif ( $ind2 eq '2' ) {
 375         $thesaurus = "mesh";
 376     }
 377     elsif ( $ind2 eq '3' ) {
 378         $thesaurus = "nal";
 379     }
 380     elsif ( $ind2 eq '4' ) {
 381         $thesaurus = "notspecified";
 382     }
 383     elsif ( $ind2 eq '5' ) {
 384         $thesaurus = "cash";
 385     }
 386     elsif ( $ind2 eq '6' ) {
 387         $thesaurus = "rvm";
 388     }
 389     elsif ( $ind2 eq '7' ) {
 390         my $sf2 = $field->subfield('2');
 391         $thesaurus = $sf2 if defined($sf2);
 392     }
 393
 394     return $thesaurus;
 395 }
 396
 397 =head2 _get_search_heading
 398
 399 =cut
 400
 401 sub _get_search_heading {
 402     my $field     = shift;
 403     my $subfields = shift;
 404
 405     my $heading   = "";
 406     my @subfields = $field->subfields();
 407     my $first     = 1;
 408     for ( my $i = 0 ; $i <= $#subfields ; $i++ ) {
 409         my $code    = $subfields[$i]->[0];
 410         my $code_re = quotemeta $code;
 411         my $value   = $subfields[$i]->[1];
 412         $value =~ s/[\s]*[-,.:=;!%\/]*[\s]*$//;
 413         next unless $subfields =~ qr/$code_re/;
 414         if ($first) {
 415             $first   = 0;
 416             $heading = $value;
 417         }
 418         else {
 419             if ( exists $subdivisions{$code} ) {
 420                 $heading .= " $subdivisions{$code} $value";
 421             }
 422             else {
 423                 $heading .= " $value";
 424             }
 425         }
 426     }
 427
 428     # remove characters that are part of CCL syntax
 429     $heading =~ s/[)(=]//g;
 430
 431     return $heading;
 432 }
 433
 434 =head2 _get_display_heading
 435
 436 =cut
 437
 438 sub _get_display_heading {
 439     my $field     = shift;
 440     my $subfields = shift;
 441
 442     my $heading   = "";
 443     my @subfields = $field->subfields();
 444     my $first     = 1;
 445     for ( my $i = 0 ; $i <= $#subfields ; $i++ ) {
 446         my $code    = $subfields[$i]->[0];
 447         my $code_re = quotemeta $code;
 448         my $value   = $subfields[$i]->[1];
 449         next unless $subfields =~ qr/$code_re/;
 450         if ($first) {
 451             $first   = 0;
 452             $heading = $value;
 453         }
 454         else {
 455             if ( exists $subdivisions{$code} ) {
 456                 $heading .= "--$value";
 457             }
 458             else {
 459                 $heading .= " $value";
 460             }
 461         }
 462     }
 463     return $heading;
 464 }
 465
 466 # Additional limiters that we aren't using:
 467 #    if ($self->{'subject_added_entry'}) {
 468 #        $limiters .= " AND Heading-use-subject-added-entry=a";
 469 #    }
 470 #    if ($self->{'series_added_entry'}) {
 471 #        $limiters .= " AND Heading-use-series-added-entry=a";
 472 #    }
 473 #    if (not $self->{'subject_added_entry'} and not $self->{'series_added_entry'}) {
 474 #        $limiters .= " AND Heading-use-main-or-added-entry=a"
 475 #    }
 476
 477 =head1 AUTHOR
 478
 479 Koha Development Team <http://koha-community.org/>
 480
 481 Galen Charlton <galen.charlton@liblime.com>
 482
 483 =cut
 484
 485 1;