C4/Heading.pm

   1 package C4::Heading;
   2
   3 # Copyright (C) 2008 LibLime
   4 #
   5 # This file is part of Koha.
   6 #
   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.
  11 #
  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.
  16 #
  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>.
  19
  20 use Modern::Perl;
  21
  22 use MARC::Field;
  23 use C4::Context;
  24 use Module::Load qw( load );
  25 use List::Util qw( none );
  26
  27 =head1 NAME
  28
  29 C4::Heading
  30
  31 =head1 SYNOPSIS
  32
  33  use C4::Heading;
  34  my $heading = C4::Heading->new_from_field($field, $frameworkcode);
  35  my $thesaurus = $heading->thesaurus();
  36  my $type = $heading->type();
  37  my $display_heading = $heading->display_form();
  38  my $search_form = $heading->search_form();
  39
  40 =head1 DESCRIPTION
  41
  42 C<C4::Heading> implements a simple class to representing
  43 headings found in bibliographic and authority records.
  44
  45 =head1 METHODS
  46
  47 =head2 new_from_field
  48
  49   my $heading = C4::Heading->new_from_field($field, $frameworkcode, [, $auth]);
  50
  51 Given a C<MARC::Field> object containing a heading from a
  52 bib record, create a C<C4::Heading> object.
  53
  54 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
  55
  56 If the MARC field supplied is not a valid heading, undef
  57 is returned.
  58
  59 =cut
  60
  61 sub new_from_field {
  62     my $class         = shift;
  63     my $field         = shift;
  64     my $frameworkcode = shift; #FIXME this is not used?
  65     my $auth          = shift;
  66     my $marcflavour   = C4::Context->preference('marcflavour');
  67     my $marc_handler = _marc_format_handler($marcflavour);
  68
  69     return unless $field;
  70     my $tag = $field->tag();
  71     return unless $marc_handler->valid_heading_tag( $tag, $frameworkcode, $auth );
  72     my $self = {};
  73
  74     $self->{'field'} = $field;
  75     (
  76         $self->{'auth_type'},   $self->{'thesaurus'},
  77         $self->{'search_form'}, $self->{'display_form'},
  78         $self->{'match_type'}
  79     ) = $marc_handler->parse_heading($field, $auth );
  80
  81     bless $self, $class;
  82     return $self;
  83 }
  84
  85 =head2 auth_type
  86
  87   my $auth_type = $heading->auth_type();
  88
  89 Return the auth_type of the heading.
  90
  91 =cut
  92
  93 sub auth_type {
  94     my $self = shift;
  95     return $self->{'auth_type'};
  96 }
  97
  98 =head2 field
  99
 100   my $field = $heading->field();
 101
 102 Return the MARC::Field the heading is based on.
 103
 104 =cut
 105
 106 sub field {
 107     my $self = shift;
 108     return $self->{'field'};
 109 }
 110
 111 =head2 display_form
 112
 113   my $display = $heading->display_form();
 114
 115 Return the "canonical" display form of the heading.
 116
 117 =cut
 118
 119 sub display_form {
 120     my $self = shift;
 121     return $self->{'display_form'};
 122 }
 123
 124 =head2 search_form
 125
 126   my $search_form = $heading->search_form();
 127
 128 Return the "canonical" search form of the heading.
 129
 130 =cut
 131
 132 sub search_form {
 133     my $self = shift;
 134     return $self->{'search_form'};
 135 }
 136
 137 =head2 authorities
 138
 139   my $authorities = $heading->authorities([$skipmetadata]);
 140
 141 Return a list of authority records for this
 142 heading. If passed a true value for $skipmetadata,
 143 SearchAuthorities will return only authids.
 144
 145 =cut
 146
 147 sub authorities {
 148     my $self         = shift;
 149     my $skipmetadata = shift;
 150     my ( $results, $total ) = _search( $self, 'match-heading', $skipmetadata );
 151     return $results;
 152 }
 153
 154 =head2 preferred_authorities
 155
 156   my $preferred_authorities = $heading->preferred_authorities;
 157
 158 Return a list of authority records for headings
 159 that are a preferred form of the heading.
 160
 161 =cut
 162
 163 sub preferred_authorities {
 164     my $self = shift;
 165     my $skipmetadata = shift || undef;
 166     my ( $results, $total ) = _search( 'see-from', $skipmetadata );
 167     return $results;
 168 }
 169
 170 =head2 valid_heading_subfield
 171
 172     if (C4::Heading::valid_heading_subfield('100', 'e', '')) ...
 173
 174 Check if the given subfield is valid for the given field.
 175
 176 =cut
 177
 178 sub valid_heading_subfield {
 179     my $tag           = shift;
 180     my $subfield      = shift;
 181     my $marcflavour   = C4::Context->preference('marcflavour');
 182     my $auth          = shift;
 183
 184     my $marc_handler = _marc_format_handler($marcflavour);
 185     return $marc_handler->valid_heading_subfield( $tag, $subfield, $auth );
 186 }
 187
 188 =head1 INTERNAL METHODS
 189
 190 =head2 _search
 191
 192 =cut
 193
 194 sub _search {
 195     my $self         = shift;
 196     my $index        = shift || undef;
 197     my $skipmetadata = shift || undef;
 198     my $thesaurus = $self->{thesaurus};
 199     my $subject_heading_thesaurus = '';
 200     my @marclist;
 201     my @and_or;
 202     my @excluding = [];
 203     my @operator;
 204     my @value;
 205
 206     my $check_thesaurus = C4::Context->preference('LinkerConsiderThesaurus');
 207
 208     # FIXME: We specify values for @and_or and @excluding
 209     # but these fields are not used anywhere and should be removed
 210     if ($index) {
 211         push @marclist, $index;
 212         push @and_or,   'AND';
 213         push @operator, $self->{'match_type'};
 214         push @value,    $self->{'search_form'};
 215     }
 216
 217     if ( $check_thesaurus && $thesaurus ) {
 218         push @marclist, 'thesaurus';
 219         push @and_or, 'and';
 220         push @excluding, '';
 221         push @operator, 'is';
 222         push @value, $thesaurus;
 223     }
 224
 225     require Koha::SearchEngine::QueryBuilder;
 226     require Koha::SearchEngine::Search;
 227
 228     # Use state variables to avoid recreating the objects every time.
 229     # With Elasticsearch this also avoids creating a massive amount of
 230     # ES connectors that would eventually run out of file descriptors.
 231     state $builder = Koha::SearchEngine::QueryBuilder->new(
 232         { index => $Koha::SearchEngine::AUTHORITIES_INDEX } );
 233     state $searcher = Koha::SearchEngine::Search->new(
 234         {index => $Koha::SearchEngine::AUTHORITIES_INDEX} );
 235
 236     my $search_query = $builder->build_authorities_query_compat(
 237         \@marclist, \@and_or, \@excluding, \@operator,
 238         \@value,    $self->{'auth_type'},
 239         'AuthidAsc'
 240     );
 241
 242     my ( $matched_auths, $total ) = $searcher->search_auth_compat( $search_query, 0, 20, $skipmetadata );
 243     # Some auth records may not contain the 040$f to specify their source
 244     # This is legal, so we do a fallback search
 245     if (
 246            $check_thesaurus
 247         && !$total
 248         && $thesaurus
 249         && none { $_ eq $thesaurus } (
 250             'lcsh',         'lcac', 'mesh', 'nal',
 251             'notspecified', 'cash', 'rvm',  'sears',
 252             'aat'
 253         )
 254       )
 255     {
 256         pop @value;
 257         push @value, 'notdefined';
 258         $search_query =
 259           $builder->build_authorities_query_compat( \@marclist, \@and_or,
 260             \@excluding, \@operator, \@value, $self->{'auth_type'},
 261             'AuthidAsc' );
 262         ( $matched_auths, $total ) =
 263           $searcher->search_auth_compat( $search_query, 0, 20, $skipmetadata );
 264     }
 265     return ( $matched_auths, $total );
 266
 267 }
 268
 269 =head1 INTERNAL FUNCTIONS
 270
 271 =head2 _marc_format_handler
 272
 273 Returns a C4::Heading::MARC21 or C4::Heading::UNIMARC object
 274 depending on the selected MARC flavour.
 275
 276 =cut
 277
 278 sub _marc_format_handler {
 279     my $marcflavour = uc shift;
 280     my $pname = "C4::Heading::$marcflavour";
 281     load $pname;
 282     return $pname->new();
 283 }
 284
 285 =head1 AUTHOR
 286
 287 Koha Development Team <http://koha-community.org/>
 288
 289 Galen Charlton <galen.charlton@liblime.com>
 290
 291 =cut
 292
 293 1;