Skip to content

Commit bb96e1a

Browse files
oaldersoalders
authored
Merge pull request #765 from metacpan/preaction/cpantesters-api
add script to read data from cpantesters api
2 parents b967764 + f36e0bb commit bb96e1a

File tree

4 files changed

+205
-13
lines changed

4 files changed

+205
-13
lines changed

‎bin/cpantesters_api_file_for_testing

Lines changed: 59 additions & 0 deletions
Original file line numberDiff line numberDiff line change
@@ -0,0 +1,59 @@
1+
#!/bin/bash
2+
3+
cd `dirname "$0"`
4+
cd ..
5+
6+
url=http://api.cpantesters.org/v3/release
7+
in=t/var/tmp/cpantesters-release-api.json
8+
out=t/var/cpantesters-release-api-fake.json
9+
10+
download_original () {
11+
test -s "$in" || wget -O "$in" "$url"
12+
}
13+
14+
append_json () {
15+
perl -MJSON::PP -e'
16+
$file = shift;
17+
$all = -e $file ? decode_json(
18+
do { local $/; open $fh, "<", $file; <$fh> }
19+
) : [];
20+
$add = decode_json( join "", <STDIN> );
21+
push @$all, $add;
22+
open $fh, ">", $file;
23+
print { $fh } encode_json( $all ) ' $out
24+
}
25+
26+
collect_dist () {
27+
local dist="$1" version="$2"
28+
jq '.[] | select( .dist == $dist and .version == $version )' \
29+
--arg dist "$dist" --arg version "$version" $in \
30+
| append_json
31+
}
32+
33+
fake_dist () {
34+
echo "{ \"dist\": \"$1\", \"version\": \"$2\", \"pass\": $3, \"fail\": $4, \
35+
\"na\": $5, \"unknown\": $6 }" | append_json;
36+
}
37+
38+
populate_file () {
39+
rm -f "$out"
40+
41+
# Get test cases from real data.
42+
collect_dist 'Devel-GoFaster' '0.000'
43+
collect_dist 'P' '1.0.20'
44+
collect_dist 'IPsonar' '0.29'
45+
collect_dist 'weblint' '++-1.15'
46+
collect_dist 'WWW-Tumblr' ''
47+
48+
# Add records for our fake dists.
49+
fake_dist 'Some' '1.00-TRIAL' 4 3 2 1
50+
}
51+
52+
if [ !-x $( which jq ) ]; then
53+
echo "ERROR: jq(1) required for this script"
54+
exit 1
55+
fi
56+
57+
download_original
58+
populate_file
59+

‎lib/MetaCPAN/Script/CPANTestersAPI.pm

Lines changed: 132 additions & 0 deletions
Original file line numberDiff line numberDiff line change
@@ -0,0 +1,132 @@
1+
package MetaCPAN::Script::CPANTestersAPI;
2+
3+
use strict;
4+
use warnings;
5+
6+
use Log::Contextual qw( :log :dlog );
7+
use Cpanel::JSON::XS qw( decode_json );
8+
use MetaCPAN::Types qw( Uri );
9+
use Moose;
10+
11+
with 'MetaCPAN::Role::Script', 'MooseX::Getopt::Dashes';
12+
13+
has url => (
14+
is => 'ro',
15+
isa => Uri,
16+
coerce => 1,
17+
lazy => 1,
18+
builder => '_build_url',
19+
);
20+
21+
sub _build_url {
22+
my ($self) = @_;
23+
$ENV{HARNESS_ACTIVE}
24+
? 'file:'
25+
. $self->home->file('t/var/cpantesters-release-api-fake.json')
26+
: 'http://api.cpantesters.org/v3/release';
27+
}
28+
29+
has _bulk => (
30+
is => 'ro',
31+
isa => 'Search::Elasticsearch::Bulk',
32+
lazy => 1,
33+
default => sub {
34+
$_[0]->es->bulk_helper(
35+
index => $_[0]->index->name,
36+
type => 'release'
37+
);
38+
},
39+
);
40+
41+
sub run {
42+
my $self = shift;
43+
$self->index_reports;
44+
$self->index->refresh;
45+
}
46+
47+
sub index_reports {
48+
my $self = shift;
49+
50+
my $es = $self->es;
51+
52+
log_info { 'Fetching ' . $self->url };
53+
my $res = $self->ua->get( $self->url );
54+
my $json = $res->decoded_content;
55+
my $data = decode_json $json;
56+
57+
my $scroll = $es->scroll_helper(
58+
index => $self->index->name,
59+
search_type => 'scan',
60+
size => '500',
61+
type => 'release',
62+
);
63+
64+
# Create a cache of all releases (dist + version combos)
65+
my %releases;
66+
while ( my $release = $scroll->next ) {
67+
my $data = $release->{_source};
68+
69+
# XXX temporary hack. This may be masking issues with release
70+
# versions. (Olaf)
71+
my $version = $data->{version};
72+
$version =~ s{\Av}{} if $version;
73+
74+
$releases{
75+
join( '-', grep {defined} $data->{distribution}, $version )
76+
} = $data;
77+
}
78+
79+
for my $row (@$data) {
80+
81+
# The testers db seems to return q{} where we would expect
82+
# a version of 0.
83+
my $version = $row->{version} || 0;
84+
85+
# weblint++ gets a name of 'weblint' and a version of '++-1.15'
86+
# from the testers db. Special case it for now. Maybe try and
87+
# get the db fixed.
88+
89+
$version =~ s{\+}{}g;
90+
$version =~ s{\A-}{};
91+
92+
my $release = join( '-', $row->{dist}, $version );
93+
my $release_doc = $releases{$release};
94+
95+
# there's a cpantesters dist we haven't indexed
96+
next unless $release_doc;
97+
98+
# Check if we need to update this data
99+
my $insert_ok = 0;
100+
my $tester_results = $release_doc->{tests};
101+
if ( !$tester_results ) {
102+
$tester_results = {};
103+
$insert_ok = 1;
104+
}
105+
106+
# maybe use Data::Compare instead
107+
for my $condition (qw(fail pass na unknown)) {
108+
last if $insert_ok;
109+
if (
110+
( $tester_results->{$condition} || 0 ) != $row->{$condition} )
111+
{
112+
$insert_ok = 1;
113+
}
114+
}
115+
116+
next unless $insert_ok;
117+
118+
my %tests = map { $_ => $row->{$_} } qw(fail pass na unknown);
119+
$self->_bulk->update(
120+
{
121+
doc => { tests => \%tests },
122+
doc_as_upsert => 1,
123+
id => $release_doc->{id},
124+
}
125+
);
126+
}
127+
128+
$self->_bulk->flush;
129+
log_info {'done'};
130+
}
131+
132+
1;

