view release on metacpan or  search on metacpan

lib/App/MetaCPANUtils.pm  view on Meta::CPAN

$SPEC{download_metacpan_release} = {
    v => 1.1,
    summary => 'Download a release to the current directory',
    description => <<'_',

Uses <pm:HTTP::Tiny::Plugin> so you can customize download behavior using
e.g. `HTTP_TINY_PLUGINS` environment variable.

_
    args => {
        distribution => {
            schema => 'perl::distname*',
            req => 1,
            pos => 0,
        },
        version => {
            summary => 'If unspecified, will select the latest release',
            schema => 'perl::module::release::version',
            pos => 1,
        },
        overwrite => {
            summary => 'Whether to overwrite existing downloaded file',
            schema => 'true*',
            cmdline_aliases => {O=>{}},
        },
        # XXX filename
    },
    examples => [
        {
            summary => 'Download latest release of App-orgadb distribution',
            argv => [qw/App-orgadb/],
            test => 0,
            'x.doc.show_result' => 0,
        },
        {
            summary => 'Download the second latest release of App-orgadb distribution',
            argv => [qw/App-orgadb latest-1/],
            test => 0,
            'x.doc.show_result' => 0,
        },
    ],
};
sub download_metacpan_release {
    my %args = @_;

    my $res = list_metacpan_releases(
        distribution => $args{distribution},
        fields => [qw/version date author download_url/],
    );
    return $res unless $res->[0] == 200;
    #use DD; dd $res;

    my $rels = [sort {version->parse($b->{version}) <=> version->parse($a->{version})} @{$res->[2]}];
    #use DD; dd $rels;

    require Module::Release::Select;
    my $rel = Module::Release::Select::select_release(
        {detail=>1}, $args{version}, $rels);
    #use DD; dd $rel;
    return [404, "Version $args{version} of distribution $args{distribution} not found in releases"] unless $rel;

    my $url = $rel->{download_url};
    (my $filename = $url) =~ s!.+/!!;
    return [412, "File '$filename' already exists, not overwriting (use -O to overwrite)"]
        if (-f $filename) && !$args{overwrite};

    open my $fh, ">", $filename
        or return [500, "Can't open $filename for writing: $!"];

    require HTTP::Tiny::Plugin;
    log_trace "Downloading %s ...", $url;
    my $dlres = HTTP::Tiny::Plugin->new->get($url);
    return [500, "Can't download $url: $dlres->{status} - $dlres->{reason}"]
        unless $dlres->{success};

    print $fh $dlres->{content};
    close $fh or return [500, "Can't write $filename: $!"];

    [200, "OK", undef, {
        'func.filename' => $filename,
        'func.url' => $url,
        'func.version' => $rel->{version},
    }];
}

$SPEC{diff_metacpan_releases} = {
    v => 1.1,
    summary => 'Diff two release tarballs',
    args => {
        distribution => {
            schema => 'perl::distname*',
            req => 1,
            pos => 0,
        },
        version1 => {
            schema => 'perl::module::release::version',
            req => 1,
            pos => 1,
        },
        version2 => {
            schema => 'perl::module::release::version',
            req => 1,
            pos => 2,
        },
    },
    examples => [
        {
            summary => 'What changed between App-orgadb 0.014 and 0.015?',
            argv => [qw/App-orgadb 0.014 0.015/],
            test => 0,
            'x.doc.show_result' => 0,
        },
        {
            summary => 'What changed in the latest version of App-orgadb?',
            argv => [qw/App-orgadb latest-1 latest/],
            test => 0,
            'x.doc.show_result' => 0,
        },
    ],
    'x.envs' => {