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 =head2 subdivisions
 123
 124 =cut
 125
 126 my %subdivisions = (
 127     'v' => 'formsubdiv',
 128     'x' => 'generalsubdiv',
 129     'y' => 'chronologicalsubdiv',
 130     'z' => 'geographicsubdiv',
 131 );
 132
 133 =head1 METHODS
 134
 135 =head2 new
 136
 137   my $marc_handler = C4::Heading::MARC21->new();
 138
 139 =cut
 140
 141 sub new {
 142     my $class = shift;
 143     return bless {}, $class;
 144 }
 145
 146 =head2 valid_bib_heading_tag
 147
 148 =cut
 149
 150 sub valid_bib_heading_tag {
 151     my $self          = shift;
 152     my $tag           = shift;
 153     my $frameworkcode = shift;
 154
 155     if ( exists $bib_heading_fields->{$tag} ) {
 156         return 1;
 157     }
 158     else {
 159         return 0;
 160     }
 161
 162 }
 163
 164 =head2 valid_bib_heading_subfield
 165
 166 =cut
 167
 168 sub valid_bib_heading_subfield {
 169     my $self          = shift;
 170     my $tag           = shift;
 171     my $subfield      = shift;
 172
 173     if ( exists $bib_heading_fields->{$tag} ) {
 174         return 1 if ($bib_heading_fields->{$tag}->{subfields} =~ /$subfield/);
 175     }
 176     return 0;
 177 }
 178
 179 =head2 parse_heading
 180
 181 =cut
 182
 183 sub parse_heading {
 184     my $self  = shift;
 185     my $field = shift;
 186
 187     my $tag        = $field->tag;
 188     my $field_info = $bib_heading_fields->{$tag};
 189
 190     my $auth_type = $field_info->{'auth_type'};
 191     my $thesaurus =
 192       $tag =~ m/6../
 193       ? _get_subject_thesaurus($field)
 194       : "lcsh";    # use 'lcsh' for names, UT, etc.
 195     my $search_heading =
 196       _get_search_heading( $field, $field_info->{'subfields'} );
 197     my $display_heading =
 198       _get_display_heading( $field, $field_info->{'subfields'} );
 199
 200     return ( $auth_type, $thesaurus, $search_heading, $display_heading,
 201         'exact' );
 202 }
 203
 204 =head1 INTERNAL FUNCTIONS
 205
 206 =head2 _get_subject_thesaurus
 207
 208 =cut
 209
 210 sub _get_subject_thesaurus {
 211     my $field = shift;
 212     my $ind2  = $field->indicator(2);
 213
 214     my $thesaurus = "notdefined";
 215     if ( $ind2 eq '0' ) {
 216         $thesaurus = "lcsh";
 217     }
 218     elsif ( $ind2 eq '1' ) {
 219         $thesaurus = "lcac";
 220     }
 221     elsif ( $ind2 eq '2' ) {
 222         $thesaurus = "mesh";
 223     }
 224     elsif ( $ind2 eq '3' ) {
 225         $thesaurus = "nal";
 226     }
 227     elsif ( $ind2 eq '4' ) {
 228         $thesaurus = "notspecified";
 229     }
 230     elsif ( $ind2 eq '5' ) {
 231         $thesaurus = "cash";
 232     }
 233     elsif ( $ind2 eq '6' ) {
 234         $thesaurus = "rvm";
 235     }
 236     elsif ( $ind2 eq '7' ) {
 237         my $sf2 = $field->subfield('2');
 238         $thesaurus = $sf2 if defined($sf2);
 239     }
 240
 241     return $thesaurus;
 242 }
 243
 244 =head2 _get_search_heading
 245
 246 =cut
 247
 248 sub _get_search_heading {
 249     my $field     = shift;
 250     my $subfields = shift;
 251
 252     my $heading   = "";
 253     my @subfields = $field->subfields();
 254     my $first     = 1;
 255     for ( my $i = 0 ; $i <= $#subfields ; $i++ ) {
 256         my $code    = $subfields[$i]->[0];
 257         my $code_re = quotemeta $code;
 258         my $value   = $subfields[$i]->[1];
 259         $value =~ s/[-,.:=;!%\/]$//;
 260         next unless $subfields =~ qr/$code_re/;
 261         if ($first) {
 262             $first   = 0;
 263             $heading = $value;
 264         }
 265         else {
 266             if ( exists $subdivisions{$code} ) {
 267                 $heading .= " $subdivisions{$code} $value";
 268             }
 269             else {
 270                 $heading .= " $value";
 271             }
 272         }
 273     }
 274
 275     # remove characters that are part of CCL syntax
 276     $heading =~ s/[)(=]//g;
 277
 278     return $heading;
 279 }
 280
 281 =head2 _get_display_heading
 282
 283 =cut
 284
 285 sub _get_display_heading {
 286     my $field     = shift;
 287     my $subfields = shift;
 288
 289     my $heading   = "";
 290     my @subfields = $field->subfields();
 291     my $first     = 1;
 292     for ( my $i = 0 ; $i <= $#subfields ; $i++ ) {
 293         my $code    = $subfields[$i]->[0];
 294         my $code_re = quotemeta $code;
 295         my $value   = $subfields[$i]->[1];
 296         next unless $subfields =~ qr/$code_re/;
 297         if ($first) {
 298             $first   = 0;
 299             $heading = $value;
 300         }
 301         else {
 302             if ( exists $subdivisions{$code} ) {
 303                 $heading .= "--$value";
 304             }
 305             else {
 306                 $heading .= " $value";
 307             }
 308         }
 309     }
 310     return $heading;
 311 }
 312
 313 # Additional limiters that we aren't using:
 314 #    if ($self->{'subject_added_entry'}) {
 315 #        $limiters .= " AND Heading-use-subject-added-entry=a";
 316 #    }
 317 #    if ($self->{'series_added_entry'}) {
 318 #        $limiters .= " AND Heading-use-series-added-entry=a";
 319 #    }
 320 #    if (not $self->{'subject_added_entry'} and not $self->{'series_added_entry'}) {
 321 #        $limiters .= " AND Heading-use-main-or-added-entry=a"
 322 #    }
 323
 324 =head1 AUTHOR
 325
 326 Koha Development Team <http://koha-community.org/>
 327
 328 Galen Charlton <galen.charlton@liblime.com>
 329
 330 =cut
 331
 332 1;