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 $rb_client = Koha::ExternalContent::RecordedBooks->new();
  41     my $rb_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 =head2 Class Methods
  52
  53 =cut
  54
  55 =head3 new
  56
  57 my $rb_client = Koha::ExternalContent::RecordedBooks->new();
  58
  59 Create the object for interacting with RecordedBooks
  60
  61 =cut
  62
  63 sub new {
  64     my $class  = shift;
  65     my $params = shift || {};
  66
  67     my $self = $class->SUPER::new($params);
  68     unless ($params->{client}) {
  69         my $client_secret  = C4::Context->preference('RecordedBooksClientSecret')
  70           or croak("RecordedBooksClientSecret pref not set");
  71         my $library_id     = C4::Context->preference('RecordedBooksLibraryID')
  72           or croak("RecordedBooksLibraryID pref not set");
  73         my $domain         = C4::Context->preference('RecordedBooksDomain');
  74         my $patron = $params->{koha_session_id} ? $self->koha_patron : undef;
  75         my $email;
  76         if ($patron) {
  77             $email = $patron->email
  78               or $self->logger->warn("User with no email, cannot identify with RecordedBooks");
  79         }
  80         my $client;
  81         if ($email) {
  82             local $@;
  83             $client = eval { WebService::ILS::RecordedBooks::PartnerPatron->new(
  84                 client_secret     => $client_secret,
  85                 library_id        => $library_id,
  86                 domain            => $domain,
  87                 user_id           => $email,
  88             ) };
  89             $self->logger->warn("Invalid RecordedBooks user $email ($@)") if $@;
  90             $self->is_identified($client);
  91         }
  92         $client ||= WebService::ILS::RecordedBooks::Partner->new(
  93                 client_secret     => $client_secret,
  94                 library_id        => $library_id,
  95                 domain            => $domain,
  96         );
  97         $self->client( $client );
  98     }
  99     return $self;
 100 }
 101
 102 =head1 METHODS
 103
 104 L<WebService::ILS::RecordedBooks::PartnerPatron> methods used without mods:
 105
 106 =over 4
 107
 108 =item C<error_message()>
 109
 110 =back
 111
 112 =cut
 113
 114 use vars qw{$AUTOLOAD};
 115 sub AUTOLOAD {
 116     my $self = shift;
 117     (my $method = $AUTOLOAD) =~ s/.*:://;
 118     return $self->client->$method(@_);
 119 }
 120 sub DESTROY { }
 121
 122 1;