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();
 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 =cut
 162
 163 sub get_all_authorities_iterator {
 164     my $database = Koha::Database->new();
 165     my $schema   = $database->schema();
 166     my $rs =
 167       $schema->resultset('AuthHeader')->search( { marcxml => { '!=', undef } },
 168         { columns => [qw/ authid authtypecode marcxml /] } );
 169     my $next_func = sub {
 170         my $row = $rs->next();
 171         return if !$row;
 172         my $authid       = $row->authid;
 173         my $authtypecode = $row->authtypecode;
 174         my $marcxml      = $row->marcxml;
 175
 176         my $record = eval {
 177             MARC::Record->new_from_xml(
 178                 StripNonXmlChars($marcxml),
 179                 'UTF-8',
 180                 (
 181                     C4::Context->preference("marcflavour") eq "UNIMARC"
 182                     ? "UNIMARCAUTH"
 183                     : C4::Context->preference("marcflavour")
 184                 )
 185             );
 186         };
 187         confess "$@" if ($@);
 188         $record->encoding('UTF-8');
 189
 190         # I'm not sure why we don't use the authtypecode from the database,
 191         # but this is how the original code does it.
 192         require C4::AuthoritiesMarc;
 193         $authtypecode = C4::AuthoritiesMarc::GuessAuthTypeCode($record);
 194
 195         my $auth = __PACKAGE__->new( $record, { authid => $authid, id => $authid, authtypecode => $authtypecode } );
 196
 197         return $auth;
 198       };
 199       return Koha::MetadataIterator->new($next_func);
 200 }
 201
 202 1;