File Coverage

blib/lib/Catmandu/Importer/Blacklight.pm
Criterion Covered Total %
statement 13 15 86.6
branch n/a
condition n/a
subroutine 5 5 100.0
pod n/a
total 18 20 90.0


line stmt bran cond sub pod time code
1             package Catmandu::Importer::Blacklight;
2              
3 2     2   41316 use Catmandu::Sane;
  2         245650  
  2         13  
4 2     2   2194 use Catmandu::Util qw(:is);
  2         104114  
  2         797  
5 2     2   1393 use REST::Client;
  2         299735  
  2         68  
6 2     2   20 use URI::Escape;
  2         3  
  2         117  
7 2     2   821 use JSON;
  0            
  0            
8             use Moo;
9             use feature 'state';
10              
11             with 'Catmandu::Importer';
12              
13             has url => (is => 'ro', required => 1);
14             has q => (is => 'ro', required => 1);
15             has client => (is => 'lazy');
16              
17             sub _build_client {
18             my $self;
19             REST::Client->new();
20             }
21              
22             sub generator {
23             my ($self) = @_;
24              
25             sub {
26             state $response = $self->query($self->q(),1);
27             state $idx = 0;
28              
29             unless (defined($response)) {
30             print STDERR "Catmandu::Importer::Blacklight no response from: " . $self->url . "\n";
31             return undef;
32             }
33              
34             if (defined $response && ! defined $response->{docs}->[$idx]) {
35             $response = $self->query($self->q(),$response->{pages}->{next_page});
36             $idx = 0;
37             }
38              
39             return unless defined($response->{docs}->[0]);
40              
41             my $doc = $response->{docs}->[$idx];
42             my $id = $doc->{id};
43              
44             $idx++;
45              
46             { '_id' => $id , %$doc};
47             };
48             }
49              
50             sub query {
51             my ($self,$q,$page) = @_;
52              
53             return undef unless defined($page) && $page =~ /^\d+$/;
54              
55             my $url = sprintf "%s?q=%s&page=%d" , $self->url, uri_escape($q), $page;
56             my $response = $self->client->GET($url, { Accept => 'application/json' });
57              
58             return undef unless ($response->responseCode eq '200');
59              
60             my $json = $response->responseContent;
61             my $perl = JSON::from_json($json , { utf8 => 1 });
62              
63             $perl->{response};
64             }
65              
66             1;
67              
68             __END__