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;
  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     '700' => { auth_type => 'PERSO_NAME', subfields => 'abcdfghjklmnopqrst' },
  98     '710' => { auth_type => 'CORPO_NAME', subfields => 'abcdfghklmnoprst' },
  99     '711' => { auth_type => 'MEETI_NAME', subfields => 'acdfghjklnpqst' },
 100     '730' => { auth_type => 'UNIF_TITLE', subfields => 'adfghklmnoprst' },
 101     '800' => {
 102         auth_type => 'PERSO_NAME',
 103         subfields => 'abcdfghjklmnopqrst',
 104         series    => 1
 105     },
 106     '810' => {
 107         auth_type => 'CORPO_NAME',
 108         subfields => 'abcdfghklmnoprst',
 109         series    => 1
 110     },
 111     '811' =>
 112       { auth_type => 'MEETI_NAME', subfields => 'acdfghjklnpqst', series => 1 },
 113     '830' =>
 114       { auth_type => 'UNIF_TITLE', subfields => 'adfghklmnoprst', series => 1 },
 115 };
 116
 117 =head2 subdivisions
 118
 119 =cut
 120
 121 my %subdivisions = (
 122     'v' => 'formsubdiv',
 123     'x' => 'generalsubdiv',
 124     'y' => 'chronologicalsubdiv',
 125     'z' => 'geographicsubdiv',
 126 );
 127
 128 =head1 METHODS
 129
 130 =head2 new
 131
 132   my $marc_handler = C4::Heading::MARC21->new();
 133
 134 =cut
 135
 136 sub new {
 137     my $class = shift;
 138     return bless {}, $class;
 139 }
 140
 141 =head2 valid_bib_heading_tag
 142
 143 =cut
 144
 145 sub valid_bib_heading_tag {
 146     my $self          = shift;
 147     my $tag           = shift;
 148     my $frameworkcode = shift;
 149
 150     if ( exists $bib_heading_fields->{$tag} ) {
 151         return 1;
 152     }
 153     else {
 154         return 0;
 155     }
 156
 157 }
 158
 159 =head2 parse_heading
 160
 161 =cut
 162
 163 sub parse_heading {
 164     my $self  = shift;
 165     my $field = shift;
 166
 167     my $tag        = $field->tag;
 168     my $field_info = $bib_heading_fields->{$tag};
 169
 170     my $auth_type = $field_info->{'auth_type'};
 171     my $thesaurus =
 172       $tag =~ m/6../
 173       ? _get_subject_thesaurus($field)
 174       : "lcsh";    # use 'lcsh' for names, UT, etc.
 175     my $search_heading =
 176       _get_search_heading( $field, $field_info->{'subfields'} );
 177     my $display_heading =
 178       _get_display_heading( $field, $field_info->{'subfields'} );
 179
 180     return ( $auth_type, $thesaurus, $search_heading, $display_heading,
 181         'exact' );
 182 }
 183
 184 =head1 INTERNAL FUNCTIONS
 185
 186 =head2 _get_subject_thesaurus
 187
 188 =cut
 189
 190 sub _get_subject_thesaurus {
 191     my $field = shift;
 192     my $ind2  = $field->indicator(2);
 193
 194     my $thesaurus = "notdefined";
 195     if ( $ind2 eq '0' ) {
 196         $thesaurus = "lcsh";
 197     }
 198     elsif ( $ind2 eq '1' ) {
 199         $thesaurus = "lcac";
 200     }
 201     elsif ( $ind2 eq '2' ) {
 202         $thesaurus = "mesh";
 203     }
 204     elsif ( $ind2 eq '3' ) {
 205         $thesaurus = "nal";
 206     }
 207     elsif ( $ind2 eq '4' ) {
 208         $thesaurus = "notspecified";
 209     }
 210     elsif ( $ind2 eq '5' ) {
 211         $thesaurus = "cash";
 212     }
 213     elsif ( $ind2 eq '6' ) {
 214         $thesaurus = "rvm";
 215     }
 216     elsif ( $ind2 eq '7' ) {
 217         my $sf2 = $field->subfield('2');
 218         $thesaurus = $sf2 if defined($sf2);
 219     }
 220
 221     return $thesaurus;
 222 }
 223
 224 =head2 _get_search_heading
 225
 226 =cut
 227
 228 sub _get_search_heading {
 229     my $field     = shift;
 230     my $subfields = shift;
 231
 232     my $heading   = "";
 233     my @subfields = $field->subfields();
 234     my $first     = 1;
 235     for ( my $i = 0 ; $i <= $#subfields ; $i++ ) {
 236         my $code    = $subfields[$i]->[0];
 237         my $code_re = quotemeta $code;
 238         my $value   = $subfields[$i]->[1];
 239         $value =~ s/[-,.:=;!%\/]$//;
 240         next unless $subfields =~ qr/$code_re/;
 241         if ($first) {
 242             $first   = 0;
 243             $heading = $value;
 244         }
 245         else {
 246             if ( exists $subdivisions{$code} ) {
 247                 $heading .= " $subdivisions{$code} $value";
 248             }
 249             else {
 250                 $heading .= " $value";
 251             }
 252         }
 253     }
 254
 255     # remove characters that are part of CCL syntax
 256     $heading =~ s/[)(=]//g;
 257
 258     return $heading;
 259 }
 260
 261 =head2 _get_display_heading
 262
 263 =cut
 264
 265 sub _get_display_heading {
 266     my $field     = shift;
 267     my $subfields = shift;
 268
 269     my $heading   = "";
 270     my @subfields = $field->subfields();
 271     my $first     = 1;
 272     for ( my $i = 0 ; $i <= $#subfields ; $i++ ) {
 273         my $code    = $subfields[$i]->[0];
 274         my $code_re = quotemeta $code;
 275         my $value   = $subfields[$i]->[1];
 276         next unless $subfields =~ qr/$code_re/;
 277         if ($first) {
 278             $first   = 0;
 279             $heading = $value;
 280         }
 281         else {
 282             if ( exists $subdivisions{$code} ) {
 283                 $heading .= "--$value";
 284             }
 285             else {
 286                 $heading .= " $value";
 287             }
 288         }
 289     }
 290     return $heading;
 291 }
 292
 293 # Additional limiters that we aren't using:
 294 #    if ($self->{'subject_added_entry'}) {
 295 #        $limiters .= " AND Heading-use-subject-added-entry=a";
 296 #    }
 297 #    if ($self->{'series_added_entry'}) {
 298 #        $limiters .= " AND Heading-use-series-added-entry=a";
 299 #    }
 300 #    if (not $self->{'subject_added_entry'} and not $self->{'series_added_entry'}) {
 301 #        $limiters .= " AND Heading-use-main-or-added-entry=a"
 302 #    }
 303
 304 =head1 AUTHOR
 305
 306 Koha Development Team <http://koha-community.org/>
 307
 308 Galen Charlton <galen.charlton@liblime.com>
 309
 310 =cut
 311
 312 1;