Bug 20920: Add missing dependency on CGI::Compile
[koha.git] / Koha / MetadataRecord / Authority.pm
blobf9eedf8dcce00249cc6276b68d8d6285abbbfc2b
1 package Koha::MetadataRecord::Authority;
3 # Copyright 2012 C & P Bibliography Services
5 # This file is part of Koha.
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.
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.
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.
20 =head1 NAME
22 Koha::MetadataRecord::Authority - class to encapsulate authority records in Koha
24 =head1 SYNOPSIS
26 Object-oriented class that encapsulates authority records in Koha.
28 =head1 DESCRIPTION
30 Authority data.
32 =cut
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;
42 use base qw(Koha::MetadataRecord);
44 __PACKAGE__->mk_accessors(qw( authid authtypecode ));
46 =head2 new
48 my $auth = Koha::MetadataRecord::Authority->new($record);
50 Create a new Koha::MetadataRecord::Authority object based on the provided record.
52 =cut
54 sub new {
55 my ( $class, $record, $params ) = @_;
57 $params //= {};
58 my $self = $class->SUPER::new(
60 'record' => $record,
61 'schema' => lc C4::Context->preference("marcflavour"),
62 %$params,
66 bless $self, $class;
67 return $self;
71 =head2 get_from_authid
73 my $auth = Koha::MetadataRecord::Authority->get_from_authid($authid);
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.
80 =cut
82 sub get_from_authid {
83 my $class = shift;
84 my $authid = shift;
85 my $marcflavour = lc C4::Context->preference("marcflavour");
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');
96 my $self = $class->SUPER::new( { authid => $authid,
97 authtypecode => $authtypecode,
98 schema => $marcflavour,
99 record => $record });
101 bless $self, $class;
102 return $self;
105 =head2 get_from_breeding
107 my $auth = Koha::MetadataRecord::Authority->get_from_authid($authid);
109 Create the Koha::MetadataRecord::Authority object associated with the provided authid.
111 =cut
113 sub get_from_breeding {
114 my $class = shift;
115 my $import_record_id = shift;
116 my $marcflavour = lc C4::Context->preference("marcflavour");
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');
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);
134 my $self = $class->SUPER::new( {
135 schema => $marcflavour,
136 authtypecode => $authtypecode,
137 record => $record });
139 bless $self, $class;
140 return $self;
143 sub authorized_heading {
144 my ($self) = @_;
145 if ($self->schema =~ m/marc/) {
146 return Koha::Util::MARC::getAuthorityAuthorizedHeading($self->record, $self->schema);
148 return;
151 =head2 get_all_authorities_iterator
153 my $it = Koha::MetadataRecord::Authority->get_all_authorities_iterator();
155 This will provide an iterator object that will, one by one, provide the
156 Koha::MetadataRecord::Authority of each authority.
158 The iterator is a Koha::MetadataIterator object.
160 =cut
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;
175 my $record = eval {
176 MARC::Record->new_from_xml(
177 StripNonXmlChars($marcxml),
178 'UTF-8',
180 C4::Context->preference("marcflavour") eq "UNIMARC"
181 ? "UNIMARCAUTH"
182 : C4::Context->preference("marcflavour")
186 confess $@ if ($@);
187 $record->encoding('UTF-8');
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);
194 my $auth = __PACKAGE__->new( $record, { authid => $authid, id => $authid, authtypecode => $authtypecode } );
196 return $auth;
198 return Koha::MetadataIterator->new($next_func);