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

use 5.008001;
use strict;
use warnings;

package CPAN::Common::Index::MetaDB;
# ABSTRACT: Search index via CPAN MetaDB

our $VERSION = '0.009'; # TRIAL

use parent 'CPAN::Common::Index';

use Class::Tiny qw/uri/;

use Carp;
use CPAN::Meta::YAML;
use HTTP::Tiny;

#pod =attr uri
#pod
#pod A URI for the endpoint of a CPAN MetaDB server. The
#pod default is L.
#pod
#pod =cut

sub BUILD {
    my $self = shift;
    my $uri  = $self->uri;
    $uri = "http://cpanmetadb.plackperl.org/v1.0/"
      unless defined $uri;
    # ensure URI ends in '/'
    $uri =~ s{/?$}{/};
    $self->uri($uri);
    return;
}

sub search_packages {
    my ( $self, $args ) = @_;
    Carp::croak("Argument to search_packages must be hash reference")
      unless ref $args eq 'HASH';

    # only support direct package query
    return
      unless keys %$args == 1 && exists $args->{package} && ref $args->{package} eq '';

    my $mod = $args->{package};
    my $res = HTTP::Tiny->new->get( $self->uri . "package/$mod" );
    return unless $res->{success};

    if ( my $yaml = CPAN::Meta::YAML->read_string( $res->{content} ) ) {
        my $meta = $yaml->[0];
        if ( $meta && $meta->{distfile} ) {
            my $file = $meta->{distfile};
            $file =~ s{^./../}{}; # strip leading
            return {
                package => $mod,
                version => $meta->{version},
                uri     => "cpan:///distfile/$file",
            };
        }
    }

    return;
}

sub index_age { return time };    # pretend always current

sub search_authors { return };    # not supported

1;


# vim: ts=4 sts=4 sw=4 et:

__END__