File Coverage

blib/lib/WebService/ILS/OverDrive.pm
Criterion Covered Total %
statement 30 141 21.2
branch 0 76 0.0
condition 0 8 0.0
subroutine 10 26 38.4
pod 7 10 70.0
total 47 261 18.0


line stmt bran cond sub pod time code
1             package WebService::ILS::OverDrive;
2              
3 3     3   1021 use Modern::Perl;
  3         5  
  3         17  
4              
5             =encoding utf-8
6              
7             =head1 NAME
8              
9             WebService::ILS::OverDrive - WebService::ILS module for OverDrive services
10              
11             =head1 SYNOPSIS
12              
13             use WebService::ILS::OverDrive::Library;
14             or
15             use WebService::ILS::OverDrive::Patron;
16              
17             =head1 DESCRIPTION
18              
19             L - anonymous discovery
20             services - no individual user credentials required
21              
22             L - discovery and circulation
23             services that require individual user credentials
24              
25             See L
26              
27             =cut
28              
29 3     3   309 use Carp;
  3         5  
  3         157  
30 3     3   14 use HTTP::Request::Common;
  3         6  
  3         128  
31 3     3   14 use URI::Escape;
  3         6  
  3         178  
32              
33 3     3   18 use parent qw(WebService::ILS::JSON);
  3         5  
  3         22  
34              
35 3     3   151 use constant API_VERSION => "v1";
  3         7  
  3         169  
36              
37 3     3   20 use constant DISCOVERY_API_URL => "http://api.overdrive.com/";
  3         5  
  3         169  
38 3     3   22 use constant TEST_DISCOVERY_API_URL => "http://integration.api.overdrive.com/";
  3         5  
  3         287  
39              
40             =head1 CONSTRUCTOR
41              
42             =head2 new (%params_hash or $params_hashref)
43              
44             =head3 Additional constructor params:
45              
46             =over 10
47              
48             =item C => if set to true use OverDrive test API urls
49              
50             =back
51              
52             =cut
53              
54             use Class::Tiny qw(
55             collection_token
56             test
57             ), {
58 0 0       0 _discovery_api_url => sub { $_[0]->test ? TEST_DISCOVERY_API_URL : DISCOVERY_API_URL },
59 3     3   19 };
  3         6  
  3         29  
