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 parse_heading
 165
 166 =cut
 167
 168 sub parse_heading {
 169     my $self  = shift;
 170     my $field = shift;
 171
 172     my $tag        = $field->tag;
 173     my $field_info = $bib_heading_fields->{$tag};
 174
 175     my $auth_type = $field_info->{'auth_type'};
 176     my $thesaurus =
 177       $tag =~ m/6../
 178       ? _get_subject_thesaurus($field)
 179       : "lcsh";    # use 'lcsh' for names, UT, etc.
 180     my $search_heading =
 181       _get_search_heading( $field, $field_info->{'subfields'} );
 182     my $display_heading =
 183       _get_display_heading( $field, $field_info->{'subfields'} );
 184
 185     return ( $auth_type, $thesaurus, $search_heading, $display_heading,
 186         'exact' );
 187 }
 188
 189 =head1 INTERNAL FUNCTIONS
 190
 191 =head2 _get_subject_thesaurus
 192
 193 =cut
 194
 195 sub _get_subject_thesaurus {
 196     my $field = shift;
 197     my $ind2  = $field->indicator(2);
 198
 199     my $thesaurus = "notdefined";
 200     if ( $ind2 eq '0' ) {
 201         $thesaurus = "lcsh";
 202     }
 203     elsif ( $ind2 eq '1' ) {
 204         $thesaurus = "lcac";
 205     }
 206     elsif ( $ind2 eq '2' ) {
 207         $thesaurus = "mesh";
 208     }
 209     elsif ( $ind2 eq '3' ) {
 210         $thesaurus = "nal";
 211     }
 212     elsif ( $ind2 eq '4' ) {
 213         $thesaurus = "notspecified";
 214     }
 215     elsif ( $ind2 eq '5' ) {
 216         $thesaurus = "cash";
 217     }
 218     elsif ( $ind2 eq '6' ) {
 219         $thesaurus = "rvm";
 220     }
 221     elsif ( $ind2 eq '7' ) {
 222         my $sf2 = $field->subfield('2');
 223         $thesaurus = $sf2 if defined($sf2);
 224     }
 225
 226     return $thesaurus;
 227 }
 228
 229 =head2 _get_search_heading
 230
 231 =cut
 232
 233 sub _get_search_heading {
 234     my $field     = shift;
 235     my $subfields = shift;
 236
 237     my $heading   = "";
 238     my @subfields = $field->subfields();
 239     my $first     = 1;
 240     for ( my $i = 0 ; $i <= $#subfields ; $i++ ) {
 241         my $code    = $subfields[$i]->[0];
 242         my $code_re = quotemeta $code;
 243         my $value   = $subfields[$i]->[1];
 244         $value =~ s/[-,.:=;!%\/]$//;
 245         next unless $subfields =~ qr/$code_re/;
 246         if ($first) {
 247             $first   = 0;
 248             $heading = $value;
 249         }
 250         else {
 251             if ( exists $subdivisions{$code} ) {
 252                 $heading .= " $subdivisions{$code} $value";
 253             }
 254             else {
 255                 $heading .= " $value";
 256             }
 257         }
 258     }
 259
 260     # remove characters that are part of CCL syntax
 261     $heading =~ s/[)(=]//g;
 262
 263     return $heading;
 264 }
 265
 266 =head2 _get_display_heading
 267
 268 =cut
 269
 270 sub _get_display_heading {
 271     my $field     = shift;
 272     my $subfields = shift;
 273
 274     my $heading   = "";
 275     my @subfields = $field->subfields();
 276     my $first     = 1;
 277     for ( my $i = 0 ; $i <= $#subfields ; $i++ ) {
 278         my $code    = $subfields[$i]->[0];
 279         my $code_re = quotemeta $code;
 280         my $value   = $subfields[$i]->[1];
 281         next unless $subfields =~ qr/$code_re/;
 282         if ($first) {
 283             $first   = 0;
 284             $heading = $value;
 285         }
 286         else {
 287             if ( exists $subdivisions{$code} ) {
 288                 $heading .= "--$value";
 289             }
 290             else {
 291                 $heading .= " $value";
 292             }
 293         }
 294     }
 295     return $heading;
 296 }
 297
 298 # Additional limiters that we aren't using:
 299 #    if ($self->{'subject_added_entry'}) {
 300 #        $limiters .= " AND Heading-use-subject-added-entry=a";
 301 #    }
 302 #    if ($self->{'series_added_entry'}) {
 303 #        $limiters .= " AND Heading-use-series-added-entry=a";
 304 #    }
 305 #    if (not $self->{'subject_added_entry'} and not $self->{'series_added_entry'}) {
 306 #        $limiters .= " AND Heading-use-main-or-added-entry=a"
 307 #    }
 308
 309 =head1 AUTHOR
 310
 311 Koha Development Team <http://koha-community.org/>
 312
 313 Galen Charlton <galen.charlton@liblime.com>
 314
 315 =cut
 316
 317 1;