Merge pull request #1353 from metacpan/haarg/no-model-in-tests

remove most use of ElasticSearchX::Model from tests

Author: haarg

lib/MetaCPAN/Document/File/Set.pm

@@ -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;

lib/MetaCPAN/Query/File.pm

@@ -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;

lib/MetaCPAN/Server/Controller/Search/History.pm

@@ -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
 );
@@ -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

t/lib/MetaCPAN/Server/Test.pm

@@ -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(
@@ -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;
     }
 };
 

t/lib/MetaCPAN/Tests/Distribution.pm

@@ -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,

t/lib/MetaCPAN/Tests/Extra.pm

@@ -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 => (
@@ -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};
     }
 };