‎t/lib/MetaCPAN/TestServer.pm

Lines changed: 13 additions & 13 deletions
Original file line numberDiff line numberDiff line change
@@ -2,17 +2,17 @@ package MetaCPAN::TestServer;
22

33
use MetaCPAN::Moose;
44

5-
use MetaCPAN::DarkPAN ();
6-
use MetaCPAN::Script::Author ();
7-
use MetaCPAN::Script::CPANTesters ();
8-
use MetaCPAN::Script::First ();
9-
use MetaCPAN::Script::Latest ();
10-
use MetaCPAN::Script::Mapping ();
11-
use MetaCPAN::Script::Mirrors ();
12-
use MetaCPAN::Script::Package ();
13-
use MetaCPAN::Script::Permission ();
14-
use MetaCPAN::Script::Release ();
15-
use MetaCPAN::Server ();
5+
use MetaCPAN::DarkPAN ();
6+
use MetaCPAN::Script::Author ();
7+
use MetaCPAN::Script::CPANTestersAPI ();
8+
use MetaCPAN::Script::First ();
9+
use MetaCPAN::Script::Latest ();
10+
use MetaCPAN::Script::Mapping ();
11+
use MetaCPAN::Script::Mirrors ();
12+
use MetaCPAN::Script::Package ();
13+
use MetaCPAN::Script::Permission ();
14+
use MetaCPAN::Script::Release ();
15+
use MetaCPAN::Server ();
1616
use MetaCPAN::TestHelpers qw( fakecpan_dir );
1717
use MetaCPAN::Types qw( Dir HashRef Str );
1818
use Search::Elasticsearch;
@@ -209,9 +209,9 @@ sub index_authors {
209209
sub index_cpantesters {
210210
my $self = shift;
211211

212-
local @ARGV = ( 'cpantesters', '--force-refresh' );
212+
local @ARGV = ('cpantestersapi');
213213
ok(
214-
MetaCPAN::Script::CPANTesters->new_with_options( $self->_config )
214+
MetaCPAN::Script::CPANTestersAPI->new_with_options( $self->_config )
215215
->run,
216216
'index cpantesters'
217217
);

‎t/var/cpantesters-release-api-fake.json

Lines changed: 1 addition & 0 deletions
Original file line numberDiff line numberDiff line change
@@ -0,0 +1 @@
1+
[{"fail":0,"na":0,"dist":"Devel-GoFaster","unknown":38,"version":"0.000","pass":468},{"version":"1.0.20","pass":194,"unknown":0,"dist":"P","na":9,"fail":14},{"unknown":0,"pass":267,"version":"0.29","na":8,"fail":5,"dist":"IPsonar"},{"fail":0,"na":0,"dist":"weblint","unknown":0,"version":"++-1.15","pass":26},{"dist":"WWW-Tumblr","na":1,"fail":0,"pass":0,"version":"","unknown":22},{"dist":"Some","fail":3,"na":2,"version":"1.00-TRIAL","pass":4,"unknown":1}]

0 commit comments

Comments
 (0)