diff --git a/lib/CPAN/Common/Index/MetaDB.pm b/lib/CPAN/Common/Index/MetaDB.pm index 54e51a8..f31333b 100644 --- a/lib/CPAN/Common/Index/MetaDB.pm +++ b/lib/CPAN/Common/Index/MetaDB.pm @@ -13,6 +13,7 @@ use Class::Tiny qw/uri/; use Carp; use CPAN::Meta::YAML; +use CPAN::Meta::Requirements; use HTTP::Tiny; =attr uri @@ -38,25 +39,61 @@ sub search_packages { 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 ''; + unless 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}; + if ($args->{version} || $args->{version_range}) { + my $res = HTTP::Tiny->new->get( $self->uri . "history/$mod" ); + return unless $res->{success}; + + my $range = defined $args->{version} ? "== $args->{version}" : $args->{version_range}; + my $reqs = CPAN::Meta::Requirements->from_string_hash({ $mod => $range }); + + my @found; + for my $line ( split /\r?\n/, $res->{content} ) { + if ($line =~ /^$mod\s+(\S+)\s+(\S+)$/) { + push @found, { + version => $1, + version_o => version::->parse($1), + distfile => $2, + }; + } + } + + my $match; + for my $try (sort { $b->{version_o} <=> $a->{version_o} } @found) { + if ($reqs->accepts_module($mod => $try->{version_o})) { + $match = $try, last; + } + } + + if ($match) { + my $file = $match->{distfile}; $file =~ s{^./../}{}; # strip leading return { package => $mod, - version => $meta->{version}, + version => $match->{version}, uri => "cpan:///distfile/$file", }; } + } else { + 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; @@ -76,6 +113,9 @@ sub search_authors { return }; # not supported $index = CPAN::Common::Index::MetaDB->new; + $index->search_packages({ package => "Moose" }); + $index->search_packages({ package => "Moose", version_range => ">= 2.0" }); + =head1 DESCRIPTION This module implements a CPAN::Common::Index that searches for packages against diff --git a/t/metadb.t b/t/metadb.t index 7d418c3..cf68d6e 100644 --- a/t/metadb.t +++ b/t/metadb.t @@ -28,7 +28,7 @@ subtest "constructor tests" => sub { # uri specified new_ok( 'CPAN::Common::Index::MetaDB' => [ { uri => "http://example.com" } ], - "new with cache" + "new with uri" ); }; @@ -47,6 +47,28 @@ subtest 'find package' => sub { }; +subtest 'find package with fixed version' => sub { + my $index = new_ok("CPAN::Common::Index::MetaDB"); + + my $got = $index->search_packages( { package => 'Moose', version => '2.1404' } ); + ok( $got, "found package" ); + is( $got->{version}, 2.1404, "has a version" ); + is( + $got->{uri}, + "cpan:///distfile/ETHER/Moose-2.1404.tar.gz", + "uri is OK" + ); + +}; + +subtest 'find package with version range' => sub { + my $index = new_ok("CPAN::Common::Index::MetaDB"); + + my $got = $index->search_packages( { package => 'Moose', version_range => '< 2.14' } ); + ok( $got, "found package" ); + ok( $got->{version} < 2.14, "has a version" ); +}; + done_testing; # COPYRIGHT # vim: ts=4 sts=4 sw=4 et: