view release on metacpan or  search on metacpan

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

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

  { guid => <guid>, }

$dumpvar is a hashreference that gets filled with data.

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

=cut

# A mapping of v3 API osname to a user-friendly label for the OS
# to use in reporting.
# TODO: This should probably be done by the API instead of here...
my %OSNAME = (
    aix => 'AIX',
    bsdos => 'BSD/OS',
    cygwin => "Windows (Cygwin)",
    darwin => "Mac OS X",
    dec_osf => "Tru64",
    dragonfly => "Dragonfly BSD",
    freebsd => "FreeBSD",
    gnu => "GNU Hurd",
    haiku => "Haiku",
    hpux => "HP-UX",
    irix => "IRIX",
    linux => "GNU/Linux",
    macos => "Mac OS classic",
    midnightbsd => "MidnightBSD",
    mirbsd => "MirOS BSD",
    mswin32 => "Windows (Win32)",
    netbsd => "NetBSD",
    openbsd => "OpenBSD",
    os2 => "OS/2",
    os390 => "OS390/zOS",
    gnukfreebsd => "Debian GNU/kFreeBSD",
    sco => "SCO",
    solaris => "SunOS/Solaris",
    vms => "VMS",
    beos => "BeOS",
    interix => "Interix",
    nto => "QNX Neutrino",
    minix => "MINIX",
    bitrig => "BITRIG",
    Mac => "MAC",
);

{
    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
    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};
                }
                my $uri = "$cturl/v3/summary/$distro";
                print STDERR "Fetching $ctarget ($uri)...\n" if $Opt{verbose} && !$Opt{quiet};
                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};
                    open my $fh, ">", $cheaders or die;