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
72 changes: 0 additions & 72 deletions lib/MetaCPAN/Document/File/Set.pm

This file was deleted.

69 changes: 69 additions & 0 deletions lib/MetaCPAN/Query/File.pm
Original file line number Diff line number Diff line change
Expand Up @@ -677,5 +677,74 @@ sub find_pod {
}
}

sub history {
my ( $self, $type, $name, $path, $opts ) = @_;

$opts ||= {};
if ( ref $path ) {
$path = join '/', @$path;
}

my $source = $opts->{fields};

my $query
= $type eq "module"
? {
nested => {
path => 'module',
query => {
constant_score => {
filter => {
bool => {
must => [
{ term => { "module.authorized" => true } },
{ term => { "module.indexed" => true } },
{ term => { "module.name" => $name } },
]
}
}
}
}
}
}
: $type eq "file" ? {
bool => {
must => [
{ term => { path => $path } },
{ term => { distribution => $name } },
]
}
}

# XXX: to fix: no filtering on 'release' so this query
# will produce modules matching duplications. -- Mickey
: $type eq "documentation" ? {
bool => {
must => [
{ match_phrase => { documentation => $name } },
{ term => { indexed => true } },
{ term => { authorized => true } },
]
}
}
: return undef;

my $res = $self->es->search(
es_doc_path('file'),
body => {
query => $query,
size => 500,
sort => [ { date => 'desc' } ],
( $source ? ( _source => $source ) : () ),
},
);

return {
took => $res->{took},
total => hit_total($res),
files => [ map $_->{_source}, @{ $res->{hits}{hits} } ],
};
}

__PACKAGE__->meta->make_immutable;
1;
8 changes: 5 additions & 3 deletions lib/MetaCPAN/Server/Controller/Search/History.pm
Original file line number Diff line number Diff line change
Expand Up @@ -12,9 +12,11 @@ with 'MetaCPAN::Server::Role::JSONP';
has '+type' => ( default => 'file' );

sub get : Local : Path('') : Args {
my ( $self, $c, @args ) = @_;
my $data = $self->model($c)->history(@args)->raw;
$c->stash( $data->all );
my ( $self, $c, $type, $name, @path ) = @_;
my $fields = $c->res->fields;
my $data = $c->model('ESQuery')
->file->history( $type, $name, \@path, { fields => $fields } );
$c->stash($data);
}

1;
32 changes: 26 additions & 6 deletions t/lib/MetaCPAN/Server/Test.pm
Original file line number Diff line number Diff line change
Expand Up @@ -4,18 +4,20 @@ use strict;
use warnings;
use feature qw(state);

use Carp qw( croak );
use HTTP::Request::Common qw( DELETE GET POST ); ## no perlimports
use MetaCPAN::Model ();
use MetaCPAN::ESConfig qw( es_doc_path );
use MetaCPAN::Server ();
use MetaCPAN::Server::Config ();
use MetaCPAN::Types::TypeTiny qw( ES );
use MetaCPAN::Util qw( hit_total );
use Plack::Test; ## no perlimports

use base 'Exporter';
our @EXPORT_OK = qw(
POST GET DELETE
es
model
es_result
test_psgi app
query
);
Expand Down Expand Up @@ -49,14 +51,32 @@ sub es {
};
}

sub model {
state $model = MetaCPAN::Model->new( es => es() );
}

sub query {
state $query = MetaCPAN::Query->new( es => es() );
}

sub es_result {
my ( $type, $query, $size ) = @_;
$size //= wantarray ? 999 : 1;
if ( !wantarray && $size != 1 ) {
croak "multiple results requested with scalar return!";
}
my $res = es()->search(
es_doc_path($type),
body => {
size => ( wantarray ? 999 : 1 ),
query => $query,
},
);
my @hits = map $_->{_source}, @{ $res->{hits}{hits} };
if ( !wantarray ) {
croak "query did not return a single result"
if hit_total($res) != 1;
return $hits[0];
}
return @hits;
}

1;

=pod
Expand Down
9 changes: 4 additions & 5 deletions t/lib/MetaCPAN/Tests/Distribution.pm
Original file line number Diff line number Diff line change
Expand Up @@ -4,14 +4,13 @@ use Test::Routine;
use version;
use MetaCPAN::Types::TypeTiny qw( Str );

with qw(
MetaCPAN::Tests::Model
);
with qw( MetaCPAN::Tests::Query );

