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
8 # under the terms of the GNU General Public License as published by
9 # the Free Software Foundation; either version 3 of the License, or
10 # (at your option) any later version.
12 # Koha is distributed in the hope that it will be useful, but
13 # WITHOUT ANY WARRANTY; without even the implied warranty of
14 # MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
15 # GNU General Public License for more details.
17 # You should have received a copy of the GNU General Public License
18 # along with Koha; if not, see <http://www.gnu.org/licenses>.
33 use C4::Heading::UNIMARC;
37 This is an internal helper class used by
38 C<C4::Heading> to parse headings data from
39 UNIMARC records. Object of this type
40 do not carry data, instead, they only
43 =head1 DATA STRUCTURES
45 FIXME - this should be moved to a configuration file.
53 'x' => 'generalsubdiv',
54 'y' => 'geographicsubdiv',
55 'z' => 'chronologicalsubdiv',
58 my $bib_heading_fields;
64 my $marc_handler = C4::Heading::UNIMARC->new();
71 my $dbh = C4::Context->dbh;
72 my $sth = $dbh->prepare(
73 "SELECT tagfield, authtypecode
74 FROM marc_subfield_structure
75 WHERE frameworkcode = '' AND authtypecode <> ''"
78 $bib_heading_fields = {};
79 while ( my ( $tag, $auth_type ) = $sth->fetchrow ) {
80 $bib_heading_fields->{$tag} = {
81 auth_type => $auth_type,
82 subfields => 'abcdefghjklmnopqrstvxyz',
86 return bless {}, $class;
89 =head2 valid_heading_tag
93 sub valid_heading_tag {
94 my ( $self, $tag ) = @_;
95 return $bib_heading_fields->{$tag};
98 =head2 valid_heading_subfield
102 sub valid_heading_subfield {
105 my $subfield = shift;
107 if ( exists $bib_heading_fields->{$tag} ) {
108 return 1 if ($bib_heading_fields->{$tag}->{subfields} =~ /$subfield/);
118 my ( $self, $field ) = @_;
120 my $tag = $field->tag;
121 my $field_info = $bib_heading_fields->{$tag};
122 my $auth_type = $field_info->{'auth_type'};
124 _get_search_heading( $field, $field_info->{'subfields'} );
125 my $display_heading =
126 _get_display_heading( $field, $field_info->{'subfields'} );
128 return ( $auth_type, undef, $search_heading, $display_heading, 'exact' );
131 =head1 INTERNAL FUNCTIONS
133 =head2 _get_subject_thesaurus
137 sub _get_subject_thesaurus {
140 my $thesaurus = "notdefined";
141 my $sf2 = $field->subfield('2');
142 $thesaurus = $sf2 if defined($sf2);
147 =head2 _get_search_heading
151 sub _get_search_heading {
153 my $subfields = shift;
156 my @subfields = $field->subfields();
158 for ( my $i = 0 ; $i <= $#subfields ; $i++ ) {
159 my $code = $subfields[$i]->[0];
160 my $code_re = quotemeta $code;
161 my $value = $subfields[$i]->[1];
162 $value =~ s/[\s]*[-,.:=;!%\/][\s]*$//;
163 next unless $subfields =~ qr/$code_re/;
169 if ( exists $subdivisions{$code} ) {
170 $heading .= " $subdivisions{$code} $value";
173 $heading .= " $value";
178 # remove characters that are part of CCL syntax
179 $heading =~ s/[)(=]//g;
184 =head2 _get_display_heading
188 sub _get_display_heading {
190 my $subfields = shift;
193 my @subfields = $field->subfields();
195 for ( my $i = 0 ; $i <= $#subfields ; $i++ ) {
196 my $code = $subfields[$i]->[0];
197 my $code_re = quotemeta $code;
198 my $value = $subfields[$i]->[1];
199 next unless $subfields =~ qr/$code_re/;
205 if ( exists $subdivisions{$code} ) {
206 $heading .= "--$value";
209 $heading .= " $value";
218 Koha Development Team <http://koha-community.org/>
220 Jared Camins-Esakov <jcamins@cpbibliography.com>