view release on metacpan or  search on metacpan

lib/Dist/Surveyor/Inquiry.pm  view on Meta::CPAN

=head1 NAME

Dist::Surveyor::Inquiry - Handling the meta-cpan API access for Dist::Surveyor

=head1 DESCRIPTION

There are a few things that needed to be known in this module:

=over

=item *

$metacpan_size - internally defined global to limit the maximum size of 
every API call

=item *

$metacpan_calls - internally defined global counting how many API call happen.

=item *

This module checks $::DEBUG and $::VERBOSE for obvious proposes.

=item *

For initating cache-on-disk, call Dist::Surveyor::Inquiry->perma_cache()
(this should be usually done, except in testing environment)

=back

=cut

# We have to limit the number of results when using MetaCPAN::API.
# We can'r make it too large as it hurts the server (it preallocates)
# but need to make it large enough for worst case distros (eg eBay-API).
# TODO: switching to the ElasticSearch module, with cursor support, will
# probably avoid the need for this. Else we could dynamically adjust.
our $metacpan_size = 2500;
our $metacpan_calls = 0;

our ($DEBUG, $VERBOSE);
*DEBUG = \$::DEBUG;
*VERBOSE = \$::VERBOSE;

require Exporter;
our @ISA = qw{Exporter};
our @EXPORT = qw{
    get_candidate_cpan_dist_releases
    get_candidate_cpan_dist_releases_fallback
    get_module_versions_in_release
    get_release_info
};

my $agent_string = "dist_surveyor/$VERSION";

my ($ua, $wget, $curl);
if (HTTP::Tiny->can_ssl) {
    $ua = HTTP::Tiny->new(
        agent => $agent_string,
        timeout => 10,
        keep_alive => 1, 
    );
} else { # for fatpacking support
    require File::Which;
    require IPC::System::Simple;
    $wget = File::Which::which('wget');
    $curl = File::Which::which('curl');
}

sub _https_request {
    my ($method, $url, $headers, $content) = @_;
    $headers ||= {};
    $method = uc($method || 'GET');
    if (defined $ua) {
        my %options;
        $options{headers} = $headers if %$headers;
        $options{content} = $content if defined $content;
        my $response = $ua->request($method, $url, \%options);
        unless ($response->{success}) {
            die "Transport error: $response->{content}\n" if $response->{status} == 599;
            die "HTTP error: $response->{status} $response->{reason}\n";
        }
        return $response->{content};
    } elsif (defined $wget) {
        my @args = ('-q', '-O', '-', '-U', $agent_string, '-T', 10, '--method', $method);
        push @args, '--header', "$_: $headers->{$_}" for keys %$headers;
        push @args, '--body-data', $content if defined $content;
        return IPC::System::Simple::capturex($wget, @args, $url);
    } elsif (defined $curl) {
        my @args = ('-s', '-S', '-L', '-A', $agent_string, '--connect-timeout', 10, '-X', $method);
        push @args, '-H', "$_: $headers->{$_}" for keys %$headers;
        push @args, '--data-raw', $content if defined $content;
        return IPC::System::Simple::capturex($curl, @args, $url);
    } else {
        die "None of IO::Socket::SSL, wget, or curl are available; cannot make HTTPS requests.";
    }
}

# caching via persistent memoize

my %memoize_cache;
my $locking_file;

=head1 CLASS METHODS

=head2 Dist::Surveyor::Inquiry->perma_cache()

Enable caching to disk of all the MetaCPAN API requests.
This cache can grew to be quite big - 40MB is one case, but it worth it,
as if you will need to run this program again, it will run much faster.

=cut

sub perma_cache {
    my $class = shift;
    my $db_generation = 3; # XXX increment on incompatible change
    my $pname = $FindBin::Script;
    $pname =~ s/\..*$//;
    my $memoize_file = "$pname-$db_generation.db";
    open $locking_file, ">", "$memoize_file.lock" 
        or die "Unable to open lock file: $!";