sub _build_type {'distribution'}

sub _build_search {
return [ get => $_[0]->name ];
my $self = shift;
return { term => { name => $self->name } };
}

my @attrs = qw(
Expand All @@ -27,7 +26,7 @@ test 'distribution attributes' => sub {
my ($self) = @_;

foreach my $attr (@attrs) {
is $self->data->$attr, $self->$attr, $attr;
is $self->data->{$attr}, $self->$attr, $attr;
}
};

Expand Down
9 changes: 9 additions & 0 deletions t/lib/MetaCPAN/Tests/Extra.pm
Original file line number Diff line number Diff line change
Expand Up @@ -3,6 +3,15 @@ use Test::More;
use Test::Routine;
use MetaCPAN::Types::TypeTiny qw( CodeRef );

around BUILDARGS => sub {
my ( $orig, $class, @args ) = @_;
my $attr = $class->$orig(@args);

delete $attr->{_expect}{extra_tests};

return $attr;
};

has _extra_tests => (
is => 'ro',
isa => CodeRef,
Expand Down
62 changes: 29 additions & 33 deletions t/lib/MetaCPAN/Tests/Model.pm → t/lib/MetaCPAN/Tests/Query.pm
Original file line number Diff line number Diff line change
@@ -1,63 +1,59 @@
package MetaCPAN::Tests::Model;
package MetaCPAN::Tests::Query;

use Test::Routine;

use MetaCPAN::ESConfig qw( es_doc_path );
use MetaCPAN::Server::Test ();
use MetaCPAN::Types::TypeTiny qw( ArrayRef HashRef InstanceOf Str );
use MetaCPAN::Types::TypeTiny qw( ES ArrayRef HashRef InstanceOf Str );
use Test::More;
use Try::Tiny qw( try );

with qw(
MetaCPAN::Tests::Extra
MetaCPAN::Tests::PSGI
);

around BUILDARGS => sub {
my ( $orig, $class, @args ) = @_;
my $attr = $class->$orig(@args);
my $expect = {};

# Get a list of defined attributes.
my %known = map { ( $_ => 1 ) }
map { $_->init_arg() } $class->meta->get_all_attributes();

# We could extract any keys that don't have defined attributes
# and only test those, but it shouldn't hurt to test the others
# (the ones that do have attributes defined). This way we won't *not*
# test something by accident if we define an attribute for it
# and really anything we specify shouldn't be different on the result.
while ( my ( $k, $v ) = each %$attr ) {
$expect->{$k} = $attr->{$k};
delete $attr->{$k} if !$known{$k};
}
my $attr = $class->$orig(@args);

my $expect = {%$attr};

return { _expect => $expect, %$attr };
};

with qw(
MetaCPAN::Tests::Extra
MetaCPAN::Tests::PSGI
);

has _type => (
is => 'ro',
isa => Str,
builder => '_build_type',
);

has model => (
has es => (
is => 'ro',
isa => InstanceOf ['MetaCPAN::Model'],
isa => ES,
lazy => 1,
default => sub { MetaCPAN::Server::Test::model() },
default => sub { MetaCPAN::Server::Test::es() },
);

has search => (
is => 'ro',
isa => ArrayRef,
isa => HashRef,
lazy => 1,
builder => '_build_search',
);

sub _do_search {
my ($self) = @_;
my ( $method, @params ) = @{ $self->search };
return $self->model->doc( $self->_type )->$method(@params);
my $query = $self->search;
my $res = $self->es->search(
es_doc_path( $self->_type ),
body => {
query => $query,
size => 1,
},
);
my $hit = $res->{hits}{hits}[0];
return $hit ? $hit->{_source} : undef;
}

has data => (
Expand All @@ -73,18 +69,18 @@ has _expectations => (
init_arg => '_expect',
);

test 'expected model attributes' => sub {
test 'expected attributes' => sub {
my ($self) = @_;
my $exp = $self->_expectations;
my $data = $self->data;

foreach my $key ( sort keys %$exp ) {

# Skip attributes of the test class that aren't attributes of the model.
next unless $data->can($key);
#next unless exists $data->{$key};

is_deeply $data->$key, $exp->{$key}, $key
or diag Test::More::explain $data->$key;
is_deeply $data->{$key}, $exp->{$key}, $key
or diag Test::More::explain $data->{$key};
}
};

Expand Down
Loading