view release on metacpan or  search on metacpan

lib/App/cpan2arch/GetMetadata.pm  view on Meta::CPAN

use v5.42.0;

use strict;
use warnings;
no source::encoding;  # Avoid dying on v5.42.0 (non-ASCII char in POD).

use Object::Pad 0.825;

package App::cpan2arch::GetMetadata;  # For toolchain compatibility.
role App::cpan2arch::GetMetadata;

use File::Spec::Functions qw< catdir splitdir >;
use Scalar::Util          qw< looks_like_number >;

our $VERSION = 'v1.1.2';

field %_endpoints :reader :writer = (
    module   => 'https://fastapi.metacpan.org/v1/module/',
    release  => 'https://fastapi.metacpan.org/v1/release/',
    download => 'https://fastapi.metacpan.org/v1/download_url/',
);
field $_mua_mcpan :reader;
field %_optionals :reader;
field %_meta      :reader :writer;

# Get CPAN metadata from MetaCPAN's API.
#
# References:
#   https://github.com/metacpan/metacpan-api/blob/master/docs/API-docs.md
method get_metadata ()
{
    $self->_psub;

    $self->_init_mua_mcpan;

    # Get the module/distribution and its release.
    my $dist;
    my $rel;
    {
        my %args    = $self->args;
        my $module  = $args{module};
        my $version = $args{version};
        my $mod;

        # Only request for a module if it does not look like a dist and no version
        # argument is passed, otherwise treat it as dist.
        if ( $module !~ /-/ && !defined $version ) {
            $mod = $self->_get_module($module);
            $self->_pdbg("found module\n\n") if defined $mod;
        }

        # Since modules and dists names can be ambiguous, e.g. Reply, do not exit
        # if a module request fails, but fallback as dist.
        $dist = defined $mod ? $mod->{distribution} : $module;

        $self->_pdbg("Dist\n");
        $self->_pdump( '$dist', \$dist, "\n" );

        $rel = $self->_get_release($dist);
        return 1 if $rel == 1;

        $self->_pdbg("Release\n");
        $self->_pdump( '$rel', \$rel, "\n" );
    }

    # Find Module::Install, license, and XS files in the dist.
    my $ret = $self->_find_files( $dist, $rel->{download_url} );
    return 1 if looks_like_number($ret) && $ret == 1;
    my %files = $ret->%*;

    # Get 'optionals_features' descriptions (will be added to the optdepends array).
    # See https://metacpan.org/pod/CPAN::Meta::Spec#optional_features.
    {
        foreach my ( $feature, $feat_info ) ( $rel->{metadata}{optional_features}->%* ) {

            foreach my ( $phase, $phase_info ) ( $feat_info->{prereqs}->%* ) {

lib/App/cpan2arch/GetMetadata.pm  view on Meta::CPAN

            }
        }
    };

    my %env  = $self->env;
    my %opts = $self->opts;
    my $mua;

    if ( defined $has_muac && defined $has_chi ) {
        require Mojo::Log;

        # Silence logger
        my $logger;
        $logger = Mojo::Log->new( path => '/dev/null' ) unless $env{debug};

        $mua = Mojo::UserAgent::Cached->new(
            $env{debug}
            ? ()
            : ( logger => $logger ),
        );

        # Use CHI as the cache backend.
        {
            my $path =
                $type eq 'mcpan'
              ? $env{cache_mcpan_path}
              : $env{cache_arch_path};

            my $chi;

            $chi = CHI->new(
                driver     => 'File',
                root_dir   => $path,
                expires_in => $env{cache_expiration},
            ) unless $env{cache_ignore};

            if ( defined $chi ) {
                $chi->clear
                  if defined $opts{clear}
                  || ( $type eq 'mcpan' && defined $opts{clear_mcpan} )
                  || ( $type eq 'arch'  && defined $opts{clear_arch} );
            }

            $mua->cache_agent($chi) unless $env{cache_ignore};
        }
    }
    else {
        $mua = Mojo::UserAgent->new;
    }

    $mua->transactor->name( $env{user_agent} ) if defined $mua;

    return $mua;
}

method _get_module ($module)
{
    $self->_psub;

    my $prog = $self->prog;
    my $url  = $_endpoints{module} . "$module?fields=distribution";
    my $json;

    my $res = do {
        try {
            my %env = $self->env;
            local $ENV{MUAC_NOCACHE} = true if $env{cache_ignore};

            $_mua_mcpan->get($url)->result;
        }
        catch ($e) {
            warn $e;
            undef;
        }
    };

    if ( defined $res && $res->is_success ) {
        $self->_pdbg("\n");
        $json = $res->json;
    }

    if ( !defined $json ) {
        warn "$prog: failed to fetch $module module\n";
        $self->_pdbg("\n");

        return undef;
    }

    return $json;
}

# References:
#   https://blogs.perl.org/users/neilb/2016/12/working-with-the-metacpan-api.html.
method _get_release ($dist)
{
    $self->_psub;

    my %args    = $self->args;
    my $version = $args{version};
    my $prog    = $self->prog;

    my $query = "distribution:$dist%20AND%20";
    $query
      .= defined $version
      ? "version:$version"
      : 'status:latest';

    my $url = $_endpoints{release} . "_search?q=$query";

    my $res = do {
        try {
            my %env = $self->env;
            local $ENV{MUAC_NOCACHE} = true if $env{cache_ignore};

            $_mua_mcpan->get($url)->result;
        }
        catch ($e) {
            warn $e;
            undef;
        }
    };

    my $json;
    my $rel;

    if ( defined $res && $res->is_success ) {
        $self->_pdbg("\n");

        $json = $res->json;
        $rel  = $json->{hits}{hits}[0]{_source}
          if defined $json && scalar $json->{hits}{hits}->@*;
    }

    if ( !defined $json || !defined $rel ) {
        warn "$prog: failed to fetch $dist dist release\n";
        return 1;
    }

    return $rel;
}

# Check if the distribution has some type of files (M::I, license, XS).
method _find_files ( $dist, $download_url )
{
    $self->_psub;

    require Path::Tiny;
    Path::Tiny->VERSION('0.150');

    require Archive::Tar;

    my $prog  = $self->prog;
    my %files = (
        mi                 => false,
        license            => false,
        has_multi_licenses => false,
        xs                 => false,
    );

    my $res = do {
        try {
            my %env = $self->env;
            local $ENV{MUAC_NOCACHE} = true if $env{cache_ignore};

            $_mua_mcpan->get($download_url)->result;
        }
        catch ($e) {
            warn $e;