File Coverage

blib/lib/CPAN/Common/Index/MetaDB.pm
Criterion Covered Total %
statement 41 44 93.1
branch 7 12 58.3
condition 3 9 33.3
subroutine 10 12 83.3
pod 3 4 75.0
total 64 81 79.0


line stmt bran cond sub pod time code
1 2     2   45520 use 5.008001;
  2         8  
2 2     2   11 use strict;
  2         5  
  2         44  
3 2     2   9 use warnings;
  2         5  
  2         102  
4              
5             package CPAN::Common::Index::MetaDB;
6             # ABSTRACT: Search index via CPAN MetaDB
7              
8             our $VERSION = '0.010';
9              
10 2     2   12 use parent 'CPAN::Common::Index';
  2         6  
  2         19  
11              
12 2     2   135 use Class::Tiny qw/uri/;
  2         6  
  2         12  
13              
14 2     2   396 use Carp;
  2         5  
  2         136  
15 2     2   1100 use CPAN::Meta::YAML;
  2         11381  
  2         163  
16 2     2   617 use HTTP::Tiny;
  2         23464  
  2         711  
17              
18             #pod =attr uri
19             #pod
20             #pod A URI for the endpoint of a CPAN MetaDB server. The
21             #pod default is L.
22             #pod
23             #pod =cut
24              
25             sub BUILD {
26 3     3 0 9327 my $self = shift;
27 3         128 my $uri = $self->uri;
28 3 100       43 $uri = "http://cpanmetadb.plackperl.org/v1.0/"
29             unless defined $uri;
30             # ensure URI ends in '/'
31 3         25 $uri =~ s{/?$}{/};
32 3         95 $self->uri($uri);
33 3         29 return;
34             }
35              
36             sub search_packages {
37 1     1 1 890 my ( $self, $args ) = @_;
38 1 50       11 Carp::croak("Argument to search_packages must be hash reference")
39             unless ref $args eq 'HASH';
40              
41             # only support direct package query
42             return
43 1 50 33     23 unless keys %$args == 1 && exists $args->{package} && ref $args->{package} eq '';
      33        
44              
45 1         4 my $mod = $args->{package};
46 1         11 my $res = HTTP::Tiny->new->get( $self->uri . "package/$mod" );
47 1 50       45799 return unless $res->{success};
48              
49 1 50       24 if ( my $yaml = CPAN::Meta::YAML->read_string( $res->{content} ) ) {
50 1         36574 my $meta = $yaml->[0];
51 1 50 33     20 if ( $meta && $meta->{distfile} ) {
52 1         7 my $file = $meta->{distfile};
53 1         13 $file =~ s{^./../}{}; # strip leading
54             return {
55             package => $mod,
56             version => $meta->{version},
57 1         251 uri => "cpan:///distfile/$file",
58             };
59             }
60             }
61              
62 0           return;
63             }
64              
65 0     0 1   sub index_age { return time }; # pretend always current
66              
67 0     0 1   sub search_authors { return }; # not supported
68              
69             1;
70              
71              
72             # vim: ts=4 sts=4 sw=4 et:
73              
74             __END__