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