File Coverage

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

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
4
4
4
4
61
16
121
use strict;
21#use warnings; FIXME - Bug 2505
22
4
4
4
4
27
15
180
use MARC::Record;
23
4
4
4
4
28
14
4810
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' => { 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 - 77
=head2 subdivisions

=cut
78
79my %subdivisions = (
80    'v' => 'formsubdiv',
81    'x' => 'generalsubdiv',
82    'y' => 'chronologicalsubdiv',
83    'z' => 'geographicsubdiv',
84);
85
86 - 92
=head1 METHODS

=head2 new

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

=cut
93
94sub new {
95
0
0
    my $class = shift;
96
0
    return bless {}, $class;
97}
98
99 - 101
=head2 valid_bib_heading_tag

=cut
102
103sub valid_bib_heading_tag {
104
0
0
    my $self = shift;
105
0
    my $tag = shift;
106
107
0
0
    if (exists $bib_heading_fields->{$tag}) {
108
0
        return 1
109    } else {
110
0
        return 0;
111    }
112
113}
114
115 - 117
=head2 parse_heading

=cut
118
119sub parse_heading {
120
0
0
    my $self = shift;
121
0
    my $field = shift;
122
123
0
    my $tag = $field->tag;
124
0
    my $field_info = $bib_heading_fields->{$tag};
125
126
0
    my $auth_type = $field_info->{'auth_type'};
127
0
0
    my $subject = $field_info->{'subject'} ? 1 : 0;
128
0
0
    my $series = $field_info->{'series'} ? 1 : 0;
129
0
0
    my $main_entry = $field_info->{'main_entry'} ? 1 : 0;
130
0
0
    my $thesaurus = $subject ? _get_subject_thesaurus($field) : "lcsh"; # use 'lcsh' for names, UT, etc.
131
0
    my $search_heading = _get_search_heading($field, $field_info->{'subfields'});
132
0
    my $display_heading = _get_display_heading($field, $field_info->{'subfields'});
133
134
0
    return ($auth_type, $subject, $series, $main_entry, $thesaurus, $search_heading, $display_heading);
135}
136
137 - 141
=head1 INTERNAL FUNCTIONS

=head2 _get_subject_thesaurus

=cut
142
143sub _get_subject_thesaurus {
144
0
0
    my $field = shift;
145
0
    my $ind2 = $field->indicator(2);
146
147
0
    my $thesaurus = "notdefined";
148
0
0
0
0
0
0
0
0
0
    if ($ind2 eq '0') {
149
0
        $thesaurus = "lcsh";
150    } elsif ($ind2 eq '1') {
151
0
        $thesaurus = "lcac";
152    } elsif ($ind2 eq '2') {
153
0
        $thesaurus = "mesh";
154    } elsif ($ind2 eq '3') {
155
0
        $thesaurus = "nal";
156    } elsif ($ind2 eq '4') {
157
0
        $thesaurus = "notspecified";
158    } elsif ($ind2 eq '5') {
159
0
        $thesaurus = "cash";
160    } elsif ($ind2 eq '6') {
161
0
        $thesaurus = "rvm";
162    } elsif ($ind2 eq '7') {
163
0
        my $sf2 = $field->subfield('2');
164
0
0
        $thesaurus = $sf2 if defined($sf2);
165    }
166
167
0
    return $thesaurus;
168}
169
170 - 172
=head2 _get_search_heading

=cut
173
174sub _get_search_heading {
175
0
0
    my $field = shift;
176
0
    my $subfields = shift;
177
178
0
    my $heading = "";
179
0
    my @subfields = $field->subfields();
180
0
    my $first = 1;
181    for (my $i = 0; $i <= $#subfields; $i++) {
182
0
        my $code = $subfields[$i]->[0];
183
0
        my $code_re = quotemeta $code;
184
0
        my $value = $subfields[$i]->[1];
185
0
0
        next unless $subfields =~ qr/$code_re/;
186
0
0
        if ($first) {
187
0
            $first = 0;
188
0
            $heading = $value;
189        } else {
190
0
0
            if (exists $subdivisions{$code}) {
191
0
                $heading .= " $subdivisions{$code} $value";
192            } else {
193
0
                $heading .= " $value";
194            }
195        }
196
0
    }
197
198    # remove characters that are part of CCL syntax
199
0
    $heading =~ s/[)(=]//g;
200
201
0
    return $heading;
202}
203
204 - 206
=head2 _get_display_heading

=cut
207
208sub _get_display_heading {
209
0
0
    my $field = shift;
210
0
    my $subfields = shift;
211
212
0
    my $heading = "";
213
0
    my @subfields = $field->subfields();
214
0
    my $first = 1;
215    for (my $i = 0; $i <= $#subfields; $i++) {
216
0
        my $code = $subfields[$i]->[0];
217
0
        my $code_re = quotemeta $code;
218
0
        my $value = $subfields[$i]->[1];
219
0
0
        next unless $subfields =~ qr/$code_re/;
220
0
0
        if ($first) {
221
0
            $first = 0;
222
0
            $heading = $value;
223        } else {
224
0
0
            if (exists $subdivisions{$code}) {
225
0
                $heading .= "--$value";
226            } else {
227
0
                $heading .= " $value";
228            }
229        }
230
0
    }
231
0
    return $heading;
232}
233
234 - 240
=head1 AUTHOR

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

Galen Charlton <galen.charlton@liblime.com>

=cut
241
2421;