File Coverage

blib/lib/MetaCPAN/API.pm
Criterion Covered Total %
statement 70 70 100.0
branch 21 22 95.4
condition 6 8 75.0
subroutine 16 16 100.0
pod 2 2 100.0
total 115 118 97.4


line stmt bran cond sub pod time code
1 16     16   2224304 use strict;
  16         35  
  16         783  
2 16     16   138 use warnings;
  16         30  
  16         1233  
3             package MetaCPAN::API;
4              
5             our $VERSION = '0.52';
6              
7 16     16   8266 use Moo;
  16         112645  
  16         74  
8 16     16   33588 use Types::Standard qw;
  16         2190761  
  16         218  
9 16     16   61593 use namespace::autoclean;
  16         299870  
  16         73  
10              
11 16     16   1231 use Carp;
  16         27  
  16         1223  
12 16     16   7838 use JSON::MaybeXS 1.001000;
  16         189976  
  16         1439  
13 16     16   198 use Try::Tiny;
  16         34  
  16         1210  
14 16     16   11576 use HTTP::Tiny 0.014;
  16         911966  
  16         15621  
15              
16             with qw/
17             MetaCPAN::API::Author
18             MetaCPAN::API::Distribution
19             MetaCPAN::API::Favorite
20             MetaCPAN::API::File
21             MetaCPAN::API::Autocomplete
22             MetaCPAN::API::Module
23             MetaCPAN::API::POD
24             MetaCPAN::API::Rating
25             MetaCPAN::API::Release
26             MetaCPAN::API::Source
27             /;
28              
29             has base_url => (
30             is => 'ro',
31             isa => Str,
32             default => sub{'https://fastapi.metacpan.org/v1'},
33             );
34              
35             has ua => (
36             is => 'ro',
37             lazy => 1,
38             builder => '_build_ua',
39             isa => InstanceOf['HTTP::Tiny'],
40             );
41              
42             has ua_args => (
43             is => 'ro',
44             isa => ArrayRef,
45             default => sub {
46             my $version = $MetaCPAN::API::VERSION || 'xx';
47             return [ agent => "MetaCPAN::API/$version" ];
48             },
49             );
50              
51             my $JSON = JSON::MaybeXS->new(canonical => 1, utf8 => 1);
52              
53             sub _build_ua {
54 14     14   298 my $self = shift;
55 14         32 return HTTP::Tiny->new( @{ $self->ua_args } );
  14         174  
56             }
57              
58             sub fetch {
59 15     15 1 1097 my $self = shift;
60 15         36 my $url = shift;
61 15         154 my $extra = $self->_build_extra_params(@_);
62 15         78 my $base = $self->base_url;
63 15 100       76 my $req_url = $extra ? "$base/$url?$extra" : "$base/$url";
64              
65 15         394 my $result = $self->ua->get($req_url);
66 15         3958154 return $self->_decode_result( $result, $req_url );
67             }
68              
69             sub post {
70 5     5 1 5850 my $self = shift;
71 5         9 my $url = shift;
72 5         10 my $query = shift;
73 5         18 my $base = $self->base_url;
74              
75 5 100       156 defined $url
76             or croak 'First argument of URL must be provided';
77              
78 4 100 66     275 ref $query and ref $query eq 'HASH'
79             or croak 'Second argument of query hashref must be provided';
80              
81 2         19 my $query_json = $JSON->encode( $query );
82 2         79 my $result = $self->ua->request(
83             'POST',
84             "$base/$url",
85             {
86             headers => { 'Content-Type' => 'application/json' },
87             content => $query_json,
88             }
89             );
90              
91 2         8756 return $self->_decode_result( $result, $url, $query_json );
92             }
93              
94             sub _decode_result {
95 24     24   4970 my $self = shift;
96 24         82 my ( $result, $url, $original ) = @_;
97 24         57 my $decoded_result;
98              
99 24 100 66     427 ref $result and ref $result eq 'HASH'
100             or croak 'First argument must be hashref';
101              
102 23 100       208 defined $url
103             or croak 'Second argument of a URL must be provided';
104              
105 22 100       120 if ( defined ( my $success = $result->{'success'} ) ) {
106 21   100     92 my $reason = $result->{'reason'} || '';
107 21 100       78 $reason .= ( defined $original ? " (request: $original)" : '' );
108              
109 21 100       272 $success or croak "Failed to fetch '$url': $reason - $result->{content}";
110             } else {
111 1         199 croak 'Missing success in return value';
112             }
113              
114 19 50       331 defined ( my $content = $result->{'content'} )
115             or croak 'Missing content in return value';
116              
117 19     19   5248 try { $decoded_result = $JSON->decode( $content ) }
118 19     1   312 catch { croak "Couldn't decode '$content': $_" };
  1         105  
119              
120 18         1452 return $decoded_result;
121             }
122              
123             sub _build_extra_params {
124 19     19   3177 my $self = shift;
125              
126 19 100       328 @_ % 2 == 0
127             or croak 'Incorrect number of params, must be key/value';
128 18         70 my %extra = @_;
129              
130             # if it's deep, JSON encoding needs to be involved
131 18 100       96 if (scalar grep { ref } values %extra) {
  13         44  
132 1         50 my $query_json = $JSON->encode( \%extra );
133 1         5 %extra = ( source => $query_json );
134             }
135              
136 18         804 my $extra = $self->ua->www_form_urlencode(\%extra);
137              
138 18         2845 return $extra;
139             }
140              
141             1;
142              
143             __END__