Added script which fetches and indexes river data

closes #460
metacpan · Apr 23, 2016 · bf9e0f8 · bf9e0f8
1 parent e6043f7
commit bf9e0f8
Show file tree

Hide file tree

Showing 4 changed files with 173 additions and 1 deletion.
diff --git a/lib/MetaCPAN/Document/Distribution.pm b/lib/MetaCPAN/Document/Distribution.pm
@@ -7,7 +7,7 @@ use namespace::autoclean;
 use Moose;
 use ElasticSearchX::Model::Document;
 
-use MetaCPAN::Types qw( ArrayRef BugSummary );
+use MetaCPAN::Types qw( ArrayRef BugSummary RiverSummary);
 
 has name => (
     is       => 'ro',
@@ -22,6 +22,13 @@ has bugs => (
     writer  => '_set_bugs',
 );
 
+has river => (
+    is      => 'ro',
+    isa     => RiverSummary,
+    dynamic => 1,
+    writer  => '_set_river',
+);
+
 sub releases {
     my $self = shift;
     return $self->index->type("release")

diff --git a/lib/MetaCPAN/Script/River.pm b/lib/MetaCPAN/Script/River.pm
@@ -0,0 +1,81 @@
+package MetaCPAN::Script::River;
+
+use strict;
+use warnings;
+use namespace::autoclean;
+
+use HTTP::Request::Common;
+use LWP::UserAgent;
+use Log::Contextual qw( :log :dlog );
+use Moose;
+use URI::Escape qw(uri_escape);
+use MetaCPAN::Types qw( ArrayRef Str );
+use JSON::MaybeXS qw( decode_json );
+
+with 'MetaCPAN::Role::Script', 'MooseX::Getopt';
+
+has river_url => (
+    is       => 'ro',
+    required => 1,
+    default  => 'https://neilb.org/FIXME',
+);
+
+has ua => (
+    is      => 'ro',
+    default => sub { LWP::UserAgent->new },
+);
+
+sub run {
+    my $self      = shift;
+    my $summaries = $self->retrieve_river_summaries;
+    $self->index_river_summaries($summaries);
+
+    return 1;
+}
+
+sub index_river_summaries {
+    my ( $self, $summaries ) = @_;
+    $self->index->refresh;
+    my $dists = $self->index->type('distribution');
+    my $bulk = $self->index->bulk( size => 300 );
+    for my $summary (@$summaries) {
+        my $dist = delete $summary->{dist};
+        my $doc  = $dists->get($dist);
+        $doc ||= $dists->new_document( { name => $dist } );
+        $doc->_set_river($summary);
+        $bulk->put($doc);
+    }
+    $bulk->commit;
+}
+
+sub retrieve_river_summaries {
+    my $self = shift;
+    my $resp = $self->ua->request( GET $self->river_url );
+
+    $self->handle_error( $resp->status_line ) unless $resp->is_success;
+
+    return decode_json $resp->content;
+}
+
+__PACKAGE__->meta->make_immutable;
+
+1;
+
+=pod
+
+=head1 SYNOPSIS
+
+ # bin/metacpan river
+
+=head1 DESCRIPTION
+
+Retrieves the CPAN river data from its source and
+updates our ES information.
+
+This can then be accessed here:
+
+http://api.metacpan.org/distribution/Moose
+http://api.metacpan.org/distribution/HTTP-BrowserDetect
+
+=cut
+
diff --git a/lib/MetaCPAN/Types/Internal.pm b/lib/MetaCPAN/Types/Internal.pm
@@ -27,6 +27,7 @@ use MooseX::Types -declare => [
         PerlMongers
         Tests
         BugSummary
+        RiverSummary
         )
 ];
 
@@ -105,6 +106,9 @@ subtype BugSummary,
     source => Str
     ];
 
+subtype RiverSummary,
+    as Dict [ ( map { $_ => Optional [Int] } qw(total immediate bucket) ), ];
+
 subtype Resources,
     as Dict [
     license => Optional [ ArrayRef [Str] ],

diff --git a/t/script/river.t b/t/script/river.t
@@ -0,0 +1,80 @@
+use strict;
+use warnings;
+
+use lib 't/lib';
+
+use MetaCPAN::Script::River;
+use MetaCPAN::Script::Runner;
+use MetaCPAN::Server::Test;
+use MetaCPAN::TestHelpers;
+use Test::More;
+
+my $config = MetaCPAN::Script::Runner::build_config;
+
+#local @ARGV = ( '--dir', $config->{cpan} );
+
+my $river = MetaCPAN::Script::River->new_with_options($config);
+
+# structure from https://github.com/CPAN-API/cpan-api/issues/460
+my @summaries = (
+    {
+        dist      => 'System-Command',
+        total     => 92,
+        immediate => 4,
+        bucket    => 2,
+    },
+    {
+        dist      => 'Text-Markdown',
+        total     => 92,
+        immediate => 56,
+        bucket    => 2,
+    }
+);
+my %expect = (
+    'System-Command' => {
+        total     => 92,
+        immediate => 4,
+        bucket    => 2,
+    },
+    'Text-Markdown' => {
+        total     => 92,
+        immediate => 56,
+        bucket    => 2,
+    }
+);
+
+# mock external service
+{
+    no warnings 'redefine';
+    *MetaCPAN::Script::River::retrieve_river_summaries = sub {
+        return \@summaries;
+    };
+}
+
+ok $river->run, 'runs and returns true';
+
+test_psgi app, sub {
+    my $cb = shift;
+    for my $dist ( keys %expect ) {
+        my $test = $expect{$dist};
+        subtest "Check $dist" => sub {
+            my $url = "/distribution/$dist";
+            ok( my $res = $cb->( GET $url), "GET $url" );
+
+            # TRAVIS 5.18
+            is( $res->code, 200, "code 200" );
+            is(
+                $res->header('content-type'),
+                'application/json; charset=utf-8',
+                'Content-type'
+            );
+            my $json = decode_json_ok($res);
+
+            # TRAVIS 5.18
+            is_deeply( $json->{river}, $test,
+                "$dist river summary roundtrip" );
+        };
+    }
+};
+
+done_testing();