view release on metacpan or  search on metacpan

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

package App::RetroPAN;
# vim:ts=4:shiftwidth=4:expandtab

use strict;
use warnings;
use utf8;

=encoding utf8

=head1 NAME

App::RetroPAN - Makes a historic minicpan ⏳

=head1 SYNOPSIS

  use App::RetroCPAN;

  my ($author, $dist_name, $url) = find_module_on_date("2011-01-01T00:00:00", "Moose");

=head1 DESCRIPTION

Uses the MetaCPAN API to find releases made prior to a given date to
satisfy your modules' dependencies.

=head1 SEE ALSO

=over

=item *

L<retropan>

=item *

L<OrePAN2>

=back

=head1 LICENSE

This library is free software; you can redistribute it and/or modify it under the same terms as Perl itself.

=head1 AUTHOR

Dave Lambley <dlambley@cpan.org>

=cut

use HTTP::Request;
use LWP::UserAgent;
use List::MoreUtils qw/ uniq /;
use Module::CoreList;
use OrePAN2::Injector;
use OrePAN2::Indexer;

use Cpanel::JSON::XS qw/ encode_json decode_json /;

our $VERSION = '0.03';

my $ua = LWP::UserAgent->new( keep_alive => 2, agent => "retropan/$VERSION" );

sub find_module_dependencies {
    my ($au, $dist) = @_;

    my $q = {
        "size" => 1,
        "query" => {
            "bool" => {
                "filter" => [
                    {
                        "match" => {
                            "name" => $dist,
                        }
                    },
                    {
                        "match" => {
                            "author" => $au,
                        }
                    },

                ],
            }
        }
    };

    my $req = HTTP::Request->new( POST => 'https://fastapi.metacpan.org/v1/release/_search', [
        "Content-Type" => "text/json",
        "Accept" => "text/json"
    ], encode_json($q) );

    my $res = $ua->request($req);
    die $res->status_line if !$res->is_success;
    my $data = decode_json($res->decoded_content);
    my $hit = $data->{hits}->{hits}->[0];
    if (!defined $hit) {
        warn "could not find $au/$dist";
        return;
    }

    my @deps =
        grep { !Module::CoreList::is_core($_) }
        grep { $_ ne "perl" }
        map { $_->{module} } @{ $hit->{_source}->{dependency} };

    return @deps;
}
sub find_module_on_date {
    my ($module, $before) = @_;

    return if Module::CoreList::is_core($module);

    # We prefer authorized modules, but can fall back to unauthorized if none
    # available.
    my $q = {
        "size" => 30, # TODO, keep search open.
        "sort" => [