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 C4::Context;
  37 use MARC::Record;
  38 use MARC::File::XML;
  39 use C4::Charset;
  40 use Koha::Util::MARC;
  41
  42 use base qw(Koha::MetadataRecord);
  43
  44 __PACKAGE__->mk_accessors(qw( authid authtypecode ));
  45
  46 =head2 new
  47
  48     my $auth = Koha::MetadataRecord::Authority->new($record);
  49
  50 Create a new Koha::MetadataRecord::Authority object based on the provided record.
  51
  52 =cut
  53
  54 sub new {
  55     my ( $class, $record, $params ) = @_;
  56
  57     $params //= {};
  58     my $self = $class->SUPER::new(
  59         {
  60             'record' => $record,
  61             'schema' => lc C4::Context->preference("marcflavour"),
  62             %$params,
  63         }
  64     );
  65
  66     bless $self, $class;
  67     return $self;
  68 }
  69
  70
  71 =head2 get_from_authid
  72
  73     my $auth = Koha::MetadataRecord::Authority->get_from_authid($authid);
  74
  75 Create the Koha::MetadataRecord::Authority object associated with the provided authid.
  76 Note that this routine currently retrieves a MARC record because
  77 authorities in Koha are MARC records by definition. This is an
  78 unfortunate but unavoidable fact.
  79
  80 =cut
  81
  82 sub get_from_authid {
  83     my $class = shift;
  84     my $authid = shift;
  85     my $marcflavour = lc C4::Context->preference("marcflavour");
  86
  87     my $dbh=C4::Context->dbh;
  88     my $sth=$dbh->prepare("select authtypecode, marcxml from auth_header where authid=?");
  89     $sth->execute($authid);
  90     my ($authtypecode, $marcxml) = $sth->fetchrow;
  91     my $record=eval {MARC::Record->new_from_xml(StripNonXmlChars($marcxml),'UTF-8',
  92         (C4::Context->preference("marcflavour") eq "UNIMARC"?"UNIMARCAUTH":C4::Context->preference("marcflavour")))};
  93     return if ($@);
  94     $record->encoding('UTF-8');
  95
  96     my $self = $class->SUPER::new( { authid => $authid,
  97                                      authtypecode => $authtypecode,
  98                                      schema => $marcflavour,
  99                                      record => $record });
 100
 101     bless $self, $class;
 102     return $self;
 103 }
 104
 105 =head2 get_from_breeding
 106
 107     my $auth = Koha::MetadataRecord::Authority->get_from_authid($authid);
 108
 109 Create the Koha::MetadataRecord::Authority object associated with the provided authid.
 110
 111 =cut
 112
 113 sub get_from_breeding {
 114     my $class = shift;
 115     my $import_record_id = shift;
 116     my $marcflavour = lc C4::Context->preference("marcflavour");
 117
 118     my $dbh=C4::Context->dbh;
 119     my $sth=$dbh->prepare("select marcxml from import_records where import_record_id=? and record_type='auth';");
 120     $sth->execute($import_record_id);
 121     my $marcxml = $sth->fetchrow;
 122     my $record=eval {MARC::Record->new_from_xml(StripNonXmlChars($marcxml),'UTF-8',
 123         (C4::Context->preference("marcflavour") eq "UNIMARC"?"UNIMARCAUTH":C4::Context->preference("marcflavour")))};
 124     return if ($@);
 125     $record->encoding('UTF-8');
 126
 127     # NOTE: GuessAuthTypeCode has no business in Koha::MetadataRecord::Authority, which is an
 128     #       object-oriented class. Eventually perhaps there will be utility
 129     #       classes in the Koha:: namespace, but there are not at the moment,
 130     #       so this shim seems like the best option all-around.
 131     require C4::AuthoritiesMarc;
 132     my $authtypecode = C4::AuthoritiesMarc::GuessAuthTypeCode($record);
 133
 134     my $self = $class->SUPER::new( {
 135                                      schema => $marcflavour,
 136                                      authtypecode => $authtypecode,
 137                                      record => $record });
 138
 139     bless $self, $class;
 140     return $self;
 141 }
 142
 143 sub authorized_heading {
 144     my ($self) = @_;
 145     if ($self->schema =~ m/marc/) {
 146         return Koha::Util::MARC::getAuthorityAuthorizedHeading($self->record, $self->schema);
 147     }
 148     return;
 149 }
 150
 151 =head2 get_all_authorities_iterator
 152
 153     my $it = Koha::MetadataRecord::Authority->get_all_authorities_iterator();
 154
 155 This will provide an iterator object that will, one by one, provide the
 156 Koha::MetadataRecord::Authority of each authority.
 157
 158 The iterator is a Koha::MetadataIterator object.
 159
 160 =cut
 161
 162 sub get_all_authorities_iterator {
 163     my $database = Koha::Database->new();
 164     my $schema   = $database->schema();
 165     my $rs =
 166       $schema->resultset('AuthHeader')->search( { marcxml => { '!=', undef } },
 167         { columns => [qw/ authid authtypecode marcxml /] } );
 168     my $next_func = sub {
 169         my $row = $rs->next();
 170         return if !$row;
 171         my $authid       = $row->authid;
 172         my $authtypecode = $row->authtypecode;
 173         my $marcxml      = $row->marcxml;
 174
 175         my $record = eval {
 176             MARC::Record->new_from_xml(
 177                 StripNonXmlChars($marcxml),
 178                 'UTF-8',
 179                 (
 180                     C4::Context->preference("marcflavour") eq "UNIMARC"
 181                     ? "UNIMARCAUTH"
 182                     : C4::Context->preference("marcflavour")
 183                 )
 184             );
 185         };
 186         confess $@ if ($@);
 187         $record->encoding('UTF-8');
 188
 189         # I'm not sure why we don't use the authtypecode from the database,
 190         # but this is how the original code does it.
 191         require C4::AuthoritiesMarc;
 192         $authtypecode = C4::AuthoritiesMarc::GuessAuthTypeCode($record);
 193
 194         my $auth = __PACKAGE__->new( $record, { authid => $authid, id => $authid, authtypecode => $authtypecode } );
 195
 196         return $auth;
 197       };
 198       return Koha::MetadataIterator->new($next_func);
 199 }
 200
 201 1;