File Coverage

File:C4/Heading/MARC21.pm
Coverage:13.0%

linestmtbrancondsubtimecode
1package 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
1
1
1
1
280
2
22
use strict;
21
1
1
1
1
4
2
31
use warnings;
22
1
1
1
1
4
2
41
use MARC::Record;
23
1
1
1
1
4
27
1125
use MARC::Field;
24
25our $VERSION = 3.00;
26
27 - 49
=head1 NAME

C4::Heading::MARC21

=head1 SYNOPSIS

use C4::Heading::MARC21;

=head1 DESCRIPTION

This is an internal helper class used by
C<C4::Heading> to parse headings data from
MARC21 records.  Object of this type
do not carry data, instead, they only
dispatch functions.

=head1 DATA STRUCTURES

FIXME - this should be moved to a configuration file.

=head2 bib_heading_fields

=cut
50
51my $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 - 119
=head2 subdivisions

=cut
120
121my %subdivisions = (
122    'v' => 'formsubdiv',
123    'x' => 'generalsubdiv',
124    'y' => 'chronologicalsubdiv',
125    'z' => 'geographicsubdiv',
126);
127
128 - 134
=head1 METHODS

=head2 new

  my $marc_handler = C4::Heading::MARC21->new();

=cut
135
136sub new {
137
0
0
    my $class = shift;
138
0
    return bless {}, $class;
139}
140
141 - 143
=head2 valid_bib_heading_tag

=cut
144
145sub valid_bib_heading_tag {
146
0
0
    my $self = shift;
147
0
    my $tag = shift;
148
0
    my $frameworkcode = shift;
149
150
0
0
    if ( exists $bib_heading_fields->{$tag} ) {
151
0
        return 1;
152    }
153    else {
154
0
        return 0;
155    }
156
157}
158
159 - 161
=head2 parse_heading

=cut
162
163sub parse_heading {
164
0
0
    my $self = shift;
165
0
    my $field = shift;
166
167
0
    my $tag = $field->tag;
168
0
    my $field_info = $bib_heading_fields->{$tag};
169
170
0
    my $auth_type = $field_info->{'auth_type'};
171
0
0
    my $thesaurus =
172      $tag =~ m/6../
173      ? _get_subject_thesaurus($field)
174      : "lcsh"; # use 'lcsh' for names, UT, etc.
175
0
    my $search_heading =
176      _get_search_heading( $field, $field_info->{'subfields'} );
177
0
    my $display_heading =
178      _get_display_heading( $field, $field_info->{'subfields'} );
179
180
0
    return ( $auth_type, $thesaurus, $search_heading, $display_heading,
181        'exact' );
182}
183
184 - 188
=head1 INTERNAL FUNCTIONS

=head2 _get_subject_thesaurus

=cut
189
190sub _get_subject_thesaurus {
191
0
0
    my $field = shift;
192
0
    my $ind2 = $field->indicator(2);
193
194
0
    my $thesaurus = "notdefined";
195
0
0
0
0
0
0
0
0
0
    if ( $ind2 eq '0' ) {
196
0
        $thesaurus = "lcsh";
197    }
198    elsif ( $ind2 eq '1' ) {
199
0
        $thesaurus = "lcac";
200    }
201    elsif ( $ind2 eq '2' ) {
202
0
        $thesaurus = "mesh";
203    }
204    elsif ( $ind2 eq '3' ) {
205
0
        $thesaurus = "nal";
206    }
207    elsif ( $ind2 eq '4' ) {
208
0
        $thesaurus = "notspecified";
209    }
210    elsif ( $ind2 eq '5' ) {
211
0
        $thesaurus = "cash";
212    }
213    elsif ( $ind2 eq '6' ) {
214
0
        $thesaurus = "rvm";
215    }
216    elsif ( $ind2 eq '7' ) {
217
0
        my $sf2 = $field->subfield('2');
218
0
0
        $thesaurus = $sf2 if defined($sf2);
219    }
220
221
0
    return $thesaurus;
222}
223
224 - 226
=head2 _get_search_heading

=cut
227
228sub _get_search_heading {
229
0
0
    my $field = shift;
230
0
    my $subfields = shift;
231
232
0
    my $heading = "";
233
0
    my @subfields = $field->subfields();
234
0
    my $first = 1;
235    for ( my $i = 0 ; $i <= $#subfields ; $i++ ) {
236
0
        my $code = $subfields[$i]->[0];
237
0
        my $code_re = quotemeta $code;
238
0
        my $value = $subfields[$i]->[1];
239
0
        $value =~ s/[-,.:=;!%\/]$//;
240
0
0
        next unless $subfields =~ qr/$code_re/;
241
0
0
        if ($first) {
242
0
            $first = 0;
243
0
            $heading = $value;
244        }
245        else {
246
0
0
            if ( exists $subdivisions{$code} ) {
247
0
                $heading .= " $subdivisions{$code} $value";
248            }
249            else {
250
0
                $heading .= " $value";
251            }
252        }
253
0
    }
254
255    # remove characters that are part of CCL syntax
256
0
    $heading =~ s/[)(=]//g;
257
258
0
    return $heading;
259}
260
261 - 263
=head2 _get_display_heading

=cut
264
265sub _get_display_heading {
266
0
0
    my $field = shift;
267
0
    my $subfields = shift;
268
269
0
    my $heading = "";
270
0
    my @subfields = $field->subfields();
271
0
    my $first = 1;
272    for ( my $i = 0 ; $i <= $#subfields ; $i++ ) {
273
0
        my $code = $subfields[$i]->[0];
274
0
        my $code_re = quotemeta $code;
275
0
        my $value = $subfields[$i]->[1];
276
0
0
        next unless $subfields =~ qr/$code_re/;
277
0
0
        if ($first) {
278
0
            $first = 0;
279
0
            $heading = $value;
280        }
281        else {
282
0
0
            if ( exists $subdivisions{$code} ) {
283
0
                $heading .= "--$value";
284            }
285            else {
286
0
                $heading .= " $value";
287            }
288        }
289
0
    }
290
0
    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 - 310
=head1 AUTHOR

Koha Development Team <http://koha-community.org/>

Galen Charlton <galen.charlton@liblime.com>

=cut
311
3121;