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     '440' => { auth_type => 'UNIF_TITLE', subfields => 'anp', series => 1 },
  72     '600' => {
  73         auth_type => 'PERSO_NAME',
  74         subfields => 'abcdfghjklmnopqrstvxyz',
  75         subject   => 1
  76     },
  77     '610' => {
  78         auth_type => 'CORPO_NAME',
  79         subfields => 'abcdfghklmnoprstvxyz',
  80         subject   => 1
  81     },
  82     '611' => {
  83         auth_type => 'MEETI_NAME',
  84         subfields => 'acdfghjklnpqstvxyz',
  85         subject   => 1
  86     },
  87     '630' => {
  88         auth_type => 'UNIF_TITLE',
  89         subfields => 'adfghklmnoprstvxyz',
  90         subject   => 1
  91     },
  92     '648' => { auth_type => 'CHRON_TERM', subfields => 'avxyz',  subject => 1 },
  93     '650' => { auth_type => 'TOPIC_TERM', subfields => 'abvxyz', subject => 1 },
  94     '651' => { auth_type => 'GEOGR_NAME', subfields => 'avxyz',  subject => 1 },
  95     '655' => { auth_type => 'GENRE/FORM', subfields => 'avxyz',  subject => 1 },
  96     '690' => { auth_type => 'TOPIC_TERM', subfields => 'abvxyz', subject => 1 },
  97     '691' => { auth_type => 'GEOGR_NAME', subfields => 'avxyz',  subject => 1 },
  98     '696' => { auth_type => 'PERSO_NAME', subfields => 'abcdfghjklmnopqrst' },
  99     '697' => { auth_type => 'CORPO_NAME', subfields => 'abcdfghklmnoprst' },
 100     '698' => { auth_type => 'MEETI_NAME', subfields => 'acdfghjklnpqst' },
 101     '699' => { auth_type => 'UNIF_TITLE', subfields => 'adfghklmnoprst' },
 102     '700' => { auth_type => 'PERSO_NAME', subfields => 'abcdfghjklmnopqrst' },
 103     '710' => { auth_type => 'CORPO_NAME', subfields => 'abcdfghklmnoprst' },
 104     '711' => { auth_type => 'MEETI_NAME', subfields => 'acdfghjklnpqst' },
 105     '730' => { auth_type => 'UNIF_TITLE', subfields => 'adfghklmnoprst' },
 106     '800' => {
 107         auth_type => 'PERSO_NAME',
 108         subfields => 'abcdfghjklmnopqrst',
 109         series    => 1
 110     },
 111     '810' => {
 112         auth_type => 'CORPO_NAME',
 113         subfields => 'abcdfghklmnoprst',
 114         series    => 1
 115     },
 116     '811' =>
 117       { auth_type => 'MEETI_NAME', subfields => 'acdfghjklnpqst', series => 1 },
 118     '830' =>
 119       { auth_type => 'UNIF_TITLE', subfields => 'adfghklmnoprst', series => 1 },
 120 };
 121
 122 my $auth_heading_fields = {
 123     '100' => {
 124         auth_type  => 'PERSO_NAME',
 125         subfields  => 'abcdfghjklmnopqrstvxyz',
 126         main_entry => 1
 127     },
 128     '110' => {
 129         auth_type  => 'CORPO_NAME',
 130         subfields  => 'abcdfghklmnoprstvxyz',
 131         main_entry => 1
 132     },
 133     '111' => {
 134         auth_type  => 'MEETI_NAME',
 135         subfields  => 'acdfghjklnpqstvxyz',
 136         main_entry => 1
 137     },
 138     '130' => {
 139         auth_type  => 'UNIF_TITLE',
 140         subfields  => 'adfghklmnoprstvxyz',
 141         main_entry => 1
 142     },
 143     '148' => {
 144         auth_type => 'CHRON_TERM',
 145         subfields => 'avxyz',
 146         main_entry => 1
 147     },
 148     '150' => {
 149         auth_type => 'TOPIC_TERM',
 150         subfields => 'abgvxyz',
 151         main_entry => 1
 152     },
 153     '151' => {
 154         auth_type => 'GEOG_NAME',
 155         subfields => 'agvxyz',
 156         main_entry => 1
 157     },
 158     '155' => {
 159         auth_type => 'GENRE/FORM',
 160         subfields => 'agvxyz',
 161         main_entry => 1
 162     }
 163 };
 164
 165 =head2 subdivisions
 166
 167 =cut
 168
 169 my %subdivisions = (
 170     'v' => 'formsubdiv',
 171     'x' => 'generalsubdiv',
 172     'y' => 'chronologicalsubdiv',
 173     'z' => 'geographicsubdiv',
 174 );
 175
 176 =head1 METHODS
 177
 178 =head2 new
 179
 180   my $marc_handler = C4::Heading::MARC21->new();
 181
 182 =cut
 183
 184 sub new {
 185     my $class = shift;
 186     return bless {}, $class;
 187 }
 188
 189 =head2 valid_heading_tag
 190
 191 =cut
 192
 193 sub valid_heading_tag {
 194     my $self          = shift;
 195     my $tag           = shift;
 196     my $frameworkcode = shift;
 197     my $auth          = shift;
 198     my $heading_fields = $auth ? { %$auth_heading_fields } : { %$bib_heading_fields };
 199
 200     if ( exists $heading_fields->{$tag} ) {
 201         return 1;
 202     }
 203     else {
 204         return 0;
 205     }
 206
 207 }
 208
 209 =head2 valid_heading_subfield
 210
 211 =cut
 212
 213 sub valid_heading_subfield {
 214     my $self          = shift;
 215     my $tag           = shift;
 216     my $subfield      = shift;
 217     my $auth          = shift;
 218
 219     my $heading_fields = $auth ? { %$auth_heading_fields } : { %$bib_heading_fields };
 220
 221     if ( exists $heading_fields->{$tag} ) {
 222         return 1 if ($heading_fields->{$tag}->{subfields} =~ /$subfield/);
 223     }
 224     return 0;
 225 }
 226
 227 =head2 parse_heading
 228
 229 Given a field and an indicator to specify if it is an authority field or biblio field we return
 230 the correct type, thesauarus, search form, and display form of the heading.
 231
 232 =cut
 233
 234 sub parse_heading {
 235     my $self  = shift;
 236     my $field = shift;
 237     my $auth  = shift;
 238
 239     my $tag        = $field->tag;
 240     my $heading_fields = $auth ? { %$auth_heading_fields } : { %$bib_heading_fields };
 241
 242     my $field_info = $heading_fields->{$tag};
 243     my $auth_type = $field_info->{'auth_type'};
 244     my $thesaurus =
 245       $tag =~ m/6../
 246       ? _get_subject_thesaurus($field)
 247       : "lcsh";    # use 'lcsh' for names, UT, etc.
 248     my $search_heading =
 249       _get_search_heading( $field, $field_info->{'subfields'} );
 250     my $display_heading =
 251       _get_display_heading( $field, $field_info->{'subfields'} );
 252
 253     return ( $auth_type, $thesaurus, $search_heading, $display_heading,
 254         'exact' );
 255 }
 256
 257 =head1 INTERNAL FUNCTIONS
 258
 259 =head2 _get_subject_thesaurus
 260
 261 =cut
 262
 263 sub _get_subject_thesaurus {
 264     my $field = shift;
 265     my $ind2  = $field->indicator(2);
 266
 267     my $thesaurus = "notdefined";
 268     if ( $ind2 eq '0' ) {
 269         $thesaurus = "lcsh";
 270     }
 271     elsif ( $ind2 eq '1' ) {
 272         $thesaurus = "lcac";
 273     }
 274     elsif ( $ind2 eq '2' ) {
 275         $thesaurus = "mesh";
 276     }
 277     elsif ( $ind2 eq '3' ) {
 278         $thesaurus = "nal";
 279     }
 280     elsif ( $ind2 eq '4' ) {
 281         $thesaurus = "notspecified";
 282     }
 283     elsif ( $ind2 eq '5' ) {
 284         $thesaurus = "cash";
 285     }
 286     elsif ( $ind2 eq '6' ) {
 287         $thesaurus = "rvm";
 288     }
 289     elsif ( $ind2 eq '7' ) {
 290         my $sf2 = $field->subfield('2');
 291         $thesaurus = $sf2 if defined($sf2);
 292     }
 293
 294     return $thesaurus;
 295 }
 296
 297 =head2 _get_search_heading
 298
 299 =cut
 300
 301 sub _get_search_heading {
 302     my $field     = shift;
 303     my $subfields = shift;
 304
 305     my $heading   = "";
 306     my @subfields = $field->subfields();
 307     my $first     = 1;
 308     for ( my $i = 0 ; $i <= $#subfields ; $i++ ) {
 309         my $code    = $subfields[$i]->[0];
 310         my $code_re = quotemeta $code;
 311         my $value   = $subfields[$i]->[1];
 312         $value =~ s/[\s]*[-,.:=;!%\/][\s]*$//;
 313         next unless $subfields =~ qr/$code_re/;
 314         if ($first) {
 315             $first   = 0;
 316             $heading = $value;
 317         }
 318         else {
 319             if ( exists $subdivisions{$code} ) {
 320                 $heading .= " $subdivisions{$code} $value";
 321             }
 322             else {
 323                 $heading .= " $value";
 324             }
 325         }
 326     }
 327
 328     # remove characters that are part of CCL syntax
 329     $heading =~ s/[)(=]//g;
 330
 331     return $heading;
 332 }
 333
 334 =head2 _get_display_heading
 335
 336 =cut
 337
 338 sub _get_display_heading {
 339     my $field     = shift;
 340     my $subfields = shift;
 341
 342     my $heading   = "";
 343     my @subfields = $field->subfields();
 344     my $first     = 1;
 345     for ( my $i = 0 ; $i <= $#subfields ; $i++ ) {
 346         my $code    = $subfields[$i]->[0];
 347         my $code_re = quotemeta $code;
 348         my $value   = $subfields[$i]->[1];
 349         next unless $subfields =~ qr/$code_re/;
 350         if ($first) {
 351             $first   = 0;
 352             $heading = $value;
 353         }
 354         else {
 355             if ( exists $subdivisions{$code} ) {
 356                 $heading .= "--$value";
 357             }
 358             else {
 359                 $heading .= " $value";
 360             }
 361         }
 362     }
 363     return $heading;
 364 }
 365
 366 # Additional limiters that we aren't using:
 367 #    if ($self->{'subject_added_entry'}) {
 368 #        $limiters .= " AND Heading-use-subject-added-entry=a";
 369 #    }
 370 #    if ($self->{'series_added_entry'}) {
 371 #        $limiters .= " AND Heading-use-series-added-entry=a";
 372 #    }
 373 #    if (not $self->{'subject_added_entry'} and not $self->{'series_added_entry'}) {
 374 #        $limiters .= " AND Heading-use-main-or-added-entry=a"
 375 #    }
 376
 377 =head1 AUTHOR
 378
 379 Koha Development Team <http://koha-community.org/>
 380
 381 Galen Charlton <galen.charlton@liblime.com>
 382
 383 =cut
 384
 385 1;