60              
61             __PACKAGE__->_set_param_spec({
62             test => { required => 0 },
63             });
64              
65             =head1 DISCOVERY METHODS
66              
67             =head2 search ($params_hashref)
68              
69             =head3 Additional input params:
70              
71             =over 16
72              
73             =item C => if true, no metadata calls will be made for result items;
74              
75             only id, title, rating and media will be available
76              
77             =back
78              
79             =cut
80              
81             my %SORT_XLATE = (
82             available_date => "dateadded",
83             rating => "starrating",
84             publication_date => undef, # not available
85             );
86             sub search {
87 0     0 1   my $self = shift;
88 0   0       my $params = shift || {};
89              
90 0           my $short_response = delete $params->{no_details};
91              
92 0           my $url = $self->products_url;
93              
94 0 0         if (my $query = delete $params->{query}) {
95 0 0         $query = join " ", @$query if ref $query;
96 0           $params->{q} = $query;
97             }
98 0           my $page_size = delete $params->{page_size};
99 0 0         $params->{limit} = $page_size if $page_size;
100 0 0         if (my $page_number = delete $params->{page}) {
101 0 0         croak "page_size must be specified for paging" unless $params->{limit};
102 0           $params->{offset} = ($page_number - 1)*$page_size;
103             }
104 0 0         if (my $sort = delete $params->{sort}) {
105 0           $params->{sort} = join ",", @{ $self->_parse_sort_string($sort, \%SORT_XLATE) };
  0            
106             }
107 0 0         $params->{formats} = join ",", @{$params->{formats}} if ref $params->{formats};
  0            
108              
109 0           my $res = $self->get_response($url, $params);
110 0           my @items;
111 0 0         foreach (@{$res->{products} || []}) {
  0            
112 0           my $item;
113 0 0         if ($short_response) {
114 0           $item = $self->_item_xlate($_);
115             } else {
116 0 0         my $native_metadata = $self->native_item_metadata($_) or next;
117 0           $item = $self->_item_metadata_xlate($native_metadata);
118             }
119 0 0         next unless $item;
120 0           push @items, $item;
121             }
122 0           my $tot = $res->{totalItems};
123 0           my %ret = (
124             total => $tot,
125             items => \@items,
126             );
127 0 0         if (my $page_size = $res->{limit}) {
128 0           my $pages = int($tot/$page_size);
129 0 0         $pages++ if $tot > $page_size*$pages;
130 0           $ret{pages} = $pages;
131 0           $ret{page_size} = $page_size;
132 0           $ret{page} = $res->{offset}/$page_size + 1;
133             }
134 0           return \%ret;
135             }
136              
137             my %SEARCH_RESULT_ITEM_XLATE = (
138             id => "id",
139             title => "title",
140             subtitle => "subtitle",
141             starRating => "rating",
142             mediaType => "media",
143             );
144             sub _item_xlate {
145 0     0     my $self = shift;
146 0           my $item = shift;
147              
148 0           my $std_item = $self->_result_xlate($item, \%SEARCH_RESULT_ITEM_XLATE);
149              
150 0 0         if (my $formats = $item->{formats}) {
151 0           $std_item->{formats} = [map $_->{id}, @$formats];
152             }
153              
154 0 0         if (my $images = $item->{images}) {
155 0           $std_item->{images} = {map { $_ => $images->{$_}{href} } keys %$images};
  0            
156             }
157              
158             # XXX
159             #if (my $details = $item->{contentDetails}) {
160             # $std_item->{details_url} = $details->{href};
161             #}
162              
163 0           return $std_item;
164             }
165              
166             my %METADATA_XLATE = (
167             id => "id",
168             mediaType => "media",
169             title => "title",
170             publisher => "publisher",
171             shortDescription => "subtitle",
172             starRating => "rating",
173             popularity => "popularity",
174             );
175             sub item_metadata {
176 0     0 1   my $self = shift;
177 0 0         my $id = shift or croak "No item id";
178 0           my $native_metadata = $self->get_response($self->products_url."/$id/metadata");
179 0           return $self->_item_metadata_xlate($native_metadata);
180             }
181              
182             sub _item_metadata_xlate {
183 0     0     my $self = shift;
184 0 0         my $metadata = shift or croak "No native metadata";
185              
186 0           my $item = $self->_result_xlate($metadata, \%METADATA_XLATE);
187              
188 0           my @authors;
189 0           foreach (@{ $metadata->{creators} }) {
  0            
190 0 0         push @authors, $_->{name} if $_->{role} eq "Author";
191             }
192 0           $item->{author} = join ", ", @authors;
193              
194 0 0         if (my $images = $metadata->{images}) {
195 0           $item->{images} = {map { $_ => $images->{$_}{href} } keys %$images};
  0            
196             }
197              
198 0 0         if (my $languages = $metadata->{languages}) {
199 0           $item->{languages} = [map $_->{name}, @$languages];
200             }
201              
202 0 0         if (my $subjects = $metadata->{subjects}) {
203 0           $item->{subjects} = [map $_->{value}, @$subjects];
204             }
205              
206 0 0         if (my $formats = $metadata->{formats}) {
207 0           $item->{formats} = [map $_->{id}, @$formats];
208             }
209              
210 0           return $item;
211             }
212              
213             my %AVAILABILITY_RESULT_XLATE = (
214             id => "id",
215             available => "available",
216             copiesAvailable => "copies_available",
217             copiesOwned => "copies_owned",
218             availabilityType => "type",
219             );
220             sub item_availability {
221 0     0 1   my $self = shift;
222 0 0         my $id = shift or croak "No item id";
223 0           return $self->_result_xlate(
224             $self->get_response($self->products_url."/$id/availability"),
225             \%AVAILABILITY_RESULT_XLATE
226             );
227             }
228              
229             sub is_item_available {
230 0     0 1   my $self = shift;
231 0 0         my $id = shift or croak "No item id";
232 0           my $type = shift;
233              
234 0 0         my $availability = $self->item_availability($id) or return;
235 0 0         return unless $availability->{available};
236 0   0       return !$type || $type eq $availability->{type};
237             }
238              
239             =head1 NATIVE METHODS
240              
241             =head2 native_search ($params_hashref)
242              
243             See L
244              
245             =head2 native_search_[next|prev|first|last] ($data_as returned_by_native_search*)
246              
247             For iterating through search result pages. Each native_search_*() method
248             accepts record returned by any native_search*() method as input.
249              
250             Example:
251              
252             my $res = $od->native_search({q => "Dogs"});
253             while ($res) {
254             do_something($res);
255             $res = $od->native_search_next($res);
256             }
257             or
258             my $res = $od->native_search({q => "Dogs"});
259             my $last = $od->native_search_last($res);
260             my $next_to_last = $od->native_search_prev($last);
261             my $first = $od->native_search_first($next_to_last)
262             # Same as $od->native_search_first($last)
263             # Same as $res
264              
265             =cut
266              
267             # params: q, limit, offset, formats, sort ? availability
268             sub native_search {
269 0     0 1   my $self = shift;
270 0           my $search_params = shift;
271              
272 0           return $self->get_response($self->products_url, $search_params);
273             }
274              
275             foreach my $f (qw(next prev first last)) {
276 3     3   4479 no strict 'refs';
  3         7  
  3         1452  
277             my $method = "native_search_$f";
278             *$method = sub {
279 0     0     my $self = shift;
280 0 0         my $search_data = shift or croak "No search result data";
281 0 0         my $url = _extract_link($search_data, $f) or return;
282 0           return $self->get_response($url);
283             }
284             }
285              
286             # Item API
287              
288             =head2 native_item_metadata ($item_data as returned by native_search*)
289              
290             =head2 native_item_availability ($item_data as returned by native_search*)
291              
292             Example:
293              
294             my $res = $od->native_search({q => "Dogs"});
295             foreach (@{ $res->{products} }) {
296             my $meta = $od->native_item_metadata($_);
297             my $availability = $od->native_item_availability($_);
298             ...
299             }
300              
301             =cut
302              
303             sub native_item_metadata {
304 0     0 1   my $self = shift;
305 0 0         my $item = shift or croak "No item record";
306              
307 0 0         my $url = _extract_link($item, 'metadata') or die "No metadata link\n";
308 0           return $self->get_response($url);
309             }
310              
311             sub native_item_availability {
312 0     0 1   my $self = shift;
313 0 0         my $item = shift or croak "No item record";
314 0           return $self->get_response(_extract_link($item, 'availability'));
315             }
316              
317             # Discovery helpers
318              
319             sub discovery_action_url {
320 0     0 0   my $self = shift;
321 0           my $action = shift;
322 0           return $self->_discovery_api_url.$self->API_VERSION.$action;
323             }
324              
325             sub products_url {
326 0     0 0   my $self = shift;
327              
328 0 0         my $collection_token = $self->collection_token or die "No collection token";
329              
330 0 0         if ($collection_token) {
331 0           return $self->_discovery_api_url.$self->API_VERSION."/collections/$collection_token/products";
332             }
333             }
334              
335             # API helpers
336              
337             sub _extract_link {
338 0     0     my ($data, $link) = @_;
339             my $href = $data->{links}{$link}{href}
340 0 0         or croak "No '$link' url in data";
341             }
342              
343             # Utility methods
344              
345 0     0     sub _basic_callback { return $_[0]; }
346              
347             # This is not exatly how we meant to use with_get_request()
348             # ie processing should be placed within the callback.
349             # However, if all goes well, it is faster (from the development perspective)
350             # this way.
351             sub get_response {
352 0     0 0   my $self = shift;
353 0 0         my $url = shift or croak "No url";
354 0           my $get_params = shift; # hash ref
355              
356 0           return $self->with_get_request(\&_basic_callback, $url, $get_params);
357             }
358              
359             sub _error_from_json {
360 0     0     my $self = shift;
361 0 0         my $data = shift or croak "No json data";
362 0   0       my $error = join " ", grep defined($_), $data->{errorCode}, $data->{error_description} || $data->{error} || $data->{message} || $data->{Message};
363 0 0         $error = "$error\n" if $error; # strip code line when dying
364 0           return $error;
365             }
366              
367             1;
368              
369             __END__