330 lines
9.0 KiB
Perl
330 lines
9.0 KiB
Perl
package C4::Heading;
|
|
|
|
# Copyright (C) 2008 LibLime
|
|
#
|
|
# This file is part of Koha.
|
|
#
|
|
# Koha is free software; you can redistribute it and/or modify it
|
|
# under the terms of the GNU General Public License as published by
|
|
# the Free Software Foundation; either version 3 of the License, or
|
|
# (at your option) any later version.
|
|
#
|
|
# Koha is distributed in the hope that it will be useful, but
|
|
# WITHOUT ANY WARRANTY; without even the implied warranty of
|
|
# MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
|
|
# GNU General Public License for more details.
|
|
#
|
|
# You should have received a copy of the GNU General Public License
|
|
# along with Koha; if not, see <https://www.gnu.org/licenses>.
|
|
|
|
use Modern::Perl;
|
|
use base 'Exporter';
|
|
|
|
BEGIN {
|
|
our @EXPORT_OK = qw(
|
|
new_from_field
|
|
);
|
|
}
|
|
|
|
use MARC::Field;
|
|
use C4::Context;
|
|
use Module::Load qw( load );
|
|
use List::Util qw( none first );
|
|
|
|
=head1 NAME
|
|
|
|
C4::Heading
|
|
|
|
=head1 SYNOPSIS
|
|
|
|
use C4::Heading;
|
|
my $heading = C4::Heading->new_from_field($field, $frameworkcode);
|
|
my $thesaurus = $heading->thesaurus();
|
|
my $type = $heading->type();
|
|
my $display_heading = $heading->display_form();
|
|
my $search_form = $heading->search_form();
|
|
|
|
=head1 DESCRIPTION
|
|
|
|
C<C4::Heading> implements a simple class to representing
|
|
headings found in bibliographic and authority records.
|
|
|
|
=head1 METHODS
|
|
|
|
=head2 new_from_field
|
|
|
|
my $heading = C4::Heading->new_from_field($field, $frameworkcode, [, $auth]);
|
|
|
|
Given a C<MARC::Field> object containing a heading from a
|
|
bib record, create a C<C4::Heading> object.
|
|
|
|
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
|
|
|
|
If the MARC field supplied is not a valid heading, undef
|
|
is returned.
|
|
|
|
=cut
|
|
|
|
sub new_from_field {
|
|
my $class = shift;
|
|
my $field = shift;
|
|
my $frameworkcode = shift; #FIXME this is not used?
|
|
my $auth = shift;
|
|
my $marcflavour = C4::Context->preference('marcflavour');
|
|
my $marc_handler = _marc_format_handler($marcflavour);
|
|
|
|
return unless $field;
|
|
my $tag = $field->tag();
|
|
return unless $marc_handler->valid_heading_tag( $tag, $frameworkcode, $auth );
|
|
my $self = {};
|
|
|
|
$self->{'field'} = $field;
|
|
(
|
|
$self->{'auth_type'}, $self->{'thesaurus'},
|
|
$self->{'search_form'}, $self->{'display_form'},
|
|
$self->{'match_type'}
|
|
) = $marc_handler->parse_heading( $field, $auth );
|
|
|
|
bless $self, $class;
|
|
return $self;
|
|
}
|
|
|
|
=head2 auth_type
|
|
|
|
my $auth_type = $heading->auth_type();
|
|
|
|
Return the auth_type of the heading.
|
|
|
|
=cut
|
|
|
|
sub auth_type {
|
|
my $self = shift;
|
|
return $self->{'auth_type'};
|
|
}
|
|
|
|
=head2 field
|
|
|
|
my $field = $heading->field();
|
|
|
|
Return the MARC::Field the heading is based on.
|
|
|
|
=cut
|
|
|
|
sub field {
|
|
my $self = shift;
|
|
return $self->{'field'};
|
|
}
|
|
|
|
=head2 display_form
|
|
|
|
my $display = $heading->display_form();
|
|
|
|
Return the "canonical" display form of the heading.
|
|
|
|
=cut
|
|
|
|
sub display_form {
|
|
my $self = shift;
|
|
return $self->{'display_form'};
|
|
}
|
|
|
|
=head2 search_form
|
|
|
|
my $search_form = $heading->search_form();
|
|
|
|
Return the "canonical" search form of the heading.
|
|
|
|
=cut
|
|
|
|
sub search_form {
|
|
my $self = shift;
|
|
return $self->{'search_form'};
|
|
}
|
|
|
|
=head2 authorities
|
|
|
|
my $authorities = $heading->authorities([$skipmetadata]);
|
|
|
|
Return a list of authority records for this
|
|
heading. If passed a true value for $skipmetadata,
|
|
SearchAuthorities will return only authids.
|
|
|
|
=cut
|
|
|
|
sub authorities {
|
|
my $self = shift;
|
|
my $skipmetadata = shift;
|
|
my ( $results, $total ) = _search( $self, 'match-heading', $skipmetadata );
|
|
if ( C4::Context->preference('LinkerConsiderDiacritics') ) {
|
|
return $self->_filter_diacritics($results);
|
|
} else {
|
|
return $results;
|
|
}
|
|
}
|
|
|
|
=head2 valid_heading_subfield
|
|
|
|
if (C4::Heading::valid_heading_subfield('100', 'e', '')) ...
|
|
|
|
Check if the given subfield is valid for the given field.
|
|
|
|
=cut
|
|
|
|
sub valid_heading_subfield {
|
|
my $tag = shift;
|
|
my $subfield = shift;
|
|
my $marcflavour = C4::Context->preference('marcflavour');
|
|
my $auth = shift;
|
|
|
|
my $marc_handler = _marc_format_handler($marcflavour);
|
|
return $marc_handler->valid_heading_subfield( $tag, $subfield, $auth );
|
|
}
|
|
|
|
=head1 INTERNAL METHODS
|
|
|
|
=head2 _search
|
|
|
|
=cut
|
|
|
|
sub _search {
|
|
my $self = shift;
|
|
my $index = shift || undef;
|
|
my $skipmetadata = shift || undef;
|
|
my $thesaurus = $self->{thesaurus};
|
|
my $subject_heading_thesaurus = '';
|
|
my @marclist;
|
|
my @and_or;
|
|
my @excluding = [];
|
|
my @operator;
|
|
my @value;
|
|
|
|
my $check_thesaurus = C4::Context->preference('LinkerConsiderThesaurus');
|
|
|
|
# FIXME: We specify values for @and_or and @excluding
|
|
# but these fields are not used anywhere and should be removed
|
|
if ($index) {
|
|
push @marclist, $index;
|
|
push @and_or, 'AND';
|
|
push @operator, $self->{'match_type'};
|
|
push @value, $self->{'search_form'};
|
|
}
|
|
|
|
if ( $check_thesaurus && $thesaurus ) {
|
|
push @marclist, 'thesaurus';
|
|
push @and_or, 'and';
|
|
push @excluding, '';
|
|
push @operator, 'is';
|
|
push @value, $thesaurus;
|
|
}
|
|
|
|
if ( C4::Context->preference('ConsiderHeadingUse') ) {
|
|
my $marcflavour = C4::Context->preference('marcflavour');
|
|
my $biblio_tag = $self->{'field'}->tag;
|
|
if ( $marcflavour eq 'MARC21' ) {
|
|
my $heading_use_search_field =
|
|
$biblio_tag =~ /^[127]/ ? 'Heading-use-main-or-added-entry'
|
|
: $biblio_tag =~ /^6/ ? 'Heading-use-subject-added-entry'
|
|
: $biblio_tag =~ /^[48]/ ? 'Heading-use-series-added-entry'
|
|
: undef;
|
|
if ($heading_use_search_field) {
|
|
push @marclist, $heading_use_search_field;
|
|
push @and_or, 'and';
|
|
push @excluding, '';
|
|
push @operator, 'is';
|
|
push @value, 'a';
|
|
}
|
|
}
|
|
}
|
|
|
|
require Koha::SearchEngine::QueryBuilder;
|
|
require Koha::SearchEngine::Search;
|
|
|
|
# Use state variables to avoid recreating the objects every time.
|
|
# With Elasticsearch this also avoids creating a massive amount of
|
|
# ES connectors that would eventually run out of file descriptors.
|
|
state $builder = Koha::SearchEngine::QueryBuilder->new( { index => $Koha::SearchEngine::AUTHORITIES_INDEX } );
|
|
state $searcher = Koha::SearchEngine::Search->new( { index => $Koha::SearchEngine::AUTHORITIES_INDEX } );
|
|
|
|
my $search_query = $builder->build_authorities_query_compat(
|
|
\@marclist, \@and_or, \@excluding, \@operator,
|
|
\@value, $self->{'auth_type'},
|
|
'AuthidAsc'
|
|
);
|
|
|
|
my ( $matched_auths, $total ) = $searcher->search_auth_compat( $search_query, 0, 20, $skipmetadata );
|
|
|
|
# Some auth records may not contain the 040$f to specify their source
|
|
# This is legal, so we do a fallback search
|
|
if (
|
|
$check_thesaurus
|
|
&& !$total
|
|
&& $thesaurus
|
|
&& none { $_ eq $thesaurus } (
|
|
'lcsh', 'lcac', 'mesh', 'nal',
|
|
'notspecified', 'cash', 'rvm', 'sears',
|
|
'aat'
|
|
)
|
|
)
|
|
{
|
|
my $thesaurus_idx = first { $marclist[$_] eq 'thesaurus' } 0 .. $#marclist;
|
|
$value[$thesaurus_idx] = 'notdefined';
|
|
$search_query = $builder->build_authorities_query_compat(
|
|
\@marclist, \@and_or,
|
|
\@excluding, \@operator, \@value, $self->{'auth_type'},
|
|
'AuthidAsc'
|
|
);
|
|
( $matched_auths, $total ) = $searcher->search_auth_compat( $search_query, 0, 20, $skipmetadata );
|
|
}
|
|
return ( $matched_auths, $total );
|
|
|
|
}
|
|
|
|
=head2 _filter_diacritics
|
|
|
|
=cut
|
|
|
|
sub _filter_diacritics {
|
|
my $self = shift;
|
|
my $results = shift;
|
|
my $exact_matched_auths = [];
|
|
for my $matched_auth (@$results) {
|
|
my $auth = Koha::Authorities->find( $matched_auth->{authid} );
|
|
next unless $auth;
|
|
my $authrec = $auth->record;
|
|
my $auth_tag_to_report = Koha::Authority::Types->find( $self->{auth_type} )->auth_tag_to_report;
|
|
my $auth_heading_field = $authrec->field($auth_tag_to_report);
|
|
$auth_heading_field->set_tag( $self->field->tag );
|
|
my $auth_heading = C4::Heading->new_from_field($auth_heading_field);
|
|
if ( $auth_heading->search_form eq $self->search_form ) {
|
|
push @$exact_matched_auths, $matched_auth;
|
|
}
|
|
}
|
|
return $exact_matched_auths;
|
|
}
|
|
|
|
=head1 INTERNAL FUNCTIONS
|
|
|
|
=head2 _marc_format_handler
|
|
|
|
Returns a C4::Heading::MARC21 or C4::Heading::UNIMARC object
|
|
depending on the selected MARC flavour.
|
|
|
|
=cut
|
|
|
|
sub _marc_format_handler {
|
|
my $marcflavour = uc shift;
|
|
my $pname = "C4::Heading::$marcflavour";
|
|
load $pname;
|
|
return $pname->new();
|
|
}
|
|
|
|
=head1 AUTHOR
|
|
|
|
Koha Development Team <https://koha-community.org/>
|
|
|
|
Galen Charlton <galen.charlton@liblime.com>
|
|
|
|
=cut
|
|
|
|
1;
|