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 15     15   428385 use strict;
  15         34  
  15         357  
2 15     15   73 use warnings;
  15         306  
  15         627  
3             package MetaCPAN::API;
4             # ABSTRACT: A comprehensive, DWIM-featured API to MetaCPAN (DEPRECATED)
5              
6             our $VERSION = '0.51';
7              
8 15     15   6394 use Moo;
  15         145077  
  15         65  
9 15     15   23479 use Types::Standard qw;
  15         1242108  
  15         193  
10 15     15   20104 use namespace::autoclean;
  15         141541  
  15         59  
11              
12 15     15   895 use Carp;
  15         33  
  15         778  
13 15     15   5390 use JSON::MaybeXS 1.001000;
  15         65117  
  15         773  
14 15     15   101 use Try::Tiny;
  15         29  
  15         637  
15 15     15   7828 use HTTP::Tiny 0.014;
  15         507441  
  15         8641  
16              
17             with qw/
18             MetaCPAN::API::Author
19             MetaCPAN::API::Distribution
20             MetaCPAN::API::Favorite
21             MetaCPAN::API::File
22             MetaCPAN::API::Autocomplete
23             MetaCPAN::API::Module
24             MetaCPAN::API::POD
25             MetaCPAN::API::Rating
26             MetaCPAN::API::Release
27             MetaCPAN::API::Source
28             /;
29              
30             has base_url => (
31             is => 'ro',
32             isa => Str,
33             default => sub{'https://fastapi.metacpan.org/v1'},
34             );
35              
36             has ua => (
37             is => 'ro',
38             lazy => 1,
39             builder => '_build_ua',
40             isa => InstanceOf['HTTP::Tiny'],
41             );
42              
43             has ua_args => (
44             is => 'ro',
45             isa => ArrayRef,
46             default => sub {
47             my $version = $MetaCPAN::API::VERSION || 'xx';
48             return [ agent => "MetaCPAN::API/$version" ];
49             },
50             );
51              
52             my $JSON = JSON::MaybeXS->new(canonical => 1, utf8 => 1);
53              
54             sub _build_ua {
55 14     14   256 my $self = shift;
56 14         32 return HTTP::Tiny->new( @{ $self->ua_args } );
  14         152  
57             }
58              
59             sub fetch {
60 15     15 1 1953 my $self = shift;
61 15         38 my $url = shift;
62 15         69 my $extra = $self->_build_extra_params(@_);
63 15         78 my $base = $self->base_url;
64 15 100       83 my $req_url = $extra ? "$base/$url?$extra" : "$base/$url";
65              
66 15         284 my $result = $self->ua->get($req_url);
67 15         9993863 return $self->_decode_result( $result, $req_url );
68             }
69              
70             sub post {
71 5     5 1 3376 my $self = shift;
72 5         10 my $url = shift;
73 5         9 my $query = shift;
74 5         14 my $base = $self->base_url;
75              
76 5 100       181 defined $url
77             or croak 'First argument of URL must be provided';
78              
79 4 100 66     158 ref $query and ref $query eq 'HASH'
80             or croak 'Second argument of query hashref must be provided';
81              
82 2         29 my $query_json = $JSON->encode( $query );
83 2         48 my $result = $self->ua->request(
84             'POST',
85             "$base/$url",
86             {
87             headers => { 'Content-Type' => 'application/json' },
88             content => $query_json,
89             }
90             );
91              
92 2         3883 return $self->_decode_result( $result, $url, $query_json );
93             }
94              
95             sub _decode_result {
96 24     24   3372 my $self = shift;
97 24         87 my ( $result, $url, $original ) = @_;
98 24         55 my $decoded_result;
99              
100 24 100 66     372 ref $result and ref $result eq 'HASH'
101             or croak 'First argument must be hashref';
102              
103 23 100       153 defined $url
104             or croak 'Second argument of a URL must be provided';
105              
106 22 100       97 if ( defined ( my $success = $result->{'success'} ) ) {
107 21   100     94 my $reason = $result->{'reason'} || '';
108 21 100       88 $reason .= ( defined $original ? " (request: $original)" : '' );
109              
110 21 100       199 $success or croak "Failed to fetch '$url': $reason";
111             } else {
112 1         69 croak 'Missing success in return value';
113             }
114              
115 19 50       98 defined ( my $content = $result->{'content'} )
116             or croak 'Missing content in return value';
117              
118 19     19   4280 try { $decoded_result = $JSON->decode( $content ) }
119 19     1   265 catch { croak "Couldn't decode '$content': $_" };
  1         93  
120              
121 18         579 return $decoded_result;
122             }
123              
124             sub _build_extra_params {
125 19     19   2002 my $self = shift;
126              
127 19 100       224 @_ % 2 == 0
128             or croak 'Incorrect number of params, must be key/value';
129 18         68 my %extra = @_;
130              
131             # if it's deep, JSON encoding needs to be involved
132 18 100       79 if (scalar grep { ref } values %extra) {
  13         39  
133 1         27 my $query_json = $JSON->encode( \%extra );
134 1         5 %extra = ( source => $query_json );
135             }
136              
137 18         517 my $extra = $self->ua->www_form_urlencode(\%extra);
138              
139 18         2311 return $extra;
140             }
141              
142             1;
143              
144             __END__