Skip to content

Commit

Permalink
Merge pull request #37 from metacpan/mickey/cpan_testers_api
Browse files Browse the repository at this point in the history
Added cpan_testers_api script
mickeyn authored Sep 30, 2024

Verified

This commit was signed with the committer’s verified signature.
W-Mai Benign X
2 parents 3f6c611 + 7650cf6 commit 6f88b6e
Showing 2 changed files with 114 additions and 1 deletion.
2 changes: 1 addition & 1 deletion bin/cpan_testers.pl
Original file line number Diff line number Diff line change
@@ -114,7 +114,7 @@
}

# maybe use Data::Compare instead
for my $condition ( qw< fail pass na unknown > ) {
for my $condition (qw< fail pass na unknown >) {
last if $insert_ok;
if ( ( $tester_results->{$condition} || 0 )
!= $row_from_db->{$condition} )
113 changes: 113 additions & 0 deletions bin/cpan_testers_api.pl
Original file line number Diff line number Diff line change
@@ -0,0 +1,113 @@
use strict;
use warnings;
use v5.36;

use Cpanel::JSON::XS qw< decode_json >;
use Getopt::Long;

use MetaCPAN::Logger qw< :log :dlog >;

use MetaCPAN::ES;
use MetaCPAN::Ingest qw<
home
ua
>;

# args
my ();
GetOptions();

# setup
my $home = home();

my $url
= $ENV{HARNESS_ACTIVE}
? 'file:' . $home->child('t/var/cpantesters-release-api-fake.json')
: 'http://api-3.cpantesters.org/v3/release';

my $ua = ua();

my $es = MetaCPAN::ES->new( type => "release" );
my $bulk = $es->bulk();

log_info { 'Fetching ' . $url };

my $res;
eval { $res = $ua->get($url) };
exit(1) unless $res and $res->code == 200;

my $json = $res->decoded_content;
my $data = decode_json $json;

my $scroll = $es->scroll(
body => {
sort => '_doc',
},
);

# Create a cache of all releases (dist + version combos)
my %releases;

while ( my $release = $scroll->next ) {
my $data = $release->{_source};

# XXX temporary hack. This may be masking issues with release
# versions. (Olaf)
my $version = $data->{version};
$version =~ s{\Av}{} if $version;
$releases{ join( '-', grep {defined} $data->{distribution}, $version ) }
= $data;
}

for my $row (@$data) {

# The testers db seems to return q{} where we would expect
# a version of 0.
my $version = $row->{version} || 0;

# weblint++ gets a name of 'weblint' and a version of '++-1.15'
# from the testers db. Special case it for now. Maybe try and
# get the db fixed.

$version =~ s{\+}{}g;
$version =~ s{\A-}{};

my $release = join( '-', $row->{dist}, $version );
my $release_doc = $releases{$release};

# there's a cpantesters dist we haven't indexed
next unless $release_doc;

# Check if we need to update this data
my $insert_ok = 0;
my $tester_results = $release_doc->{tests};
if ( !$tester_results ) {
$tester_results = {};
$insert_ok = 1;
}

# maybe use Data::Compare instead
for my $condition (qw(fail pass na unknown)) {
last if $insert_ok;
if ( ( $tester_results->{$condition} || 0 ) != $row->{$condition} ) {
$insert_ok = 1;
}
}

next unless $insert_ok;

my %tests = map { $_ => $row->{$_} } qw(fail pass na unknown);
$bulk->update( {
doc => { tests => \%tests },
doc_as_upsert => 1,
id => $release_doc->{id},
} );
}

$bulk->flush;
$es->index_refresh;

log_info {'done'};

1;

0 comments on commit 6f88b6e

Please sign in to comment.