Koha/MetadataRecord/Authority.pm

   1 package Koha::MetadataRecord::Authority;
   2
   3 # Copyright 2012 C & P Bibliography Services
   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 3 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 =head1 NAME
  21
  22 Koha::MetadataRecord::Authority - class to encapsulate authority records in Koha
  23
  24 =head1 SYNOPSIS
  25
  26 Object-oriented class that encapsulates authority records in Koha.
  27
  28 =head1 DESCRIPTION
  29
  30 Authority data.
  31
  32 =cut
  33
  34 use strict;
  35 use warnings;
  36 use Carp;
  37 use C4::Context;
  38 use MARC::Record;
  39 use MARC::File::XML;
  40 use C4::Charset;
  41 use Koha::Util::MARC;
  42
  43 use base qw(Koha::MetadataRecord);
  44
  45 __PACKAGE__->mk_accessors(qw( authid authtypecode ));
  46
  47 =head2 new
  48
  49     my $auth = Koha::MetadataRecord::Authority->new($record);
  50
  51 Create a new Koha::MetadataRecord::Authority object based on the provided record.
  52
  53 =cut
  54
  55 sub new {
  56     my ( $class, $record, $params ) = @_;
  57
  58     $params //= {};
  59     my $self = $class->SUPER::new(
  60         {
  61             'record' => $record,
  62             'schema' => lc C4::Context->preference("marcflavour"),
  63             %$params,
  64         }
  65     );
  66
  67     bless $self, $class;
  68     return $self;
  69 }
  70
  71
  72 =head2 get_from_authid
  73
  74     my $auth = Koha::MetadataRecord::Authority->get_from_authid($authid);
  75
  76 Create the Koha::MetadataRecord::Authority object associated with the provided authid.
  77 Note that this routine currently retrieves a MARC record because
  78 authorities in Koha are MARC records by definition. This is an
  79 unfortunate but unavoidable fact.
  80
  81 =cut
  82
  83 sub get_from_authid {
  84     my $class = shift;
  85     my $authid = shift;
  86     my $marcflavour = lc C4::Context->preference("marcflavour");
  87
  88     my $dbh=C4::Context->dbh;
  89     my $sth=$dbh->prepare("select authtypecode, marcxml from auth_header where authid=?");
  90     $sth->execute($authid);
  91     my ($authtypecode, $marcxml) = $sth->fetchrow;
  92     my $record=eval {MARC::Record->new_from_xml(StripNonXmlChars($marcxml),'UTF-8',
  93         (C4::Context->preference("marcflavour") eq "UNIMARC"?"UNIMARCAUTH":C4::Context->preference("marcflavour")))};
  94     return if ($@);
  95     $record->encoding('UTF-8');
  96
  97     my $self = $class->SUPER::new( { authid => $authid,
  98                                      authtypecode => $authtypecode,
  99                                      schema => $marcflavour,
 100                                      record => $record });
 101
 102     bless $self, $class;
 103     return $self;
 104 }
 105
 106 =head2 get_from_breeding
 107
 108     my $auth = Koha::MetadataRecord::Authority->get_from_authid($authid);
 109
 110 Create the Koha::MetadataRecord::Authority object associated with the provided authid.
 111
 112 =cut
 113
 114 sub get_from_breeding {
 115     my $class = shift;
 116     my $import_record_id = shift;
 117     my $marcflavour = lc C4::Context->preference("marcflavour");
 118
 119     my $dbh=C4::Context->dbh;
 120     my $sth=$dbh->prepare("select marcxml from import_records where import_record_id=? and record_type='auth';");
 121     $sth->execute($import_record_id);
 122     my $marcxml = $sth->fetchrow;
 123     my $record=eval {MARC::Record->new_from_xml(StripNonXmlChars($marcxml),'UTF-8',
 124         (C4::Context->preference("marcflavour") eq "UNIMARC"?"UNIMARCAUTH":C4::Context->preference("marcflavour")))};
 125     return if ($@);
 126     $record->encoding('UTF-8');
 127
 128     # NOTE: GuessAuthTypeCode has no business in Koha::MetadataRecord::Authority, which is an
 129     #       object-oriented class. Eventually perhaps there will be utility
 130     #       classes in the Koha:: namespace, but there are not at the moment,
 131     #       so this shim seems like the best option all-around.
 132     require C4::AuthoritiesMarc;
 133     my $authtypecode = C4::AuthoritiesMarc::GuessAuthTypeCode($record);
 134
 135     my $self = $class->SUPER::new( {
 136                                      schema => $marcflavour,
 137                                      authtypecode => $authtypecode,
 138                                      record => $record });
 139
 140     bless $self, $class;
 141     return $self;
 142 }
 143
 144 sub authorized_heading {
 145     my ($self) = @_;
 146     if ($self->schema =~ m/marc/) {
 147         return Koha::Util::MARC::getAuthorityAuthorizedHeading($self->record, $self->schema);
 148     }
 149     return;
 150 }
 151
 152 =head2 get_all_authorities_iterator
 153
 154     my $it = Koha::MetadataRecord::Authority->get_all_authorities_iterator(%options);
 155
 156 This will provide an iterator object that will, one by one, provide the
 157 Koha::MetadataRecord::Authority of each authority.
 158
 159 The iterator is a Koha::MetadataIterator object.
 160
 161 Possible options are:
 162
 163 =over 4
 164
 165 =item C<slice>
 166
 167 slice may be defined as a hash of two values: index and count. index
 168 is the slice number to process and count is total number of slices.
 169 With this information the iterator returns just the given slice of
 170 records instead of all.
 171
 172 =back
 173
 174 =cut
 175
 176 sub get_all_authorities_iterator {
 177     my ($self, %options) = @_;
 178
 179     my $search_terms = {
 180         marcxml => { '!=', undef }
 181     };
 182     my ($slice_modulo, $slice_count);
 183     if ($options{slice}) {
 184         $slice_count = $options{slice}->{count};
 185         $slice_modulo = $options{slice}->{index};
 186         $search_terms = {
 187             '-and' => [
 188                 %{$search_terms},
 189                 \[ 'mod(authid, ?) = ?', $slice_count, $slice_modulo ]
 190             ]
 191         };
 192     }
 193
 194     my $database = Koha::Database->new();
 195     my $schema   = $database->schema();
 196     my $rs =
 197       $schema->resultset('AuthHeader')->search(
 198         $search_terms,
 199         { columns => [qw/ authid authtypecode marcxml /] } );
 200     my $next_func = sub {
 201         my $row = $rs->next();
 202         return if !$row;
 203         my $authid       = $row->authid;
 204         my $authtypecode = $row->authtypecode;
 205         my $marcxml      = $row->marcxml;
 206
 207         my $record = eval {
 208             MARC::Record->new_from_xml(
 209                 StripNonXmlChars($marcxml),
 210                 'UTF-8',
 211                 (
 212                     C4::Context->preference("marcflavour") eq "UNIMARC"
 213                     ? "UNIMARCAUTH"
 214                     : C4::Context->preference("marcflavour")
 215                 )
 216             );
 217         };
 218         confess "$@" if ($@);
 219         $record->encoding('UTF-8');
 220
 221         # I'm not sure why we don't use the authtypecode from the database,
 222         # but this is how the original code does it.
 223         require C4::AuthoritiesMarc;
 224         $authtypecode = C4::AuthoritiesMarc::GuessAuthTypeCode($record);
 225
 226         my $auth = __PACKAGE__->new( $record, { authid => $authid, id => $authid, authtypecode => $authtypecode } );
 227
 228         return $auth;
 229       };
 230       return Koha::MetadataIterator->new($next_func);
 231 }
 232
 233 1;