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  => 'acdfghjklnpqst',
  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 => 'abvxyz68',
  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 => 'acdfghjklnpqstvxyz',
 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 => 'acdfghjklnpqst' },
 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 => 'acdfghjklnpqst', 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  => 'abcdefghjklmnopqrstvxyz68',
 171         main_entry => 1
 172     },
 173     '110' => {
 174         auth_type  => 'CORPO_NAME',
 175         subfields  => 'abcdefghklmnoprstvxyz68',
 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  => 'abvxyz68',
 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       : "lcsh";    # use 'lcsh' for names, UT, etc.
 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     my $thesaurus = "notdefined";
 363     if ( $ind2 eq '0' ) {
 364         $thesaurus = "lcsh";
 365     }
 366     elsif ( $ind2 eq '1' ) {
 367         $thesaurus = "lcac";
 368     }
 369     elsif ( $ind2 eq '2' ) {
 370         $thesaurus = "mesh";
 371     }
 372     elsif ( $ind2 eq '3' ) {
 373         $thesaurus = "nal";
 374     }
 375     elsif ( $ind2 eq '4' ) {
 376         $thesaurus = "notspecified";
 377     }
 378     elsif ( $ind2 eq '5' ) {
 379         $thesaurus = "cash";
 380     }
 381     elsif ( $ind2 eq '6' ) {
 382         $thesaurus = "rvm";
 383     }
 384     elsif ( $ind2 eq '7' ) {
 385         my $sf2 = $field->subfield('2');
 386         $thesaurus = $sf2 if defined($sf2);
 387     }
 388
 389     return $thesaurus;
 390 }
 391
 392 =head2 _get_search_heading
 393
 394 =cut
 395
 396 sub _get_search_heading {
 397     my $field     = shift;
 398     my $subfields = shift;
 399
 400     my $heading   = "";
 401     my @subfields = $field->subfields();
 402     my $first     = 1;
 403     for ( my $i = 0 ; $i <= $#subfields ; $i++ ) {
 404         my $code    = $subfields[$i]->[0];
 405         my $code_re = quotemeta $code;
 406         my $value   = $subfields[$i]->[1];
 407         $value =~ s/[\s]*[-,.:=;!%\/][\s]*$//;
 408         next unless $subfields =~ qr/$code_re/;
 409         if ($first) {
 410             $first   = 0;
 411             $heading = $value;
 412         }
 413         else {
 414             if ( exists $subdivisions{$code} ) {
 415                 $heading .= " $subdivisions{$code} $value";
 416             }
 417             else {
 418                 $heading .= " $value";
 419             }
 420         }
 421     }
 422
 423     # remove characters that are part of CCL syntax
 424     $heading =~ s/[)(=]//g;
 425
 426     return $heading;
 427 }
 428
 429 =head2 _get_display_heading
 430
 431 =cut
 432
 433 sub _get_display_heading {
 434     my $field     = shift;
 435     my $subfields = shift;
 436
 437     my $heading   = "";
 438     my @subfields = $field->subfields();
 439     my $first     = 1;
 440     for ( my $i = 0 ; $i <= $#subfields ; $i++ ) {
 441         my $code    = $subfields[$i]->[0];
 442         my $code_re = quotemeta $code;
 443         my $value   = $subfields[$i]->[1];
 444         next unless $subfields =~ qr/$code_re/;
 445         if ($first) {
 446             $first   = 0;
 447             $heading = $value;
 448         }
 449         else {
 450             if ( exists $subdivisions{$code} ) {
 451                 $heading .= "--$value";
 452             }
 453             else {
 454                 $heading .= " $value";
 455             }
 456         }
 457     }
 458     return $heading;
 459 }
 460
 461 # Additional limiters that we aren't using:
 462 #    if ($self->{'subject_added_entry'}) {
 463 #        $limiters .= " AND Heading-use-subject-added-entry=a";
 464 #    }
 465 #    if ($self->{'series_added_entry'}) {
 466 #        $limiters .= " AND Heading-use-series-added-entry=a";
 467 #    }
 468 #    if (not $self->{'subject_added_entry'} and not $self->{'series_added_entry'}) {
 469 #        $limiters .= " AND Heading-use-main-or-added-entry=a"
 470 #    }
 471
 472 =head1 AUTHOR
 473
 474 Koha Development Team <http://koha-community.org/>
 475
 476 Galen Charlton <galen.charlton@liblime.com>
 477
 478 =cut
 479
 480 1;