Bug 26922: Regression tests
[koha.git] / C4 / Heading.pm
blobc58b507feffc7f10f766a523994ed4f9c54baf51
1 package C4::Heading;
3 # Copyright (C) 2008 LibLime
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>.
20 use Modern::Perl;
22 use MARC::Record;
23 use MARC::Field;
24 use C4::Context;
25 use Module::Load;
26 use Carp;
29 =head1 NAME
31 C4::Heading
33 =head1 SYNOPSIS
35 use C4::Heading;
36 my $heading = C4::Heading->new_from_field($field, $frameworkcode);
37 my $thesaurus = $heading->thesaurus();
38 my $type = $heading->type();
39 my $display_heading = $heading->display_form();
40 my $search_form = $heading->search_form();
42 =head1 DESCRIPTION
44 C<C4::Heading> implements a simple class to representing
45 headings found in bibliographic and authority records.
47 =head1 METHODS
49 =head2 new_from_field
51 my $heading = C4::Heading->new_from_field($field, $frameworkcode, [, $auth]);
53 Given a C<MARC::Field> object containing a heading from a
54 bib record, create a C<C4::Heading> object.
56 The optional third parameter is 'auth' - it is handled as boolean. If supplied we treat the field as an auth record field. Otherwise if it is a bib field. The fields checked are the same in a UNIMARC system and this parameter is ignored
58 If the MARC field supplied is not a valid heading, undef
59 is returned.
61 =cut
63 sub new_from_field {
64 my $class = shift;
65 my $field = shift;
66 my $frameworkcode = shift; #FIXME this is not used?
67 my $auth = shift;
68 my $marcflavour = C4::Context->preference('marcflavour');
69 my $marc_handler = _marc_format_handler($marcflavour);
71 my $tag = $field->tag();
72 return unless $marc_handler->valid_heading_tag( $tag, $frameworkcode, $auth );
73 my $self = {};
75 $self->{'field'} = $field;
77 $self->{'auth_type'}, $self->{'thesaurus'},
78 $self->{'search_form'}, $self->{'display_form'},
79 $self->{'match_type'}
80 ) = $marc_handler->parse_heading($field, $auth );
82 bless $self, $class;
83 return $self;
86 =head2 auth_type
88 my $auth_type = $heading->auth_type();
90 Return the auth_type of the heading.
92 =cut
94 sub auth_type {
95 my $self = shift;
96 return $self->{'auth_type'};
99 =head2 field
101 my $field = $heading->field();
103 Return the MARC::Field the heading is based on.
105 =cut
107 sub field {
108 my $self = shift;
109 return $self->{'field'};
112 =head2 display_form
114 my $display = $heading->display_form();
116 Return the "canonical" display form of the heading.
118 =cut
120 sub display_form {
121 my $self = shift;
122 return $self->{'display_form'};
125 =head2 search_form
127 my $search_form = $heading->search_form();
129 Return the "canonical" search form of the heading.
131 =cut
133 sub search_form {
134 my $self = shift;
135 return $self->{'search_form'};
138 =head2 authorities
140 my $authorities = $heading->authorities([$skipmetadata]);
142 Return a list of authority records for this
143 heading. If passed a true value for $skipmetadata,
144 SearchAuthorities will return only authids.
146 =cut
148 sub authorities {
149 my $self = shift;
150 my $skipmetadata = shift;
151 my ( $results, $total ) = _search( $self, 'match-heading', $skipmetadata );
152 return $results;
155 =head2 preferred_authorities
157 my $preferred_authorities = $heading->preferred_authorities;
159 Return a list of authority records for headings
160 that are a preferred form of the heading.
162 =cut
164 sub preferred_authorities {
165 my $self = shift;
166 my $skipmetadata = shift || undef;
167 my ( $results, $total ) = _search( 'see-from', $skipmetadata );
168 return $results;
171 =head2 valid_heading_subfield
173 if (C4::Heading::valid_heading_subfield('100', 'e', '')) ...
175 =cut
177 sub valid_heading_subfield {
178 my $tag = shift;
179 my $subfield = shift;
180 my $marcflavour = C4::Context->preference('marcflavour');
181 my $auth = shift;
183 my $marc_handler = _marc_format_handler($marcflavour);
184 return $marc_handler->valid_heading_subfield( $tag, $subfield, $auth );
187 =head1 INTERNAL METHODS
189 =head2 _search
191 =cut
193 sub _search {
194 my $self = shift;
195 my $index = shift || undef;
196 my $skipmetadata = shift || undef;
197 my @marclist;
198 my @and_or;
199 my @excluding = [];
200 my @operator;
201 my @value;
203 if ($index) {
204 push @marclist, $index;
205 push @and_or, 'and';
206 push @operator, $self->{'match_type'};
207 push @value, $self->{'search_form'};
210 # if ($self->{'thesaurus'}) {
211 # push @marclist, 'thesaurus';
212 # push @and_or, 'and';
213 # push @excluding, '';
214 # push @operator, 'is';
215 # push @value, $self->{'thesaurus'};
218 require Koha::SearchEngine::QueryBuilder;
219 require Koha::SearchEngine::Search;
221 # Use state variables to avoid recreating the objects every time.
222 # With Elasticsearch this also avoids creating a massive amount of
223 # ES connectors that would eventually run out of file descriptors.
224 state $builder = Koha::SearchEngine::QueryBuilder->new(
225 { index => $Koha::SearchEngine::AUTHORITIES_INDEX } );
226 state $searcher = Koha::SearchEngine::Search->new(
227 {index => $Koha::SearchEngine::AUTHORITIES_INDEX} );
229 my $search_query = $builder->build_authorities_query_compat(
230 \@marclist, \@and_or, \@excluding, \@operator,
231 \@value, $self->{'auth_type'},
232 'AuthidAsc'
234 return $searcher->search_auth_compat( $search_query, 0, 20, $skipmetadata );
237 =head1 INTERNAL FUNCTIONS
239 =head2 _marc_format_handler
241 Returns a C4::Heading::MARC21 or C4::Heading::UNIMARC object
242 depending on the selected MARC flavour.
244 =cut
246 sub _marc_format_handler {
247 my $marcflavour = uc shift;
248 $marcflavour = 'MARC21' if ( $marcflavour eq 'NORMARC' );
249 my $pname = "C4::Heading::$marcflavour";
250 load $pname;
251 return $pname->new();
254 =head1 AUTHOR
256 Koha Development Team <http://koha-community.org/>
258 Galen Charlton <galen.charlton@liblime.com>
260 =cut