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 our $VERSION = 3.07.00.049;
  26
  27 =head1 NAME
  28
  29 C4::Heading::MARC21
  30
  31 =head1 SYNOPSIS
  32
  33 use C4::Heading::MARC21;
  34
  35 =head1 DESCRIPTION
  36
  37 This is an internal helper class used by
  38 C<C4::Heading> to parse headings data from
  39 MARC21 records.  Object of this type
  40 do not carry data, instead, they only
  41 dispatch functions.
  42
  43 =head1 DATA STRUCTURES
  44
  45 FIXME - this should be moved to a configuration file.
  46
  47 =head2 bib_heading_fields
  48
  49 =cut
  50
  51 my $bib_heading_fields = {
  52     '100' => {
  53         auth_type  => 'PERSO_NAME',
  54         subfields  => 'abcdfghjklmnopqrst',
  55         main_entry => 1
  56     },
  57     '110' => {
  58         auth_type  => 'CORPO_NAME',
  59         subfields  => 'abcdfghklmnoprst',
  60         main_entry => 1
  61     },
  62     '111' => {
  63         auth_type  => 'MEETI_NAME',
  64         subfields  => 'acdfghjklnpqst',
  65         main_entry => 1
  66     },
  67     '130' => {
  68         auth_type  => 'UNIF_TITLE',
  69         subfields  => 'adfghklmnoprst',
  70         main_entry => 1
  71     },
  72     '440' => { auth_type => 'UNIF_TITLE', subfields => 'anp', series => 1 },
  73     '600' => {
  74         auth_type => 'PERSO_NAME',
  75         subfields => 'abcdfghjklmnopqrstvxyz',
  76         subject   => 1
  77     },
  78     '610' => {
  79         auth_type => 'CORPO_NAME',
  80         subfields => 'abcdfghklmnoprstvxyz',
  81         subject   => 1
  82     },
  83     '611' => {
  84         auth_type => 'MEETI_NAME',
  85         subfields => 'acdfghjklnpqstvxyz',
  86         subject   => 1
  87     },
  88     '630' => {
  89         auth_type => 'UNIF_TITLE',
  90         subfields => 'adfghklmnoprstvxyz',
  91         subject   => 1
  92     },
  93     '648' => { auth_type => 'CHRON_TERM', subfields => 'avxyz',  subject => 1 },
  94     '650' => { auth_type => 'TOPIC_TERM', subfields => 'abvxyz', subject => 1 },
  95     '651' => { auth_type => 'GEOGR_NAME', subfields => 'avxyz',  subject => 1 },
  96     '655' => { auth_type => 'GENRE/FORM', subfields => 'avxyz',  subject => 1 },
  97     '690' => { auth_type => 'TOPIC_TERM', subfields => 'abvxyz', subject => 1 },
  98     '691' => { auth_type => 'GEOGR_NAME', subfields => 'avxyz',  subject => 1 },
  99     '696' => { auth_type => 'PERSO_NAME', subfields => 'abcdfghjklmnopqrst' },
 100     '697' => { auth_type => 'CORPO_NAME', subfields => 'abcdfghklmnoprst' },
 101     '698' => { auth_type => 'MEETI_NAME', subfields => 'acdfghjklnpqst' },
 102     '699' => { auth_type => 'UNIF_TITLE', subfields => 'adfghklmnoprst' },
 103     '700' => { auth_type => 'PERSO_NAME', subfields => 'abcdfghjklmnopqrst' },
 104     '710' => { auth_type => 'CORPO_NAME', subfields => 'abcdfghklmnoprst' },
 105     '711' => { auth_type => 'MEETI_NAME', subfields => 'acdfghjklnpqst' },
 106     '730' => { auth_type => 'UNIF_TITLE', subfields => 'adfghklmnoprst' },
 107     '800' => {
 108         auth_type => 'PERSO_NAME',
 109         subfields => 'abcdfghjklmnopqrst',
 110         series    => 1
 111     },
 112     '810' => {
 113         auth_type => 'CORPO_NAME',
 114         subfields => 'abcdfghklmnoprst',
 115         series    => 1
 116     },
 117     '811' =>
 118       { auth_type => 'MEETI_NAME', subfields => 'acdfghjklnpqst', series => 1 },
 119     '830' =>
 120       { auth_type => 'UNIF_TITLE', subfields => 'adfghklmnoprst', series => 1 },
 121 };
 122
 123 =head2 subdivisions
 124
 125 =cut
 126
 127 my %subdivisions = (
 128     'v' => 'formsubdiv',
 129     'x' => 'generalsubdiv',
 130     'y' => 'chronologicalsubdiv',
 131     'z' => 'geographicsubdiv',
 132 );
 133
 134 =head1 METHODS
 135
 136 =head2 new
 137
 138   my $marc_handler = C4::Heading::MARC21->new();
 139
 140 =cut
 141
 142 sub new {
 143     my $class = shift;
 144     return bless {}, $class;
 145 }
 146
 147 =head2 valid_bib_heading_tag
 148
 149 =cut
 150
 151 sub valid_bib_heading_tag {
 152     my $self          = shift;
 153     my $tag           = shift;
 154     my $frameworkcode = shift;
 155
 156     if ( exists $bib_heading_fields->{$tag} ) {
 157         return 1;
 158     }
 159     else {
 160         return 0;
 161     }
 162
 163 }
 164
 165 =head2 parse_heading
 166
 167 =cut
 168
 169 sub parse_heading {
 170     my $self  = shift;
 171     my $field = shift;
 172
 173     my $tag        = $field->tag;
 174     my $field_info = $bib_heading_fields->{$tag};
 175
 176     my $auth_type = $field_info->{'auth_type'};
 177     my $thesaurus =
 178       $tag =~ m/6../
 179       ? _get_subject_thesaurus($field)
 180       : "lcsh";    # use 'lcsh' for names, UT, etc.
 181     my $search_heading =
 182       _get_search_heading( $field, $field_info->{'subfields'} );
 183     my $display_heading =
 184       _get_display_heading( $field, $field_info->{'subfields'} );
 185
 186     return ( $auth_type, $thesaurus, $search_heading, $display_heading,
 187         'exact' );
 188 }
 189
 190 =head1 INTERNAL FUNCTIONS
 191
 192 =head2 _get_subject_thesaurus
 193
 194 =cut
 195
 196 sub _get_subject_thesaurus {
 197     my $field = shift;
 198     my $ind2  = $field->indicator(2);
 199
 200     my $thesaurus = "notdefined";
 201     if ( $ind2 eq '0' ) {
 202         $thesaurus = "lcsh";
 203     }
 204     elsif ( $ind2 eq '1' ) {
 205         $thesaurus = "lcac";
 206     }
 207     elsif ( $ind2 eq '2' ) {
 208         $thesaurus = "mesh";
 209     }
 210     elsif ( $ind2 eq '3' ) {
 211         $thesaurus = "nal";
 212     }
 213     elsif ( $ind2 eq '4' ) {
 214         $thesaurus = "notspecified";
 215     }
 216     elsif ( $ind2 eq '5' ) {
 217         $thesaurus = "cash";
 218     }
 219     elsif ( $ind2 eq '6' ) {
 220         $thesaurus = "rvm";
 221     }
 222     elsif ( $ind2 eq '7' ) {
 223         my $sf2 = $field->subfield('2');
 224         $thesaurus = $sf2 if defined($sf2);
 225     }
 226
 227     return $thesaurus;
 228 }
 229
 230 =head2 _get_search_heading
 231
 232 =cut
 233
 234 sub _get_search_heading {
 235     my $field     = shift;
 236     my $subfields = shift;
 237
 238     my $heading   = "";
 239     my @subfields = $field->subfields();
 240     my $first     = 1;
 241     for ( my $i = 0 ; $i <= $#subfields ; $i++ ) {
 242         my $code    = $subfields[$i]->[0];
 243         my $code_re = quotemeta $code;
 244         my $value   = $subfields[$i]->[1];
 245         $value =~ s/[-,.:=;!%\/]$//;
 246         next unless $subfields =~ qr/$code_re/;
 247         if ($first) {
 248             $first   = 0;
 249             $heading = $value;
 250         }
 251         else {
 252             if ( exists $subdivisions{$code} ) {
 253                 $heading .= " $subdivisions{$code} $value";
 254             }
 255             else {
 256                 $heading .= " $value";
 257             }
 258         }
 259     }
 260
 261     # remove characters that are part of CCL syntax
 262     $heading =~ s/[)(=]//g;
 263
 264     return $heading;
 265 }
 266
 267 =head2 _get_display_heading
 268
 269 =cut
 270
 271 sub _get_display_heading {
 272     my $field     = shift;
 273     my $subfields = shift;
 274
 275     my $heading   = "";
 276     my @subfields = $field->subfields();
 277     my $first     = 1;
 278     for ( my $i = 0 ; $i <= $#subfields ; $i++ ) {
 279         my $code    = $subfields[$i]->[0];
 280         my $code_re = quotemeta $code;
 281         my $value   = $subfields[$i]->[1];
 282         next unless $subfields =~ qr/$code_re/;
 283         if ($first) {
 284             $first   = 0;
 285             $heading = $value;
 286         }
 287         else {
 288             if ( exists $subdivisions{$code} ) {
 289                 $heading .= "--$value";
 290             }
 291             else {
 292                 $heading .= " $value";
 293             }
 294         }
 295     }
 296     return $heading;
 297 }
 298
 299 # Additional limiters that we aren't using:
 300 #    if ($self->{'subject_added_entry'}) {
 301 #        $limiters .= " AND Heading-use-subject-added-entry=a";
 302 #    }
 303 #    if ($self->{'series_added_entry'}) {
 304 #        $limiters .= " AND Heading-use-series-added-entry=a";
 305 #    }
 306 #    if (not $self->{'subject_added_entry'} and not $self->{'series_added_entry'}) {
 307 #        $limiters .= " AND Heading-use-main-or-added-entry=a"
 308 #    }
 309
 310 =head1 AUTHOR
 311
 312 Koha Development Team <http://koha-community.org/>
 313
 314 Galen Charlton <galen.charlton@liblime.com>
 315
 316 =cut
 317
 318 1;