view release on metacpan or  search on metacpan

lib/App/cpm/Resolver/MetaDB.pm  view on Meta::CPAN

package App::cpm::Resolver::MetaDB;
use v5.24;
use warnings;
use experimental qw(lexical_subs signatures);

use App::cpm::DistNotation;
use App::cpm::Util 'uniq';
use App::cpm::version;
use CPAN::Meta::YAML;

sub new ($class, $ctx, %argv) {
    my $uri = $argv{uri} || "https://cpanmetadb.plackperl.org/v1.0/";
    my $mirror = $argv{mirror} || "https://cpan.metacpan.org/";
    s{/*$}{/} for $uri, $mirror;
    bless {
        %argv,
        uri => $uri,
        mirror => $mirror,
    }, $class;
}

sub _get ($self, $ctx, $uri) {
    my $res;
    for (1..2) {
        $res = $ctx->{http}->get($uri);
        last if $res->{success} or $res->{status} == 404;
    }
    $res;
}

sub resolve ($self, $ctx, $task) {
    if (defined $task->{version_range} and $task->{version_range} =~ /(?:<|!=|==)/) {
        my $uri = "$self->{uri}history/$task->{package}";
        my $res = $self->_get($ctx, $uri);
        if (!$res->{success}) {
            my $error = "$res->{status} $res->{reason}, $uri";
            $error .= ", $res->{content}" if $res->{status} == 599;
            return { error => $error };
        }

        my @found;
        for my $line ( split /\r?\n/, $res->{content} ) {
            if ($line =~ /^$task->{package}\s+(\S+)\s+(\S+)$/) {
                push @found, {
                    version => $1,
                    version_o => App::cpm::version->parse($1),
                    distfile => $2,
                };
            }
        }

        @found = reverse @found;

        my $match;
        for my $try (sort { $b->{version_o} <=> $a->{version_o} } @found) {
            if ($try->{version_o}->satisfy($task->{version_range})) {
                $match = $try, last;
            }
        }

        if ($match) {
            my $dist = App::cpm::DistNotation->new_from_dist($match->{distfile});
            return {
                source => "cpan",
                package => $task->{package},
                version => $match->{version},
                uri => $dist->cpan_uri($self->{mirror}),
                distfile => $dist->distfile,
            };
        } else {
            return { error => "found versions @{[join ',', uniq map $_->{version}, @found]}, but they do not satisfy $task->{version_range}, $uri" };
        }
    } else {
        my $uri = "$self->{uri}package/$task->{package}";
        my $res = $self->_get($ctx, $uri);
        if (!$res->{success}) {
            my $error = "$res->{status} $res->{reason}, $uri";
            $error .= ", $res->{content}" if $res->{status} == 599;
            return { error => $error };
        }

        my $yaml = CPAN::Meta::YAML->read_string($res->{content});
        my $meta = $yaml->[0];
        if (!App::cpm::version->parse($meta->{version})->satisfy($task->{version_range})) {
            return { error => "found version $meta->{version}, but it does not satisfy $task->{version_range}, $uri" };
        }