File Coverage

blib/lib/CPAN/Perl/Releases/MetaCPAN.pm

Criterion	Covered	Total	%
statement	17	96	17.7
branch	0	24	0.0
condition	0	5	0.0
subroutine	6	12	50.0
pod	0	5	0.0
total	23	142	16.2

package CPAN::Perl::Releases::MetaCPAN v1.0.0;
use v5.24;
use warnings;
use experimental qw(lexical_subs signatures);

our $TRIAL = 0;

use JSON::PP ();
use HTTP::Tinyish;

use Exporter 'import';
our @EXPORT_OK = qw(perl_tarballs perl_versions perl_pumpkins);

sub new ($class, %option) {
    my $uri = $option{uri} || "https://fastapi.metacpan.org/v1/release";
    $uri =~ s{/$}{};
    my $cache = exists $option{cache} ? $option{cache} : 1;
    my $http = HTTP::Tinyish->new(verify_SSL => 1, agent => __PACKAGE__ . "/" . __PACKAGE__->VERSION);
    my $json = JSON::PP->new->canonical(1);
    bless { uri => $uri, http => $http, cache => $cache, json => $json }, $class;
}

sub get ($self) {
    return $self->{_releases} if $self->{cache} and $self->{_releases};

    my @release;
    my $from = 0;
    my $total;
    my $uri = "$self->{uri}/_search";
    for (1..5) {
        # https://github.com/metacpan/metacpan-web/blob/master/lib/MetaCPAN/Web/Model/API/Release.pm
        # https://github.com/metacpan/metacpan-api/blob/master/lib/MetaCPAN/Document/Release/Set.pm
        my $query = {
            query => {
                bool => {
                    must => [
                        { term => { distribution => "perl" } },
                        { term => { authorized => JSON::PP::true } },
                    ],
                },
            },
            size => 1000,
            from => $from,
            sort => [ { date => 'desc' } ],
            fields => [qw( name date author version status maturity download_url checksum_sha256 )],
        };
        my $res = $self->{http}->post($uri, {
            content => $self->{json}->encode($query),
            headers => { 'content-type' => 'application/json' },
        });
        if (!$res->{success}) {
            my $message = $res->{status} == 599 ? ", $res->{content}" : "";
            chomp $message;
            $message =~ s/\n/ /g;
            die "$res->{status} $res->{reason}, $uri$message\n";
        }
        my $hash = $self->{json}->decode($res->{content});
        $total = ref $hash->{hits}{total} ? $hash->{hits}{total}{value} : $hash->{hits}{total} unless defined $total;
        push @release, map { $_->{fields} } @{$hash->{hits}{hits}};
        last if $total <= @release;
        $from = @release;
    }
    if ($total != @release) {
        die sprintf "metacpan returns %d perl releases, but expected %d\n",
            (scalar @release), $total;
    }
    $self->{_releases} = \@release if $self->{cache};
    \@release;
}

sub _self (@args) {
    my $self = eval { $args[0]->isa(__PACKAGE__) } ? shift @args : __PACKAGE__->new;
    wantarray ? ($self, @args) : $self;
}

sub perl_tarballs (@args) {
    my ($self, $arg) = _self(@args);
    my $releases = $self->get;
    my %tarballs =
        map {
            my $url = $_->{download_url};
            $url =~ s{.*authors/id/}{};
            if ($url =~ /\.(tar\.\S+)$/) {
                ($1, $url);
            } else {
                ();
            }
        }
        grep { my $name = $_->{name}; $name =~ s/^perl-?//; $name eq $arg }
        grep { $_->{status} =~ /^(?:cpan|latest)$/ }
        $releases->@*;
    \%tarballs;
}

sub perl_versions (@args) {
    my $self = _self(@args);
    my $releases = $self->get;
    my @versions =
        map { my $name = $_->{name}; $name =~ s/^perl-?//; $name }
        grep { $_->{status} =~ /^(?:cpan|latest)$/ }
        $releases->@*;
    @versions;
}

sub perl_pumpkins (@args) {
    my $self = _self(@args);
    my $releases = $self->get;
    my %author =
        map { $_->{author} => 1 }
        grep { $_->{status} =~ /^(?:cpan|latest)$/ }
        $releases->@*;
    sort keys %author;
}

1;
__END__