view release on metacpan or  search on metacpan

lib/CPAN/Testers/ParseReport.pm  view on Meta::CPAN

our $default_cturl = "https://www.cpantesters.org/show";
our $Signal = 0;

=encoding utf-8

=head1 NAME

CPAN::Testers::ParseReport - parse reports to www.cpantesters.org from various sources

=cut

use version; our $VERSION = qv('0.5.0');

=head1 SYNOPSIS

The documentation in here is normally not needed because the code is
meant to be run from the standalone program C<ctgetreports>.

  ctgetreports --q mod:Moose Devel-Events

=head1 DESCRIPTION

This is the core module for CPAN::Testers::ParseReport. If you're not
looking to extend or alter the behaviour of this module, you probably
want to look at L<ctgetreports> instead.

=head1 OPTIONS

Options are described in the L<ctgetreports> manpage and are passed
through to the functions unaltered.

=head1 FUNCTIONS

=head2 parse_distro($distro,%options)

reads the cpantesters JSON file or the local database for the distro
and loops through the reports for the specified or most recent version
of that distro found in these data.

parse_distro() intentionally has no meaningful return value, different
options would require different ones.

=head2 $extract = parse_single_report($report,$dumpvars,%options)

mirrors and reads this report. $report is of the form

  { id => <integer>, guid => <guid>, }

$dumpvar is a hashreference that gets filled with data.

$extract is the result of parse_report() described below.

=cut

{
    my $ua;
    sub _ua {
        return $ua if $ua;
        $ua = LWP::UserAgent->new
            (
             keep_alive => 1,
             env_proxy => 1,
             timeout => 900,
            );
        $ua->parse_head(0);
        $ua;
    }
}
{
    my $ua;
    sub _ua_gzip {
        return $ua if $ua;
        $ua = LWP::UserAgent->new
            (
             keep_alive => 1,
             env_proxy => 1,
            );
        $ua->parse_head(0);
        $ua->default_header('Accept-Encoding' => scalar HTTP::Message::decodable());
        $ua;
    }
}

{
    # we called it yaml because it was yaml; now it is json
    use JSON::XS;
    my $j = JSON::XS->new->ascii->pretty;
    sub _slurp {
        my($file) = @_;
        local $/;
        open my $fh, $file or die "Could not open '$file': $!";
        <$fh>;
    }
    sub _yaml_loadfile {
        my $file = shift;
        my $content = _slurp $file;
        $DB::single = 1;
        if ($file =~ /\.ndjson$/) {
            $content =~ s/}$/},/gm;
            $content =~ s/,\s*\z//;
            $content =~ s/^/\[/s;
            $content =~ s/\z/\]/s;
        }
        $j->decode($content);
    }
    sub _yaml_dump {
        $j->encode(shift);
    }
}

sub _download_overview {
    my($cts_dir, $distro, %Opt) = @_;
    my $cturl = $Opt{cturl} ||= $default_cturl;
    $Opt{distrotransport} ||= $default_distrotransport;
    my $extension = $Opt{distrotransport} eq "ndjson" ? "ndjson" : "json";
    my $ctarget = "$cts_dir/$distro.$extension";
    my $cheaders = "$cts_dir/$distro.headers";
    if ($Opt{local}) {
        unless (-e $ctarget) {
            die "Alert: No local file '$ctarget' found, cannot continue\n";
        }
    } else {
        if (0) {
        } elsif ($Opt{distrotransport} eq "ctjson") {
            if (! -e $ctarget or -M $ctarget > .25) {
                if (-e $ctarget && $Opt{verbose}) {
                    my(@stat) = stat _;
                    my $timestamp = gmtime $stat[9];
                    print STDERR "(timestamp $timestamp GMT)\n" unless $Opt{quiet};
                }
                print STDERR "Fetching $ctarget..." if $Opt{verbose} && !$Opt{quiet};
                my $uri = "$cturl/$distro.json";
                my $resp = _ua->mirror($uri,$ctarget); # should most probably be _ua_gip, but then we need to deal with uncompressing
                if ($resp->is_success) {
                    print STDERR "DONE\n" if $Opt{verbose} && !$Opt{quiet};