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 = shift;
  56     my $record = shift;
  57
  58     my $self = $class->SUPER::new(
  59         {
  60             'record' => $record,
  61             'schema' => lc C4::Context->preference("marcflavour")
  62         }
  63     );
  64
  65     bless $self, $class;
  66     return $self;
  67 }
  68
  69
  70 =head2 get_from_authid
  71
  72     my $auth = Koha::MetadataRecord::Authority->get_from_authid($authid);
  73
  74 Create the Koha::MetadataRecord::Authority object associated with the provided authid.
  75 Note that this routine currently retrieves a MARC record because
  76 authorities in Koha are MARC records by definition. This is an
  77 unfortunate but unavoidable fact.
  78
  79 =cut
  80
  81 sub get_from_authid {
  82     my $class = shift;
  83     my $authid = shift;
  84     my $marcflavour = lc C4::Context->preference("marcflavour");
  85
  86     my $dbh=C4::Context->dbh;
  87     my $sth=$dbh->prepare("select authtypecode, marcxml from auth_header where authid=?");
  88     $sth->execute($authid);
  89     my ($authtypecode, $marcxml) = $sth->fetchrow;
  90     my $record=eval {MARC::Record->new_from_xml(StripNonXmlChars($marcxml),'UTF-8',
  91         (C4::Context->preference("marcflavour") eq "UNIMARC"?"UNIMARCAUTH":C4::Context->preference("marcflavour")))};
  92     return if ($@);
  93     $record->encoding('UTF-8');
  94
  95     # NOTE: GuessAuthTypeCode has no business in Koha::MetadataRecord::Authority, which is an
  96     #       object-oriented class. Eventually perhaps there will be utility
  97     #       classes in the Koha:: namespace, but there are not at the moment,
  98     #       so this shim seems like the best option all-around.
  99     require C4::AuthoritiesMarc;
 100     $authtypecode ||= C4::AuthoritiesMarc::GuessAuthTypeCode($record);
 101
 102     my $self = $class->SUPER::new( { authid => $authid,
 103                                      authtypecode => $authtypecode,
 104                                      schema => $marcflavour,
 105                                      record => $record });
 106
 107     bless $self, $class;
 108     return $self;
 109 }
 110
 111 =head2 get_from_breeding
 112
 113     my $auth = Koha::MetadataRecord::Authority->get_from_authid($authid);
 114
 115 Create the Koha::MetadataRecord::Authority object associated with the provided authid.
 116
 117 =cut
 118
 119 sub get_from_breeding {
 120     my $class = shift;
 121     my $import_record_id = shift;
 122     my $marcflavour = lc C4::Context->preference("marcflavour");
 123
 124     my $dbh=C4::Context->dbh;
 125     my $sth=$dbh->prepare("select marcxml from import_records where import_record_id=? and record_type='auth';");
 126     $sth->execute($import_record_id);
 127     my $marcxml = $sth->fetchrow;
 128     my $record=eval {MARC::Record->new_from_xml(StripNonXmlChars($marcxml),'UTF-8',
 129         (C4::Context->preference("marcflavour") eq "UNIMARC"?"UNIMARCAUTH":C4::Context->preference("marcflavour")))};
 130     return if ($@);
 131     $record->encoding('UTF-8');
 132
 133     # NOTE: GuessAuthTypeCode has no business in Koha::MetadataRecord::Authority, which is an
 134     #       object-oriented class. Eventually perhaps there will be utility
 135     #       classes in the Koha:: namespace, but there are not at the moment,
 136     #       so this shim seems like the best option all-around.
 137     require C4::AuthoritiesMarc;
 138     my $authtypecode = C4::AuthoritiesMarc::GuessAuthTypeCode($record);
 139
 140     my $self = $class->SUPER::new( {
 141                                      schema => $marcflavour,
 142                                      authtypecode => $authtypecode,
 143                                      record => $record });
 144
 145     bless $self, $class;
 146     return $self;
 147 }
 148
 149 sub authorized_heading {
 150     my ($self) = @_;
 151     if ($self->schema =~ m/marc/) {
 152         return Koha::Util::MARC::getAuthorityAuthorizedHeading($self->record, $self->schema);
 153     }
 154     return;
 155 }
 156
 157 1;