Bug 6679: (follow-up) fix 9 perlcritic violations in C4/TmplTokenType.pm
[koha.git] / C4 / External / OverDrive.pm
1 package C4::External::OverDrive;
2
3 # Copyright (c) 2013 ByWater
4 #
5 # This file is part of Koha.
6 #
7 # Koha is free software; you can redistribute it and/or modify it
8 # under the terms of the GNU General Public License as published by
9 # the Free Software Foundation; either version 3 of the License, or
10 # (at your option) any later version.
11 #
12 # Koha is distributed in the hope that it will be useful, but
13 # WITHOUT ANY WARRANTY; without even the implied warranty of
14 # MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
15 # GNU General Public License for more details.
16 #
17 # You should have received a copy of the GNU General Public License
18 # along with Koha; if not, see <http://www.gnu.org/licenses>.
19
20 use strict;
21 use warnings;
22
23 use Koha;
24 use JSON;
25 use Koha::Cache;
26 use HTTP::Request;
27 use HTTP::Request::Common;
28 use LWP::Authen::Basic;
29 use LWP::UserAgent;
30
31 BEGIN {
32     require Exporter;
33     our $VERSION = 3.07.00.049;
34     our @ISA = qw( Exporter ) ;
35     our @EXPORT = qw(
36         IsOverDriveEnabled
37         GetOverDriveToken
38     );
39 }
40
41 sub _request {
42     my ( $request ) = @_;
43     my $ua = LWP::UserAgent->new( agent => "Koha " . $Koha::VERSION );
44
45     my $response;
46     eval {
47         $response = $ua->request( $request ) ;
48     };
49     if ( $@ )  {
50         warn "OverDrive request failed: $@";
51         return;
52     }
53
54     return $response;
55 }
56
57 =head1 NAME
58
59 C4::External::OverDrive - Retrieve OverDrive content availability information
60
61 =head2 FUNCTIONS
62
63 This module provides content search for OverDrive,
64
65 =over
66
67 =item IsOverDriveEnabled
68
69 Returns 1 if all of the necessary system preferences for OverDrive are set.
70
71 =back
72
73 =cut
74
75 sub IsOverDriveEnabled {
76     return (
77         C4::Context->preference( 'OverDriveClientKey' ) &&
78         C4::Context->preference( 'OverDriveClientSecret' )
79     );
80 }
81
82 =over
83
84 =item GetOverDriveToken
85
86 Fetches an OAuth2 auth token for the OverDrive API, reusing an existing token in
87 Memcache if possible.
88
89 Returns the token ( as "bearer ..." )  or undef on failure.
90
91 =back
92
93 =cut
94
95 sub GetOverDriveToken {
96     my $key = C4::Context->preference( 'OverDriveClientKey' );
97     my $secret = C4::Context->preference( 'OverDriveClientSecret' );
98
99     return unless ( $key && $secret ) ;
100
101     my $cache;
102
103     eval { $cache = Koha::Cache->get_instance() };
104
105     my $token;
106     $cache and $token = $cache->get_from_cache( "overdrive_token" ) and return $token;
107
108     my $request = HTTP::Request::Common::POST( 'https://oauth.overdrive.com/token', [
109         grant_type => 'client_credentials'
110     ] ) ;
111     $request->header( Authorization => LWP::Authen::Basic->auth_header( $key, $secret ) );
112
113     my $response = _request( $request ) or return;
114     if ( $response->header('Content-Type') !~ m!application/json! ) {
115         warn "Could not connect to OverDrive: " . $response->message;
116         return;
117     }
118     my $contents = from_json( $response->decoded_content );
119
120     if ( !$response->is_success ) {
121         warn "Could not log into OverDrive: " . ( $contents ? $contents->{'error_description'} : $response->decoded_content );
122         return;
123     }
124
125     $token = $contents->{'token_type'} . ' ' . $contents->{'access_token'};
126
127     # Fudge factor to prevent spurious failures
128     $cache
129       and $cache->set_in_cache( 'overdrive_token', $token,
130         { expiry => $contents->{'expires_in'} - 5 } );
131
132     return $token;
133 }
134
135 1;
136 __END__
137
138 =head1 NOTES
139
140 =cut
141
142 =head1 AUTHOR
143
144 Jesse Weaver <pianohacker@gmail.com>
145
146 =cut