File Coverage

blib/lib/MetaCPAN/API.pm
Criterion Covered Total %
statement 68 68 100.0
branch 21 22 95.4
condition 6 8 75.0
subroutine 15 15 100.0
pod 2 2 100.0
total 112 115 97.3


line stmt bran cond sub pod time code
1 15     15   771881 use strict;
  15         36  
  15         811  
2 15     15   84 use warnings;
  15         29  
  15         848  
3             package MetaCPAN::API;
4             # ABSTRACT: A comprehensive, DWIM-featured API to MetaCPAN
5             $MetaCPAN::API::VERSION = '0.44';
6 15     15   17787 use Any::Moose;
  15         711479  
  15         136  
7              
8 15     15   9798 use Carp;
  15         43  
  15         1306  
9 15     15   32715 use JSON;
  15         316317  
  15         97  
10 15     15   3639 use Try::Tiny;
  15         1792  
  15         1182  
11 15     15   28249 use HTTP::Tiny;
  15         1313712  
  15         766  
12 15     15   16664 use URI::Escape 'uri_escape';
  15         21530  
  15         14929  
13              
14             with qw/
15             MetaCPAN::API::Author
16             MetaCPAN::API::Distribution
17             MetaCPAN::API::Favorite
18             MetaCPAN::API::File
19             MetaCPAN::API::Autocomplete
20             MetaCPAN::API::Module
21             MetaCPAN::API::POD
22             MetaCPAN::API::Rating
23             MetaCPAN::API::Release
24             MetaCPAN::API::Source
25             /;
26              
27             has base_url => (
28                 is => 'ro',
29                 isa => 'Str',
30                 default => 'http://api.metacpan.org/v0',
31             );
32              
33             has ua => (
34                 is => 'ro',
35                 isa => 'HTTP::Tiny',
36                 lazy_build => 1,
37             );
38              
39             has ua_args => (
40                 is => 'ro',
41                 isa => 'ArrayRef',
42                 default => sub {
43                     my $version = $MetaCPAN::API::VERSION || 'xx';
44                     return [ agent => "MetaCPAN::API/$version" ];
45                 },
46             );
47              
48             sub _build_ua {
49 13     13   1187     my $self = shift;
50              
51 13         73     return HTTP::Tiny->new( @{ $self->ua_args } );
  13         154  
52             }
53              
54             sub fetch {
55 15     15 1 3304     my $self = shift;
56 15         41     my $url = shift;
57 15         198     my $extra = $self->_build_extra_params(@_);
58 15         87     my $base = $self->base_url;
59 15 100       207     my $req_url = $extra ? "$base/$url?$extra" : "$base/$url";
60              
61 15         712     my $result = $self->ua->get($req_url);
62 15         536718     return $self->_decode_result( $result, $req_url );
63             }
64              
65             sub post {
66 5     5 1 9206     my $self = shift;
67 5         8     my $url = shift;
68 5         7     my $query = shift;
69 5         14     my $base = $self->base_url;
70              
71 5 100       211     defined $url
72                     or croak 'First argument of URL must be provided';
73              
74 4 100 66     419     ref $query and ref $query eq 'HASH'
75                     or croak 'Second argument of query hashref must be provided';
76              
77 2         13     my $query_json = to_json( $query, { canonical => 1 } );
78 2         118     my $result = $self->ua->request(
79                     'POST',
80                     "$base/$url",
81                     {
82                         headers => { 'Content-Type' => 'application/json' },
83                         content => $query_json,
84                     }
85                 );
86              
87 2         3527     return $self->_decode_result( $result, $url, $query_json );
88             }
89              
90             sub _decode_result {
91 24     24   6657     my $self = shift;
92 24         228     my ( $result, $url, $original ) = @_;
93 24         46     my $decoded_result;
94              
95 24 100 66     832     ref $result and ref $result eq 'HASH'
96                     or croak 'First argument must be hashref';
97              
98 23 100       223     defined $url
99                     or croak 'Second argument of a URL must be provided';
100              
101 22 100       428     if ( defined ( my $success = $result->{'success'} ) ) {
102 21   100     271         my $reason = $result->{'reason'} || '';
103 21 100       92         $reason .= ( defined $original ? " (request: $original)" : '' );
104              
105 21 100       560         $success or croak "Failed to fetch '$url': $reason";
106                 } else {
107 1         177         croak 'Missing success in return value';
108                 }
109              
110 19 50       591     defined ( my $content = $result->{'content'} )
111                     or croak 'Missing content in return value';
112              
113 19     19   52074     try { $decoded_result = decode_json $content }
114 19     1   274     catch { croak "Couldn't decode '$content': $_" };
  1         138  
115              
116 18         769     return $decoded_result;
117             }
118              
119             sub _build_extra_params {
120 19     19   2635     my $self = shift;
121              
122 19 100       363     @_ % 2 == 0
123                     or croak 'Incorrect number of params, must be key/value';
124 18         58     my %extra = @_;
125              
126             # if it's deep, JSON encoding needs to be involved
127 18 100       186     if (scalar grep { ref } values %extra) {
  13         42  
128 1         10         my $query_json = to_json( \%extra, { canonical => 1 } );
129 1         73         %extra = ( source => $query_json );
130                 }
131              
132 11         203     my $extra = join '&', map {
133 18         135         "$_=" . uri_escape( $extra{$_} )
134                 } sort keys %extra;
135              
136 18         303     return $extra;
137             }
138              
139             1;
140              
141             __END__
142            
143             =pod
144            
145             =head1 NAME
146            
147             MetaCPAN::API - A comprehensive, DWIM-featured API to MetaCPAN
148            
149             =head1 VERSION
150            
151             version 0.44
152            
153             =head1 SYNOPSIS
154            
155             # simple usage
156             my $mcpan = MetaCPAN::API->new();
157             my $author = $mcpan->author('XSAWYERX');
158             my $dist = $mcpan->release( distribution => 'MetaCPAN-API' );
159            
160             # advanced usage with cache (contributed by Kent Fredric)
161             require CHI;
162             require WWW::Mechanize::Cached;
163             require HTTP::Tiny::Mech;
164             require MetaCPAN::API;
165            
166             my $mcpan = MetaCPAN::API->new(
167             ua => HTTP::Tiny::Mech->new(
168             mechua => WWW::Mechanize::Cached->new(
169             cache => CHI->new(
170             driver => 'File',
171             root_dir => '/tmp/metacpan-cache',
172             ),
173             ),
174             ),
175             );
176            
177             =head1 DESCRIPTION
178            
179             This is a hopefully-complete API-compliant interface to MetaCPAN
180             (L<https://metacpan.org>) with DWIM capabilities, to make your life easier.
181            
182             This module has three purposes:
183            
184             =over 4
185            
186             =item * Provide 100% of the beta MetaCPAN API
187            
188             This module will be updated regularly on every MetaCPAN API change, and intends
189             to provide the user with as much of the API as possible, no shortcuts. If it's
190             documented in the API, you should be able to do it.
191            
192             Because of this design decision, this module has an official MetaCPAN namespace
193             with the blessing of the MetaCPAN developers.
194            
195             Notice this module currently only provides the beta API, not the old
196             soon-to-be-deprecated API.
197            
198             =item * Be lightweight, to allow flexible usage
199            
200             While many modules would help make writing easier, it's important to take into
201             account how they affect your compile-time, run-time and overall memory
202             consumption.
203            
204             By providing a slim interface implementation, more users are able to use this
205             module, such as long-running processes (like daemons), CLI or GUI applications,
206             cron jobs, and more.
207            
208             =item * DWIM
209            
210             While it's possible to access the methods defined by the API spec, there's still
211             a matter of what you're really trying to achieve. For example, when searching
212             for I<"Dave">, you want to find both I<Dave Cross> and I<Dave Rolsky> (and any
213             other I<Dave>), but you also want to search for a PAUSE ID of I<DAVE>, if one
214             exists.
215            
216             This is where DWIM comes in. This module provides you with additional generic
217             methods which will try to do what they think you want.
218            
219             Of course, this does not prevent you from manually using the API methods. You
220             still have full control over that, if that's what you wish.
221            
222             You can (and should) read up on the generic methods, which will explain how
223             their DWIMish nature works, and what searches they run.
224            
225             =back
226            
227             =head1 DEPRECATED
228            
229             B<THIS MODULE IS DEPRECATED, DO NOT USE!>
230            
231             This module has been completely rewritten to address a multitude
232             of problems, and is now available under the new official name:
233             L<MetaCPAN::Client>.
234            
235             Please do not use this module.
236            
237             =head1 ATTRIBUTES
238            
239             =head2 base_url
240            
241             my $mcpan = MetaCPAN::API->new(
242             base_url => 'http://localhost:9999',
243             );
244            
245             This attribute is used for REST requests. You should set it to where the
246             MetaCPAN is accessible. By default it's already set correctly, but if you're
247             running a local instance of MetaCPAN, or use a local mirror, or tunnel it
248             through a local port, or any of those stuff, you would want to change this.
249            
250             Default: I<http://api.metacpan.org/v0>.
251            
252             This attribute is read-only (immutable), meaning that once it's set on
253             initialize (via C<new()>), you cannot change it. If you need to, create a
254             new instance of MetaCPAN::API. Why is it immutable? Because it's better.
255            
256             =head2 ua
257            
258             This attribute is used to contain the user agent used for running the REST
259             request to the server. It is specifically set to L<HTTP::Tiny>, so if you
260             want to set it manually, make sure it's of HTTP::Tiny.
261            
262             HTTP::Tiny is used as part of the philosophy of keeping it tiny.
263            
264             This attribute is read-only (immutable), meaning that once it's set on
265             initialize (via C<new()>), you cannot change it. If you need to, create a
266             new instance of MetaCPAN::API. Why is it immutable? Because it's better.
267            
268             =head2 ua_args
269            
270             my $mcpan = MetaCPAN::API->new(
271             ua_args => [ agent => 'MyAgent' ],
272             );
273            
274             The arguments that will be given to the L<HTTP::Tiny> user agent.
275            
276             This attribute is read-only (immutable), meaning that once it's set on
277             initialize (via C<new()>), you cannot change it. If you need to, create a
278             new instance of MetaCPAN::API. Why is it immutable? Because it's better.
279            
280             The default is a user agent string: B<MetaCPAN::API/$version>.
281            
282             =head1 METHODS
283            
284             =head2 fetch
285            
286             my $result = $mcpan->fetch('/release/distribution/Moose');
287            
288             # with parameters
289             my $more = $mcpan->fetch(
290             '/release/distribution/Moose',
291             param => 'value',
292             );
293            
294             This is a helper method for API implementations. It fetches a path from
295             MetaCPAN, decodes the JSON from the content variable and returns it.
296            
297             You don't really need to use it, but you can in case you want to write your
298             own extension implementation to MetaCPAN::API.
299            
300             It accepts an additional hash as C<GET> parameters.
301            
302             =head2 post
303            
304             # /release&content={"query":{"match_all":{}},"filter":{"prefix":{"archive":"Cache-Cache-1.06"}}}
305             my $result = $mcpan->post(
306             'release',
307             {
308             query => { match_all => {} },
309             filter => { prefix => { archive => 'Cache-Cache-1.06' } },
310             },
311             );
312            
313             The POST equivalent of the C<fetch()> method. It gets the path and JSON request.
314            
315             =head1 AUTHOR
316            
317             Sawyer X <xsawyerx@cpan.org>
318            
319             =head1 COPYRIGHT AND LICENSE
320            
321             This software is copyright (c) 2011 by Sawyer X.
322            
323             This is free software; you can redistribute it and/or modify it under
324             the same terms as the Perl 5 programming language system itself.
325            
326             =cut
327