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 under the
   8 # terms of the GNU General Public License as published by the Free Software
   9 # Foundation; either version 2 of the License, or (at your option) any later
  10 # version.
  11 #
  12 # Koha is distributed in the hope that it will be useful, but WITHOUT ANY
  13 # WARRANTY; without even the implied warranty of MERCHANTABILITY or FITNESS FOR
  14 # A PARTICULAR PURPOSE.  See the GNU General Public License for more details.
  15 #
  16 # You should have received a copy of the GNU General Public License along
  17 # with Koha; if not, write to the Free Software Foundation, Inc.,
  18 # 51 Franklin Street, Fifth Floor, Boston, MA 02110-1301 USA.
  19
  20 use strict;
  21 #use warnings; FIXME - Bug 2505
  22 use MARC::Record;
  23 use MARC::Field;
  24
  25 our $VERSION = 3.00;
  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' => { auth_type => 'PERSO_NAME', subfields => 'abcdefghjklmnopqrst', main_entry => 1 },
  53     '110' => { auth_type => 'CORPO_NAME', subfields => 'abcdefghklmnoprst', main_entry => 1 },
  54     '111' => { auth_type => 'MEETI_NAME', subfields => 'acdefghjklnpqst', main_entry => 1 },
  55     '130' => { auth_type => 'UNIF_TITLE', subfields => 'adfghklmnoprst', main_entry => 1 },
  56     '440' => { auth_type => 'UNIF_TITLE', subfields => 'anp', series => 1 },
  57     '600' => { auth_type => 'PERSO_NAME', subfields => 'abcdefghjklmnopqrstvxyz', subject => 1 },
  58     '610' => { auth_type => 'CORPO_NAME', subfields => 'abcdefghklmnoprstvxyz', subject => 1 },
  59     '611' => { auth_type => 'MEETI_NAME', subfields => 'acdefghjklnpqstvxyz', subject => 1 },
  60     '630' => { auth_type => 'UNIF_TITLE', subfields => 'adfghklmnoprstvxyz', subject => 1 },
  61     '648' => { auth_type => 'CHRON_TERM', subfields => 'avxyz', subject => 1 },
  62     '650' => { auth_type => 'TOPIC_TERM', subfields => 'abvxyz', subject => 1 },
  63     '651' => { auth_type => 'GEOGR_NAME', subfields => 'avxyz', subject => 1 },
  64     '655' => { auth_type => 'GENRE/FORM', subfields => 'avxyz', subject => 1 },
  65     '700' => { auth_type => 'PERSO_NAME', subfields => 'abcdefghjklmnopqrst' },
  66     '710' => { auth_type => 'CORPO_NAME', subfields => 'abcdefghklmnoprst' },
  67     '711' => { auth_type => 'MEETI_NAME', subfields => 'acdefghjklnpqst' },
  68     '730' => { auth_type => 'UNIF_TITLE', subfields => 'adfghklmnoprst' },
  69     '800' => { auth_type => 'PERSO_NAME', subfields => 'abcdefghjklmnopqrst', series => 1 },
  70     '810' => { auth_type => 'CORPO_NAME', subfields => 'abcdefghklmnoprst', series => 1 },
  71     '811' => { auth_type => 'MEETI_NAME', subfields => 'acdefghjklnpqst', series => 1 },
  72     '830' => { auth_type => 'UNIF_TITLE', subfields => 'adfghklmnoprst', series => 1 },
  73 };
  74
  75 =head2 subdivisions
  76
  77 =cut
  78
  79 my %subdivisions = (
  80     'v' => 'formsubdiv',
  81     'x' => 'generalsubdiv',
  82     'y' => 'chronologicalsubdiv',
  83     'z' => 'geographicsubdiv',
  84 );
  85
  86 =head1 METHODS
  87
  88 =head2 new
  89
  90 =over 4
  91
  92 my $marc_handler = C4::Heading::MARC21->new();
  93
  94 =back
  95
  96 =cut
  97
  98 sub new {
  99     my $class = shift;
 100     return bless {}, $class;
 101 }
 102
 103 =head2 valid_bib_heading_tag
 104
 105 =cut
 106
 107 sub valid_bib_heading_tag {
 108     my $self = shift;
 109     my $tag = shift;
 110
 111     if (exists $bib_heading_fields->{$tag}) {
 112         return 1
 113     } else {
 114         return 0;
 115     }
 116
 117 }
 118
 119 =head2 parse_heading
 120
 121 =cut
 122
 123 sub parse_heading {
 124     my $self = shift;
 125     my $field = shift;
 126
 127     my $tag = $field->tag;
 128     my $field_info = $bib_heading_fields->{$tag};
 129
 130     my $auth_type = $field_info->{'auth_type'};
 131     my $subject = $field_info->{'subject'} ? 1 : 0;
 132     my $series = $field_info->{'series'} ? 1 : 0;
 133     my $main_entry = $field_info->{'main_entry'} ? 1 : 0;
 134     my $thesaurus = $subject ? _get_subject_thesaurus($field) : "lcsh"; # use 'lcsh' for names, UT, etc.
 135     my $search_heading = _get_search_heading($field, $field_info->{'subfields'});
 136     my $display_heading = _get_display_heading($field, $field_info->{'subfields'});
 137
 138     return ($auth_type, $subject, $series, $main_entry, $thesaurus, $search_heading, $display_heading);
 139 }
 140
 141 =head1 INTERNAL FUNCTIONS
 142
 143 =head2 _get_subject_thesaurus
 144
 145 =cut
 146
 147 sub _get_subject_thesaurus {
 148     my $field = shift;
 149     my $ind2 = $field->indicator(2);
 150
 151     my $thesaurus = "notdefined";
 152     if ($ind2 eq '0') {
 153         $thesaurus = "lcsh";
 154     } elsif ($ind2 eq '1') {
 155         $thesaurus = "lcac";
 156     } elsif ($ind2 eq '2') {
 157         $thesaurus = "mesh";
 158     } elsif ($ind2 eq '3') {
 159         $thesaurus = "nal";
 160     } elsif ($ind2 eq '4') {
 161         $thesaurus = "notspecified";
 162     } elsif ($ind2 eq '5') {
 163         $thesaurus = "cash";
 164     } elsif ($ind2 eq '6') {
 165         $thesaurus = "rvm";
 166     } elsif ($ind2 eq '7') {
 167         my $sf2 = $field->subfield('2');
 168         $thesaurus = $sf2 if defined($sf2);
 169     }
 170
 171     return $thesaurus;
 172 }
 173
 174 =head2 _get_search_heading
 175
 176 =cut
 177
 178 sub _get_search_heading {
 179     my $field = shift;
 180     my $subfields = shift;
 181
 182     my $heading = "";
 183     my @subfields = $field->subfields();
 184     my $first = 1;
 185     for (my $i = 0; $i <= $#subfields; $i++) {
 186         my $code = $subfields[$i]->[0];
 187         my $code_re = quotemeta $code;
 188         my $value = $subfields[$i]->[1];
 189         next unless $subfields =~ qr/$code_re/;
 190         if ($first) {
 191             $first = 0;
 192             $heading = $value;
 193         } else {
 194             if (exists $subdivisions{$code}) {
 195                 $heading .= " $subdivisions{$code} $value";
 196             } else {
 197                 $heading .= " $value";
 198             }
 199         }
 200     }
 201
 202     # remove characters that are part of CCL syntax
 203     $heading =~ s/[)(=]//g;
 204
 205     return $heading;
 206 }
 207
 208 =head2 _get_display_heading
 209
 210 =cut
 211
 212 sub _get_display_heading {
 213     my $field = shift;
 214     my $subfields = shift;
 215
 216     my $heading = "";
 217     my @subfields = $field->subfields();
 218     my $first = 1;
 219     for (my $i = 0; $i <= $#subfields; $i++) {
 220         my $code = $subfields[$i]->[0];
 221         my $code_re = quotemeta $code;
 222         my $value = $subfields[$i]->[1];
 223         next unless $subfields =~ qr/$code_re/;
 224         if ($first) {
 225             $first = 0;
 226             $heading = $value;
 227         } else {
 228             if (exists $subdivisions{$code}) {
 229                 $heading .= "--$value";
 230             } else {
 231                 $heading .= " $value";
 232             }
 233         }
 234     }
 235     return $heading;
 236 }
 237
 238 =head1 AUTHOR
 239
 240 Koha Developement team <info@koha.org>
 241
 242 Galen Charlton <galen.charlton@liblime.com>
 243
 244 =cut
 245
 246 1;