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 under the
   8 # terms of the GNU General Public License as published by the Free Software
   9 # Foundation; either version 2 of the License, or (at your option) any later
  10 # version.
  11 #
  12 # Koha is distributed in the hope that it will be useful, but WITHOUT ANY
  13 # WARRANTY; without even the implied warranty of MERCHANTABILITY or FITNESS FOR
  14 # A PARTICULAR PURPOSE.  See the GNU General Public License for more details.
  15 #
  16 # You should have received a copy of the GNU General Public License along
  17 # with Koha; if not, write to the Free Software Foundation, Inc.,
  18 # 51 Franklin Street, Fifth Floor, Boston, MA 02110-1301 USA.
  19
  20 use strict;
  21 use warnings;
  22 use MARC::Record;
  23 use MARC::Field;
  24 use C4::Context;
  25 use Module::Load;
  26 use Carp;
  27
  28 our $VERSION = 3.07.00.049;
  29
  30 =head1 NAME
  31
  32 C4::Heading
  33
  34 =head1 SYNOPSIS
  35
  36  use C4::Heading;
  37  my $heading = C4::Heading->new_from_bib_field($field, $frameworkcode);
  38  my $thesaurus = $heading->thesaurus();
  39  my $type = $heading->type();
  40  my $display_heading = $heading->display_form();
  41  my $search_form = $heading->search_form();
  42
  43 =head1 DESCRIPTION
  44
  45 C<C4::Heading> implements a simple class to representing
  46 headings found in bibliographic and authority records.
  47
  48 =head1 METHODS
  49
  50 =head2 new_from_bib_field
  51
  52   my $heading = C4::Heading->new_from_bib_field($field, $frameworkcode, [, $marc_flavour]);
  53
  54 Given a C<MARC::Field> object containing a heading from a
  55 bib record, create a C<C4::Heading> object.
  56
  57 The optional second parameter is the MARC flavour (i.e., MARC21
  58 or UNIMARC); if this parameter is not supplied, it is
  59 taken from the Koha application context.
  60
  61 If the MARC field supplied is not a valid heading, undef
  62 is returned.
  63
  64 =cut
  65
  66 sub new_from_bib_field {
  67     my $class         = shift;
  68     my $field         = shift;
  69     my $frameworkcode = shift;
  70     my $marcflavour   = @_ ? shift : C4::Context->preference('marcflavour');
  71
  72     my $marc_handler = _marc_format_handler($marcflavour);
  73
  74     my $tag = $field->tag();
  75     return unless $marc_handler->valid_bib_heading_tag( $tag, $frameworkcode );
  76     my $self = {};
  77
  78     $self->{'field'} = $field;
  79     (
  80         $self->{'auth_type'},   $self->{'thesaurus'},
  81         $self->{'search_form'}, $self->{'display_form'},
  82         $self->{'match_type'}
  83     ) = $marc_handler->parse_heading($field);
  84
  85     bless $self, $class;
  86     return $self;
  87 }
  88
  89 =head2 auth_type
  90
  91   my $auth_type = $heading->auth_type();
  92
  93 Return the auth_type of the heading.
  94
  95 =cut
  96
  97 sub auth_type {
  98     my $self = shift;
  99     return $self->{'auth_type'};
 100 }
 101
 102 =head2 field
 103
 104   my $field = $heading->field();
 105
 106 Return the MARC::Field the heading is based on.
 107
 108 =cut
 109
 110 sub field {
 111     my $self = shift;
 112     return $self->{'field'};
 113 }
 114
 115 =head2 display_form
 116
 117   my $display = $heading->display_form();
 118
 119 Return the "canonical" display form of the heading.
 120
 121 =cut
 122
 123 sub display_form {
 124     my $self = shift;
 125     return $self->{'display_form'};
 126 }
 127
 128 =head2 search_form
 129
 130   my $search_form = $heading->search_form();
 131
 132 Return the "canonical" search form of the heading.
 133
 134 =cut
 135
 136 sub search_form {
 137     my $self = shift;
 138     return $self->{'search_form'};
 139 }
 140
 141 =head2 authorities
 142
 143   my $authorities = $heading->authorities([$skipmetadata]);
 144
 145 Return a list of authority records for this
 146 heading. If passed a true value for $skipmetadata,
 147 SearchAuthorities will return only authids.
 148
 149 =cut
 150
 151 sub authorities {
 152     my $self         = shift;
 153     my $skipmetadata = shift;
 154     my ( $results, $total ) = _search( $self, 'match-heading', $skipmetadata );
 155     return $results;
 156 }
 157
 158 =head2 preferred_authorities
 159
 160   my $preferred_authorities = $heading->preferred_authorities;
 161
 162 Return a list of authority records for headings
 163 that are a preferred form of the heading.
 164
 165 =cut
 166
 167 sub preferred_authorities {
 168     my $self = shift;
 169     my $skipmetadata = shift || undef;
 170     my ( $results, $total ) = _search( 'see-from', $skipmetadata );
 171     return $results;
 172 }
 173
 174 =head1 INTERNAL METHODS
 175
 176 =head2 _search
 177
 178 =cut
 179
 180 sub _search {
 181     my $self         = shift;
 182     my $index        = shift || undef;
 183     my $skipmetadata = shift || undef;
 184     my @marclist;
 185     my @and_or;
 186     my @excluding = [];
 187     my @operator;
 188     my @value;
 189
 190     if ($index) {
 191         push @marclist, $index;
 192         push @and_or,   'and';
 193         push @operator, $self->{'match_type'};
 194         push @value,    $self->{'search_form'};
 195     }
 196
 197     #    if ($self->{'thesaurus'}) {
 198     #        push @marclist, 'thesaurus';
 199     #        push @and_or, 'and';
 200     #        push @excluding, '';
 201     #        push @operator, 'is';
 202     #        push @value, $self->{'thesaurus'};
 203     #    }
 204     require C4::AuthoritiesMarc;
 205     return C4::AuthoritiesMarc::SearchAuthorities(
 206         \@marclist, \@and_or, \@excluding, \@operator,
 207         \@value,    0,        20,          $self->{'auth_type'},
 208         'AuthidAsc',         $skipmetadata
 209     );
 210 }
 211
 212 =head1 INTERNAL FUNCTIONS
 213
 214 =head2 _marc_format_handler
 215
 216 Returns a C4::Heading::MARC21 or C4::Heading::UNIMARC object
 217 depending on the selected MARC flavour.
 218
 219 =cut
 220
 221 sub _marc_format_handler {
 222     my $marcflavour = uc shift;
 223     $marcflavour = 'MARC21' if ( $marcflavour eq 'NORMARC' );
 224     my $pname = "C4::Heading::$marcflavour";
 225     load $pname;
 226     return $pname->new();
 227 }
 228
 229 =head1 AUTHOR
 230
 231 Koha Development Team <http://koha-community.org/>
 232
 233 Galen Charlton <galen.charlton@liblime.com>
 234
 235 =cut
 236
 237 1;