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     # NOTE: GuessAuthTypeCode has no business in Koha::MetadataRecord::Authority, which is an
  97     #       object-oriented class. Eventually perhaps there will be utility
  98     #       classes in the Koha:: namespace, but there are not at the moment,
  99     #       so this shim seems like the best option all-around.
 100     require C4::AuthoritiesMarc;
 101     $authtypecode ||= C4::AuthoritiesMarc::GuessAuthTypeCode($record);
 102
 103     my $self = $class->SUPER::new( { authid => $authid,
 104                                      authtypecode => $authtypecode,
 105                                      schema => $marcflavour,
 106                                      record => $record });
 107
 108     bless $self, $class;
 109     return $self;
 110 }
 111
 112 =head2 get_from_breeding
 113
 114     my $auth = Koha::MetadataRecord::Authority->get_from_authid($authid);
 115
 116 Create the Koha::MetadataRecord::Authority object associated with the provided authid.
 117
 118 =cut
 119
 120 sub get_from_breeding {
 121     my $class = shift;
 122     my $import_record_id = shift;
 123     my $marcflavour = lc C4::Context->preference("marcflavour");
 124
 125     my $dbh=C4::Context->dbh;
 126     my $sth=$dbh->prepare("select marcxml from import_records where import_record_id=? and record_type='auth';");
 127     $sth->execute($import_record_id);
 128     my $marcxml = $sth->fetchrow;
 129     my $record=eval {MARC::Record->new_from_xml(StripNonXmlChars($marcxml),'UTF-8',
 130         (C4::Context->preference("marcflavour") eq "UNIMARC"?"UNIMARCAUTH":C4::Context->preference("marcflavour")))};
 131     return if ($@);
 132     $record->encoding('UTF-8');
 133
 134     # NOTE: GuessAuthTypeCode has no business in Koha::MetadataRecord::Authority, which is an
 135     #       object-oriented class. Eventually perhaps there will be utility
 136     #       classes in the Koha:: namespace, but there are not at the moment,
 137     #       so this shim seems like the best option all-around.
 138     require C4::AuthoritiesMarc;
 139     my $authtypecode = C4::AuthoritiesMarc::GuessAuthTypeCode($record);
 140
 141     my $self = $class->SUPER::new( {
 142                                      schema => $marcflavour,
 143                                      authtypecode => $authtypecode,
 144                                      record => $record });
 145
 146     bless $self, $class;
 147     return $self;
 148 }
 149
 150 sub authorized_heading {
 151     my ($self) = @_;
 152     if ($self->schema =~ m/marc/) {
 153         return Koha::Util::MARC::getAuthorityAuthorizedHeading($self->record, $self->schema);
 154     }
 155     return;
 156 }
 157
 158 =head2 get_all_authorities_iterator
 159
 160     my $it = Koha::MetadataRecord::Authority->get_all_authorities_iterator();
 161
 162 This will provide an iterator object that will, one by one, provide the
 163 Koha::MetadataRecord::Authority of each authority.
 164
 165 The iterator is a Koha::MetadataIterator object.
 166
 167 =cut
 168
 169 sub get_all_authorities_iterator {
 170     my $database = Koha::Database->new();
 171     my $schema   = $database->schema();
 172     my $rs =
 173       $schema->resultset('AuthHeader')->search( { marcxml => { '!=', undef } },
 174         { columns => [qw/ authid authtypecode marcxml /] } );
 175     my $next_func = sub {
 176         my $row = $rs->next();
 177         return if !$row;
 178         my $authid       = $row->authid;
 179         my $authtypecode = $row->authtypecode;
 180         my $marcxml      = $row->marcxml;
 181
 182         my $record = eval {
 183             MARC::Record->new_from_xml(
 184                 StripNonXmlChars($marcxml),
 185                 'UTF-8',
 186                 (
 187                     C4::Context->preference("marcflavour") eq "UNIMARC"
 188                     ? "UNIMARCAUTH"
 189                     : C4::Context->preference("marcflavour")
 190                 )
 191             );
 192         };
 193         confess $@ if ($@);
 194         $record->encoding('UTF-8');
 195
 196         # I'm not sure why we don't use the authtypecode from the database,
 197         # but this is how the original code does it.
 198         require C4::AuthoritiesMarc;
 199         $authtypecode = C4::AuthoritiesMarc::GuessAuthTypeCode($record);
 200
 201         my $auth = __PACKAGE__->new( $record, { authid => $authid, id => $authid, authtypecode => $authtypecode } );
 202
 203         return $auth;
 204       };
 205       return Koha::MetadataIterator->new($next_func);
 206 }
 207
 208 1;