File Coverage

File:C4/Heading/UNIMARC.pm
Coverage:33.0%

linestmtbrancondsubtimecode
1package C4::Heading::UNIMARC;
2
3# Copyright (C) 2011 C & P Bibliography Services
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
1
1
1
1
329
63
25
12
8
20
use 5.010;
21
1
1
1
1
10
7
50
use strict;
22
1
1
1
1
10
6
38
use warnings;
23
1
1
1
1
10
7
44
use MARC::Record;
24
1
1
1
1
10
6
24
use MARC::Field;
25
1
1
1
1
10
5
18
use C4::Context;
26
27our $VERSION = 3.00;
28
29 - 51
=head1 NAME

C4::Heading::UNIMARC

=head1 SYNOPSIS

use C4::Heading::UNIMARC;

=head1 DESCRIPTION

This is an internal helper class used by
C<C4::Heading> to parse headings data from
UNIMARC 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 subdivisions

=cut
52
53my %subdivisions = (
54    'j' => 'formsubdiv',
55    'x' => 'generalsubdiv',
56    'y' => 'chronologicalsubdiv',
57    'z' => 'geographicsubdiv',
58);
59
60my $bib_heading_fields;
61
62BEGIN {
63
1
1
14
    my $dbh = C4::Context->dbh;
64
1
11
    my $sth = $dbh->prepare(
65        "SELECT tagfield, authtypecode
66         FROM marc_subfield_structure
67         WHERE frameworkcode = '' AND authtypecode <> ''"
68    );
69
1
5748
    $sth->execute();
70
1
6
    $bib_heading_fields = {};
71
1
751
    while ( my ( $tag, $auth_type ) = $sth->fetchrow ) {
72
0
        $bib_heading_fields->{$tag} = {
73            auth_type => $auth_type,
74            subfields => 'abcdefghjklmnopqrstvxyz',
75        };
76    }
77}
78
79 - 85
=head1 METHODS

=head2 new

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

=cut
86
87sub new {
88
0
0
    my $class = shift;
89
0
    return bless {}, $class;
90}
91
92 - 94
=head2 valid_bib_heading_tag

=cut
95
96sub valid_bib_heading_tag {
97
0
0
    my ( $self, $tag ) = @_;
98
0
    return $bib_heading_fields->{$tag};
99}
100
101 - 103
=head2 parse_heading

=cut
104
105sub parse_heading {
106
0
0
    my ( $self, $field ) = @_;
107
108
0
    my $tag = $field->tag;
109
0
    my $field_info = $bib_heading_fields->{$tag};
110
0
    my $auth_type = $field_info->{'auth_type'};
111
0
    my $search_heading =
112      _get_search_heading( $field, $field_info->{'subfields'} );
113
0
    my $display_heading =
114      _get_display_heading( $field, $field_info->{'subfields'} );
115
116
0
    return ( $auth_type, undef, $search_heading, $display_heading, 'exact' );
117}
118
119 - 123
=head1 INTERNAL FUNCTIONS

=head2 _get_subject_thesaurus

=cut
124
125sub _get_subject_thesaurus {
126
0
0
    my $field = shift;
127
128
0
    my $thesaurus = "notdefined";
129
0
    my $sf2 = $field->subfield('2');
130
0
0
    $thesaurus = $sf2 if defined($sf2);
131
132
0
    return $thesaurus;
133}
134
135 - 137
=head2 _get_search_heading

=cut
138
139sub _get_search_heading {
140
0
0
    my $field = shift;
141
0
    my $subfields = shift;
142
143
0
    my $heading = "";
144
0
    my @subfields = $field->subfields();
145
0
    my $first = 1;
146    for ( my $i = 0 ; $i <= $#subfields ; $i++ ) {
147
0
        my $code = $subfields[$i]->[0];
148
0
        my $code_re = quotemeta $code;
149
0
        my $value = $subfields[$i]->[1];
150
0
        $value =~ s/[-,.:=;!%\/]*$//;
151
0
0
        next unless $subfields =~ qr/$code_re/;
152
0
0
        if ($first) {
153
0
            $first = 0;
154
0
            $heading = $value;
155        }
156        else {
157
0
            $heading .= " $value";
158        }
159
0
    }
160
161    # remove characters that are part of CCL syntax
162
0
    $heading =~ s/[)(=]//g;
163
164
0
    return $heading;
165}
166
167 - 169
=head2 _get_display_heading

=cut
170
171sub _get_display_heading {
172
0
0
    my $field = shift;
173
0
    my $subfields = shift;
174
175
0
    my $heading = "";
176
0
    my @subfields = $field->subfields();
177
0
    my $first = 1;
178    for ( my $i = 0 ; $i <= $#subfields ; $i++ ) {
179
0
        my $code = $subfields[$i]->[0];
180
0
        my $code_re = quotemeta $code;
181
0
        my $value = $subfields[$i]->[1];
182
0
0
        next unless $subfields =~ qr/$code_re/;
183
0
0
        if ($first) {
184
0
            $first = 0;
185
0
            $heading = $value;
186        }
187        else {
188
0
0
            if ( exists $subdivisions{$code} ) {
189
0
                $heading .= "--$value";
190            }
191            else {
192
0
                $heading .= " $value";
193            }
194        }
195
0
    }
196
0
    return $heading;
197}
198
199 - 205
=head1 AUTHOR

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

Jared Camins-Esakov <jcamins@cpbibliography.com>

=cut
206
2071;