1 package C4::Heading::UNIMARC;
3 # Copyright (C) 2011 C & P Bibliography Services
5 # This file is part of Koha.
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
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.
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.
35 use C4::Heading::UNIMARC;
39 This is an internal helper class used by
40 C<C4::Heading> to parse headings data from
41 UNIMARC records. Object of this type
42 do not carry data, instead, they only
45 =head1 DATA STRUCTURES
47 FIXME - this should be moved to a configuration file.
55 'x' => 'generalsubdiv',
56 'y' => 'chronologicalsubdiv',
57 'z' => 'geographicsubdiv',
60 my $bib_heading_fields;
63 my $dbh = C4::Context->dbh;
64 my $sth = $dbh->prepare(
65 "SELECT tagfield, authtypecode
66 FROM marc_subfield_structure
67 WHERE frameworkcode = '' AND authtypecode <> ''"
70 $bib_heading_fields = {};
71 while ( my ( $tag, $auth_type ) = $sth->fetchrow ) {
72 $bib_heading_fields->{$tag} = {
73 auth_type => $auth_type,
74 subfields => 'abcdefghjklmnopqrstvxyz',
83 my $marc_handler = C4::Heading::UNIMARC->new();
89 return bless {}, $class;
92 =head2 valid_bib_heading_tag
96 sub valid_bib_heading_tag {
97 my ( $self, $tag ) = @_;
98 return $bib_heading_fields->{$tag};
106 my ( $self, $field ) = @_;
108 my $tag = $field->tag;
109 my $field_info = $bib_heading_fields->{$tag};
110 my $auth_type = $field_info->{'auth_type'};
112 _get_search_heading( $field, $field_info->{'subfields'} );
113 my $display_heading =
114 _get_display_heading( $field, $field_info->{'subfields'} );
116 return ( $auth_type, undef, $search_heading, $display_heading, 'exact' );
119 =head1 INTERNAL FUNCTIONS
121 =head2 _get_subject_thesaurus
125 sub _get_subject_thesaurus {
128 my $thesaurus = "notdefined";
129 my $sf2 = $field->subfield('2');
130 $thesaurus = $sf2 if defined($sf2);
135 =head2 _get_search_heading
139 sub _get_search_heading {
141 my $subfields = shift;
144 my @subfields = $field->subfields();
146 for ( my $i = 0 ; $i <= $#subfields ; $i++ ) {
147 my $code = $subfields[$i]->[0];
148 my $code_re = quotemeta $code;
149 my $value = $subfields[$i]->[1];
150 $value =~ s/[-,.:=;!%\/]*$//;
151 next unless $subfields =~ qr/$code_re/;
157 $heading .= " $value";
161 # remove characters that are part of CCL syntax
162 $heading =~ s/[)(=]//g;
167 =head2 _get_display_heading
171 sub _get_display_heading {
173 my $subfields = shift;
176 my @subfields = $field->subfields();
178 for ( my $i = 0 ; $i <= $#subfields ; $i++ ) {
179 my $code = $subfields[$i]->[0];
180 my $code_re = quotemeta $code;
181 my $value = $subfields[$i]->[1];
182 next unless $subfields =~ qr/$code_re/;
188 if ( exists $subdivisions{$code} ) {
189 $heading .= "--$value";
192 $heading .= " $value";
201 Koha Development Team <http://koha-community.org/>
203 Jared Camins-Esakov <jcamins@cpbibliography.com>