Koha/ExternalContent/RecordedBooks.pm

   1 # Copyright 2016 Catalyst
   2 #
   3 # This file is part of Koha.
   4 #
   5 # Koha is free software; you can redistribute it and/or modify it under the
   6 # terms of the GNU General Public License as published by the Free Software
   7 # Foundation; either version 3 of the License, or (at your option) any later
   8 # version.
   9 #
  10 # Koha is distributed in the hope that it will be useful, but WITHOUT ANY
  11 # WARRANTY; without even the implied warranty of MERCHANTABILITY or FITNESS FOR
  12 # A PARTICULAR PURPOSE.  See the GNU General Public License for more details.
  13 #
  14 # You should have received a copy of the GNU General Public License along
  15 # with Koha; if not, write to the Free Software Foundation, Inc.,
  16 # 51 Franklin Street, Fifth Floor, Boston, MA 02110-1301 USA.
  17
  18 package Koha::ExternalContent::RecordedBooks;
  19
  20 use Modern::Perl;
  21 use Carp;
  22
  23 use base qw(Koha::ExternalContent);
  24 use WebService::ILS::RecordedBooks::PartnerPatron;
  25 use WebService::ILS::RecordedBooks::Partner;
  26 use C4::Context;
  27 use Koha::Logger;
  28
  29 use constant logger => Koha::Logger->get();
  30
  31 __PACKAGE__->mk_accessors(qw(domain is_identified));
  32
  33 =head1 NAME
  34
  35 Koha::ExternalContent::RecordedBooks
  36
  37 =head1 SYNOPSIS
  38
  39     use Koha::ExternalContent::RecordedBooks;
  40     my $od_client = Koha::ExternalContent::RecordedBooks->new();
  41     my $od_auth_url = $od_client->auth_url();
  42
  43 =head1 DESCRIPTION
  44
  45 A (very) thin wrapper around C<WebService::ILS::RecordedBooks::Patron>
  46
  47 Takes "RecordedBooks*" Koha preferences
  48
  49 =cut
  50
  51 sub new {
  52     my $class  = shift;
  53     my $params = shift || {};
  54
  55     my $self = $class->SUPER::new($params);
  56     unless ($params->{client}) {
  57         my $client_secret  = C4::Context->preference('RecordedBooksClientSecret')
  58           or croak("RecordedBooksClientSecret pref not set");
  59         my $library_id     = C4::Context->preference('RecordedBooksLibraryID')
  60           or croak("RecordedBooksLibraryID pref not set");
  61         my $domain         = C4::Context->preference('RecordedBooksDomain');
  62         my $patron = $params->{koha_session_id} ? $self->koha_patron : undef;
  63         my $email;
  64         if ($patron) {
  65             $email = $patron->email
  66               or $self->logger->warn("User with no email, cannot identify with RecordedBooks");
  67         }
  68         my $client;
  69         if ($email) {
  70             local $@;
  71             $client = eval { WebService::ILS::RecordedBooks::PartnerPatron->new(
  72                 client_secret     => $client_secret,
  73                 library_id        => $library_id,
  74                 domain            => $domain,
  75                 user_id           => $email,
  76                 user_agent_params => { agent => $class->agent_string }
  77             ) };
  78             $self->logger->warn("Invalid RecordedBooks user $email ($@)") if $@;
  79             $self->is_identified($client);
  80         }
  81         $client ||= WebService::ILS::RecordedBooks::Partner->new(
  82                 client_secret     => $client_secret,
  83                 library_id        => $library_id,
  84                 domain            => $domain,
  85         );
  86         $self->client( $client );
  87     }
  88     return $self;
  89 }
  90
  91 =head1 METHODS
  92
  93 L<WebService::ILS::RecordedBooks::PartnerPatron> methods used without mods:
  94
  95 =over 4
  96
  97 =item C<error_message()>
  98
  99 =back
 100
 101 =cut
 102
 103 use vars qw{$AUTOLOAD};
 104 sub AUTOLOAD {
 105     my $self = shift;
 106     (my $method = $AUTOLOAD) =~ s/.*:://;
 107     return $self->client->$method(@_);
 108 }
 109 sub DESTROY { }
 110
 111 1;