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 unless ( defined $bib_heading_fields ) {
72 my $dbh = C4::Context->dbh;
73 my $sth = $dbh->prepare(
74 "SELECT tagfield, authtypecode
75 FROM marc_subfield_structure
76 WHERE frameworkcode = '' AND authtypecode <> ''"
79 $bib_heading_fields = {};
80 while ( my ( $tag, $auth_type ) = $sth->fetchrow ) {
81 $bib_heading_fields->{$tag} = {
82 auth_type => $auth_type,
83 subfields => 'abcdefghjklmnopqrstvxyz',
88 return bless {}, $class;
91 =head2 valid_heading_tag
95 sub valid_heading_tag {
96 my ( $self, $tag ) = @_;
97 return $bib_heading_fields->{$tag};
100 =head2 valid_heading_subfield
104 sub valid_heading_subfield {
107 my $subfield = shift;
109 if ( exists $bib_heading_fields->{$tag} ) {
110 return 1 if ($bib_heading_fields->{$tag}->{subfields} =~ /$subfield/);
120 my ( $self, $field ) = @_;
122 my $tag = $field->tag;
123 my $field_info = $bib_heading_fields->{$tag};
124 my $auth_type = $field_info->{'auth_type'};
126 _get_search_heading( $field, $field_info->{'subfields'} );
127 my $display_heading =
128 _get_display_heading( $field, $field_info->{'subfields'} );
130 return ( $auth_type, undef, $search_heading, $display_heading, 'exact' );
133 =head1 INTERNAL FUNCTIONS
135 =head2 _get_subject_thesaurus
139 sub _get_subject_thesaurus {
142 my $thesaurus = "notdefined";
143 my $sf2 = $field->subfield('2');
144 $thesaurus = $sf2 if defined($sf2);
149 =head2 _get_search_heading
153 sub _get_search_heading {
155 my $subfields = shift;
158 my @subfields = $field->subfields();
160 for ( my $i = 0 ; $i <= $#subfields ; $i++ ) {
161 my $code = $subfields[$i]->[0];
162 my $code_re = quotemeta $code;
163 my $value = $subfields[$i]->[1];
164 $value =~ s/[\s]*[-,.:=;!%\/][\s]*$//;
165 next unless $subfields =~ qr/$code_re/;
171 if ( exists $subdivisions{$code} ) {
172 $heading .= " $subdivisions{$code} $value";
175 $heading .= " $value";
180 # remove characters that are part of CCL syntax
181 $heading =~ s/[)(=]//g;
186 =head2 _get_display_heading
190 sub _get_display_heading {
192 my $subfields = shift;
195 my @subfields = $field->subfields();
197 for ( my $i = 0 ; $i <= $#subfields ; $i++ ) {
198 my $code = $subfields[$i]->[0];
199 my $code_re = quotemeta $code;
200 my $value = $subfields[$i]->[1];
201 next unless $subfields =~ qr/$code_re/;
207 if ( exists $subdivisions{$code} ) {
208 $heading .= "--$value";
211 $heading .= " $value";
220 Koha Development Team <http://koha-community.org/>
222 Jared Camins-Esakov <jcamins@cpbibliography.com>