Skip to content
Merged
Show file tree
Hide file tree
Changes from all commits
Commits
File filter

Filter by extension

Filter by extension

Conversations
Failed to load comments.
Loading
Jump to
Jump to file
Failed to load files.
Loading
Diff view
Diff view
1 change: 1 addition & 0 deletions .gitignore
Original file line number Diff line number Diff line change
Expand Up @@ -9,6 +9,7 @@
/var
/t/var/tmp/
/t/var/darkpan/
/t/var/log/
/etc/metacpan_local.pl
metacpan_server_local.conf

Expand Down
9 changes: 8 additions & 1 deletion lib/MetaCPAN/Document/Distribution.pm
Original file line number Diff line number Diff line change
Expand Up @@ -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',
Expand All @@ -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")
Expand Down
3 changes: 2 additions & 1 deletion lib/MetaCPAN/Role/Logger.pm
Original file line number Diff line number Diff line change
Expand Up @@ -49,7 +49,8 @@ sub set_logger_once {
# XXX This doesn't belong here.
sub _build_logger {
my ($config) = @_;
my $log = Log::Log4perl->get_logger( $ARGV[0] );
my $log = Log::Log4perl->get_logger( $ARGV[0]
|| 'this_would_have_been_argv_0_but_there_is_no_such_thing' );
foreach my $c (@$config) {
my $layout = Log::Log4perl::Layout::PatternLayout->new( $c->{layout}
|| qq{%d %p{1} %c: %m{chomp}%n} );
Expand Down
3 changes: 2 additions & 1 deletion lib/MetaCPAN/Role/Script.pm
Original file line number Diff line number Diff line change
Expand Up @@ -9,6 +9,7 @@ use Log::Contextual qw( :log :dlog );
use MetaCPAN::Model;
use MetaCPAN::Types qw(:all);
use Moose::Role;
use Carp ();

has 'cpan' => (
is => 'ro',
Expand Down Expand Up @@ -74,7 +75,7 @@ sub handle_error {
log_fatal {$error};

# Die if configured (for the test suite).
die $error if $self->die_on_error;
Carp::croak $error if $self->die_on_error;
}

sub index {
Expand Down
80 changes: 80 additions & 0 deletions lib/MetaCPAN/Script/River.pm
Original file line number Diff line number Diff line change
@@ -0,0 +1,80 @@
package MetaCPAN::Script::River;

use Moose;
use namespace::autoclean;

use JSON::MaybeXS qw( decode_json );
use Log::Contextual qw( :log :dlog );
use LWP::UserAgent;
use MetaCPAN::Types qw( ArrayRef Str Uri);

with 'MetaCPAN::Role::Script', 'MooseX::Getopt';

has river_url => (
is => 'ro',
isa => Uri,
coerce => 1,
required => 1,
default => 'https://neilb.org/FIXME',
);

has _ua => (
is => 'ro',
isa => 'LWP::UserAgent',
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->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

4 changes: 4 additions & 0 deletions lib/MetaCPAN/Types/Internal.pm
Original file line number Diff line number Diff line change
Expand Up @@ -26,6 +26,7 @@ use MooseX::Types -declare => [
PerlMongers
Tests
BugSummary
RiverSummary
)
];

Expand Down Expand Up @@ -104,6 +105,9 @@ subtype BugSummary,
source => Str
];

subtype RiverSummary,
as Dict [ ( map { $_ => Optional [Int] } qw(total immediate bucket) ), ];

subtype Resources,
as Dict [
license => Optional [ ArrayRef [Str] ],
Expand Down
61 changes: 61 additions & 0 deletions t/script/river.t
Original file line number Diff line number Diff line change
@@ -0,0 +1,61 @@
use strict;
use warnings;

use lib 't/lib';

use Git::Helpers qw( checkout_root );
use MetaCPAN::Script::River;
use MetaCPAN::Script::Runner;
use MetaCPAN::Server::Test;
use MetaCPAN::TestHelpers;
use Test::More;
use URI;

my $config = MetaCPAN::Script::Runner::build_config;

# local json file with structure from https://github.com/CPAN-API/cpan-api/issues/460
my $root = checkout_root();
my $file = URI->new('t/var/river.json')->abs("file://$root/");
$config->{'river_url'} = "$file";

my $river = MetaCPAN::Script::River->new_with_options($config);
ok $river->run, 'runs and returns true';

my %expect = (
'System-Command' => {
total => 92,
immediate => 4,
bucket => 2,
},
'Text-Markdown' => {
total => 92,
immediate => 56,
bucket => 2,
}
);

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();
14 changes: 14 additions & 0 deletions t/var/river.json
Original file line number Diff line number Diff line change
@@ -0,0 +1,14 @@
[
{
"dist": "System-Command",
"total": 92,
"immediate": 4,
"bucket": 2
},
{
"dist": "Text-Markdown",
"total": 92,
"immediate": 56,
"bucket": 2
}
]