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::Record;
  23 use MARC::Field;
  24 use C4::Context;
  25 use Module::Load;
  26 use Carp;
  27
  28
  29 =head1 NAME
  30
  31 C4::Heading
  32
  33 =head1 SYNOPSIS
  34
  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();
  41
  42 =head1 DESCRIPTION
  43
  44 C<C4::Heading> implements a simple class to representing
  45 headings found in bibliographic and authority records.
  46
  47 =head1 METHODS
  48
  49 =head2 new_from_field
  50
  51   my $heading = C4::Heading->new_from_field($field, $frameworkcode, [, $auth]);
  52
  53 Given a C<MARC::Field> object containing a heading from a
  54 bib record, create a C<C4::Heading> object.
  55
  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
  57
  58 If the MARC field supplied is not a valid heading, undef
  59 is returned.
  60
  61 =cut
  62
  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);
  70
  71     my $tag = $field->tag();
  72     return unless $marc_handler->valid_heading_tag( $tag, $frameworkcode, $auth );
  73     my $self = {};
  74
  75     $self->{'field'} = $field;
  76     (
  77         $self->{'auth_type'},   $self->{'thesaurus'},
  78         $self->{'search_form'}, $self->{'display_form'},
  79         $self->{'match_type'}
  80     ) = $marc_handler->parse_heading($field, $auth );
  81
  82     bless $self, $class;
  83     return $self;
  84 }
  85
  86 =head2 auth_type
  87
  88   my $auth_type = $heading->auth_type();
  89
  90 Return the auth_type of the heading.
  91
  92 =cut
  93
  94 sub auth_type {
  95     my $self = shift;
  96     return $self->{'auth_type'};
  97 }
  98
  99 =head2 field
 100
 101   my $field = $heading->field();
 102
 103 Return the MARC::Field the heading is based on.
 104
 105 =cut
 106
 107 sub field {
 108     my $self = shift;
 109     return $self->{'field'};
 110 }
 111
 112 =head2 display_form
 113
 114   my $display = $heading->display_form();
 115
 116 Return the "canonical" display form of the heading.
 117
 118 =cut
 119
 120 sub display_form {
 121     my $self = shift;
 122     return $self->{'display_form'};
 123 }
 124
 125 =head2 search_form
 126
 127   my $search_form = $heading->search_form();
 128
 129 Return the "canonical" search form of the heading.
 130
 131 =cut
 132
 133 sub search_form {
 134     my $self = shift;
 135     return $self->{'search_form'};
 136 }
 137
 138 =head2 authorities
 139
 140   my $authorities = $heading->authorities([$skipmetadata]);
 141
 142 Return a list of authority records for this
 143 heading. If passed a true value for $skipmetadata,
 144 SearchAuthorities will return only authids.
 145
 146 =cut
 147
 148 sub authorities {
 149     my $self         = shift;
 150     my $skipmetadata = shift;
 151     my ( $results, $total ) = _search( $self, 'match-heading', $skipmetadata );
 152     return $results;
 153 }
 154
 155 =head2 preferred_authorities
 156
 157   my $preferred_authorities = $heading->preferred_authorities;
 158
 159 Return a list of authority records for headings
 160 that are a preferred form of the heading.
 161
 162 =cut
 163
 164 sub preferred_authorities {
 165     my $self = shift;
 166     my $skipmetadata = shift || undef;
 167     my ( $results, $total ) = _search( 'see-from', $skipmetadata );
 168     return $results;
 169 }
 170
 171 =head2 valid_heading_subfield
 172
 173     if (C4::Heading::valid_heading_subfield('100', 'e', '')) ...
 174
 175 =cut
 176
 177 sub valid_heading_subfield {
 178     my $tag           = shift;
 179     my $subfield      = shift;
 180     my $marcflavour   = C4::Context->preference('marcflavour');
 181     my $auth          = shift;
 182
 183     my $marc_handler = _marc_format_handler($marcflavour);
 184     return $marc_handler->valid_heading_subfield( $tag, $subfield, $auth );
 185 }
 186
 187 =head1 INTERNAL METHODS
 188
 189 =head2 _search
 190
 191 =cut
 192
 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;
 202
 203     if ($index) {
 204         push @marclist, $index;
 205         push @and_or,   'and';
 206         push @operator, $self->{'match_type'};
 207         push @value,    $self->{'search_form'};
 208     }
 209
 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'};
 216     #    }
 217
 218     require Koha::SearchEngine::QueryBuilder;
 219     require Koha::SearchEngine::Search;
 220
 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} );
 228
 229     my $search_query = $builder->build_authorities_query_compat(
 230         \@marclist, \@and_or, \@excluding, \@operator,
 231         \@value,    $self->{'auth_type'},
 232         'AuthidAsc'
 233     );
 234     return $searcher->search_auth_compat( $search_query, 0, 20, $skipmetadata );
 235 }
 236
 237 =head1 INTERNAL FUNCTIONS
 238
 239 =head2 _marc_format_handler
 240
 241 Returns a C4::Heading::MARC21 or C4::Heading::UNIMARC object
 242 depending on the selected MARC flavour.
 243
 244 =cut
 245
 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();
 252 }
 253
 254 =head1 AUTHOR
 255
 256 Koha Development Team <http://koha-community.org/>
 257
 258 Galen Charlton <galen.charlton@liblime.com>
 259
 260 =cut
 261
 262 1;