Koha/Authority.pm

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