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
   6 # under the terms of the GNU General Public License as published by
   7 # the Free Software Foundation; either version 3 of the License, or
   8 # (at your option) any later version.
   9 #
  10 # Koha is distributed in the hope that it will be useful, but
  11 # WITHOUT ANY WARRANTY; without even the implied warranty of
  12 # MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
  13 # GNU General Public License for more details.
  14 #
  15 # You should have received a copy of the GNU General Public License
  16 # along with Koha; if not, see <http://www.gnu.org/licenses>.
  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
  28 __PACKAGE__->mk_accessors(qw(domain is_identified));
  29
  30 =head1 NAME
  31
  32 Koha::ExternalContent::RecordedBooks
  33
  34 =head1 SYNOPSIS
  35
  36     use Koha::ExternalContent::RecordedBooks;
  37     my $rb_client = Koha::ExternalContent::RecordedBooks->new();
  38     my $rb_auth_url = $od_client->auth_url();
  39
  40 =head1 DESCRIPTION
  41
  42 A (very) thin wrapper around C<WebService::ILS::RecordedBooks::Patron>
  43
  44 Takes "RecordedBooks*" Koha preferences
  45
  46 =cut
  47
  48 =head2 Class Methods
  49
  50 =cut
  51
  52 =head3 new
  53
  54 my $rb_client = Koha::ExternalContent::RecordedBooks->new();
  55
  56 Create the object for interacting with RecordedBooks
  57
  58 =cut
  59
  60 sub new {
  61     my $class  = shift;
  62     my $params = shift || {};
  63
  64     my $self = $class->SUPER::new($params);
  65     unless ($params->{client}) {
  66         my $client_secret  = C4::Context->preference('RecordedBooksClientSecret')
  67           or croak("RecordedBooksClientSecret pref not set");
  68         my $library_id     = C4::Context->preference('RecordedBooksLibraryID')
  69           or croak("RecordedBooksLibraryID pref not set");
  70         my $domain         = C4::Context->preference('RecordedBooksDomain');
  71         my $patron = $params->{koha_session_id} ? $self->koha_patron : undef;
  72         my $email;
  73         if ($patron) {
  74             $email = $patron->email
  75               or $self->logger->warn("User with no email, cannot identify with RecordedBooks");
  76         }
  77         my $client;
  78         if ($email) {
  79             local $@;
  80             $client = eval { WebService::ILS::RecordedBooks::PartnerPatron->new(
  81                 client_secret     => $client_secret,
  82                 library_id        => $library_id,
  83                 domain            => $domain,
  84                 user_id           => $email,
  85             ) };
  86             $self->logger->warn("Invalid RecordedBooks user $email ($@)") if $@;
  87             $self->is_identified($client);
  88         }
  89         $client ||= WebService::ILS::RecordedBooks::Partner->new(
  90                 client_secret     => $client_secret,
  91                 library_id        => $library_id,
  92                 domain            => $domain,
  93         );
  94         $self->client( $client );
  95     }
  96     return $self;
  97 }
  98
  99 =head1 METHODS
 100
 101 L<WebService::ILS::RecordedBooks::PartnerPatron> methods used without mods:
 102
 103 =over 4
 104
 105 =item C<error_message()>
 106
 107 =back
 108
 109 =cut
 110
 111 use vars qw{$AUTOLOAD};
 112 sub AUTOLOAD {
 113     my $self = shift;
 114     (my $method = $AUTOLOAD) =~ s/.*:://;
 115     return $self->client->$method(@_);
 116 }
 117 sub DESTROY { }
 118
 119 1;