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