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   my $marc_handler = C4::Heading::MARC21->new();
  91
  92 =cut
  93
  94 sub new {
  95     my $class = shift;
  96     return bless {}, $class;
  97 }
  98
  99 =head2 valid_bib_heading_tag
 100
 101 =cut
 102
 103 sub valid_bib_heading_tag {
 104     my $self = shift;
 105     my $tag = shift;
 106
 107     if (exists $bib_heading_fields->{$tag}) {
 108         return 1
 109     } else {
 110         return 0;
 111     }
 112
 113 }
 114
 115 =head2 parse_heading
 116
 117 =cut
 118
 119 sub parse_heading {
 120     my $self = shift;
 121     my $field = shift;
 122
 123     my $tag = $field->tag;
 124     my $field_info = $bib_heading_fields->{$tag};
 125
 126     my $auth_type = $field_info->{'auth_type'};
 127     my $subject = $field_info->{'subject'} ? 1 : 0;
 128     my $series = $field_info->{'series'} ? 1 : 0;
 129     my $main_entry = $field_info->{'main_entry'} ? 1 : 0;
 130     my $thesaurus = $subject ? _get_subject_thesaurus($field) : "lcsh"; # use 'lcsh' for names, UT, etc.
 131     my $search_heading = _get_search_heading($field, $field_info->{'subfields'});
 132     my $display_heading = _get_display_heading($field, $field_info->{'subfields'});
 133
 134     return ($auth_type, $subject, $series, $main_entry, $thesaurus, $search_heading, $display_heading);
 135 }
 136
 137 =head1 INTERNAL FUNCTIONS
 138
 139 =head2 _get_subject_thesaurus
 140
 141 =cut
 142
 143 sub _get_subject_thesaurus {
 144     my $field = shift;
 145     my $ind2 = $field->indicator(2);
 146
 147     my $thesaurus = "notdefined";
 148     if ($ind2 eq '0') {
 149         $thesaurus = "lcsh";
 150     } elsif ($ind2 eq '1') {
 151         $thesaurus = "lcac";
 152     } elsif ($ind2 eq '2') {
 153         $thesaurus = "mesh";
 154     } elsif ($ind2 eq '3') {
 155         $thesaurus = "nal";
 156     } elsif ($ind2 eq '4') {
 157         $thesaurus = "notspecified";
 158     } elsif ($ind2 eq '5') {
 159         $thesaurus = "cash";
 160     } elsif ($ind2 eq '6') {
 161         $thesaurus = "rvm";
 162     } elsif ($ind2 eq '7') {
 163         my $sf2 = $field->subfield('2');
 164         $thesaurus = $sf2 if defined($sf2);
 165     }
 166
 167     return $thesaurus;
 168 }
 169
 170 =head2 _get_search_heading
 171
 172 =cut
 173
 174 sub _get_search_heading {
 175     my $field = shift;
 176     my $subfields = shift;
 177
 178     my $heading = "";
 179     my @subfields = $field->subfields();
 180     my $first = 1;
 181     for (my $i = 0; $i <= $#subfields; $i++) {
 182         my $code = $subfields[$i]->[0];
 183         my $code_re = quotemeta $code;
 184         my $value = $subfields[$i]->[1];
 185         next unless $subfields =~ qr/$code_re/;
 186         if ($first) {
 187             $first = 0;
 188             $heading = $value;
 189         } else {
 190             if (exists $subdivisions{$code}) {
 191                 $heading .= " $subdivisions{$code} $value";
 192             } else {
 193                 $heading .= " $value";
 194             }
 195         }
 196     }
 197
 198     # remove characters that are part of CCL syntax
 199     $heading =~ s/[)(=]//g;
 200
 201     return $heading;
 202 }
 203
 204 =head2 _get_display_heading
 205
 206 =cut
 207
 208 sub _get_display_heading {
 209     my $field = shift;
 210     my $subfields = shift;
 211
 212     my $heading = "";
 213     my @subfields = $field->subfields();
 214     my $first = 1;
 215     for (my $i = 0; $i <= $#subfields; $i++) {
 216         my $code = $subfields[$i]->[0];
 217         my $code_re = quotemeta $code;
 218         my $value = $subfields[$i]->[1];
 219         next unless $subfields =~ qr/$code_re/;
 220         if ($first) {
 221             $first = 0;
 222             $heading = $value;
 223         } else {
 224             if (exists $subdivisions{$code}) {
 225                 $heading .= "--$value";
 226             } else {
 227                 $heading .= " $value";
 228             }
 229         }
 230     }
 231     return $heading;
 232 }
 233
 234 =head1 AUTHOR
 235
 236 Koha Development Team <http://koha-community.org/>
 237
 238 Galen Charlton <galen.charlton@liblime.com>
 239
 240 =cut
 241
 242 1;