convert MetaCPAN::Tests system to avoid ElasticSearchX::Model

Author: haarg

t/lib/MetaCPAN/Tests/Distribution.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/Extra.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/Model.pm renamed to t/lib/MetaCPAN/Tests/Query.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};
     }
 };
 

t/lib/MetaCPAN/Tests/Release.pm

@@ -6,21 +6,24 @@ use version;
 
 use HTTP::Request::Common     qw( GET );
 use List::Util                ();
+use MetaCPAN::ESConfig        qw( es_doc_path );
 use MetaCPAN::Types::TypeTiny qw( ArrayRef HashRef Str );
 use Test::More;
 
-with('MetaCPAN::Tests::Model');
+with qw( MetaCPAN::Tests::Query );
 
 sub _build_type {'release'}
 
 sub _build_search {
     my ($self) = @_;
-    return [
-        get => {
-            author => $self->author,
-            name   => $self->name,
-        }
-    ];
+    return {
+        bool => {
+            must => [
+                { term => { author => $self->author } },
+                { term => { name   => $self->name } },
+            ]
+        },
+    };
 }
 
 around BUILDARGS => sub {
@@ -35,8 +38,9 @@ around BUILDARGS => sub {
         @$attr{qw( distribution version )} = ( $1, $2 );
     }
 
-    # We handle this one specially.
+    # We handle these specially.
     delete $attr->{_expect}{tests};
+    delete $attr->{_expect}{modules};
 
     return $attr;
 };
@@ -92,7 +96,7 @@ sub file_content {
 
 sub file_by_path {
     my ( $self, $path ) = @_;
-    my $file = List::Util::first { $_->path eq $path } @{ $self->files };
+    my $file = List::Util::first { $_->{path} eq $path } @{ $self->files };
     ok $file, "found file '$path'";
     return $file;
 }
@@ -117,17 +121,22 @@ sub filter_files {
         if $add_filters && ref($add_filters) ne 'ARRAY';
 
     my $release = $self->data;
-    return [
-        $self->model->doc('file')->query( {
-            bool => {
-                must => [
-                    { term => { 'author'  => $release->author } },
-                    { term => { 'release' => $release->name } },
-                    @{ $add_filters || [] },
-                ],
-            }
-        } )->size(100)->all
-    ];
+    my $res     = $self->es->search(
+        es_doc_path('file'),
+        body => {
+            query => {
+                bool => {
+                    must => [
+                        { term => { 'author'  => $release->{author} } },
+                        { term => { 'release' => $release->{name} } },
+                        @{ $add_filters || [] },
+                    ],
+                },
+            },
+            size => 100,
+        },
+    );
+    return [ map $_->{_source}, @{ $res->{hits}{hits} } ];
 }
 
 has modules => (
@@ -177,7 +186,7 @@ has tests => (
 
 sub has_tests_ok {
     my ($self) = @_;
-    my $tests = $self->data->tests;
+    my $tests = $self->data->{tests};
 
     # Don't test the actual numbers since we copy this out of the real
     # database as a live test case.
@@ -198,15 +207,15 @@ test 'release attributes' => sub {
     my ($self) = @_;
 
     foreach my $attr (@attrs) {
-        is $self->data->$attr, $self->$attr, "release $attr";
+        is $self->data->{$attr}, $self->$attr, "release $attr";
     }
 
     if ( $self->expects_tests ) {
         if ( $self->tests eq '1' ) {
             $self->has_tests_ok;
         }
         else {
-            is_deeply $self->data->tests, $self->tests, 'test results';
+            is_deeply $self->data->{tests}, $self->tests, 'test results';
         }
     }
 };
@@ -218,11 +227,13 @@ test 'modules in Packages-1.103' => sub {
         unless scalar keys %{ $self->modules };
 
     my %module_files
-        = map { ( $_->path => $_->module ) } @{ $self->module_files };
+        = map { ( $_->{path} => $_->{module} ) } @{ $self->module_files };
 
     foreach my $path ( sort keys %{ $self->modules } ) {
         my $desc = "File '$path' has expected modules";
         if ( my $got = delete $module_files{$path} ) {
+            my $got = [ map +{%$_}, @$got ];
+            $_->{associated_pod} //= undef for @$got;
 
      # We may need to sort modules by name, I'm not sure if order is reliable.
             is_deeply $got, $self->modules->{$path}, $desc

t/release/badpod.t

@@ -33,12 +33,12 @@ sub test_bad_pod {
 
     my $file = $self->file_by_path('lib/BadPod.pm');
 
-    is $file->sloc, 3, 'sloc';
-    is $file->slop, 4, 'slop';
+    is $file->{sloc}, 3, 'sloc';
+    is $file->{slop}, 4, 'slop';
 
-    is_deeply $file->pod_lines, [ [ 5, 7 ], ], 'no pod_lines';
+    is_deeply $file->{pod_lines}, [ [ 5, 7 ], ], 'no pod_lines';
 
-    is ${ $file->pod },
+    is $file->{pod},
 
         # The unknown "=head" directive will get dropped
         # but the paragraph following it is valid.

t/release/binary-data.t

@@ -45,22 +45,22 @@ sub test_binary_data {
     {
         my $file = $self->file_by_path('lib/Binary/Data.pm');
 
-        is $file->sloc, 4, 'sloc';
-        is $file->slop, 0, 'slop';
+        is $file->{sloc}, 4, 'sloc';
+        is $file->{slop}, 0, 'slop';
 
         is_deeply $file->{pod_lines}, [], 'no pod_lines';
 
         my $binary = $self->file_content($file);
         like $binary, qr/^=[a-zA-Z]/m, 'matches loose pod pattern';
 
-        is ${ $file->pod }, q[], 'no pod text';
+        is $file->{pod}, q[], 'no pod text';
     }
 
     {
         my $file = $self->file_by_path('lib/Binary/Data/WithPod.pm');
 
-        is $file->sloc, 4, 'sloc';
-        is $file->slop, 7, 'slop';
+        is $file->{sloc}, 4, 'sloc';
+        is $file->{slop}, 7, 'slop';
 
         is_deeply $file->{pod_lines}, [ [ 5, 5 ], [ 22, 6 ], ], 'pod_lines';
 
@@ -69,7 +69,7 @@ sub test_binary_data {
         like $binary, qr/^=buzz9\xF0\x9F\x98\x8E/m,
             'matches more complex unwanted pod pattern';
 
-        is ${ $file->pod },
+        is $file->{pod},
             q[NAME Binary::Data::WithPod - that's it DESCRIPTION razzberry pudding],
             'pod text';
     }

t/release/common-files.t

@@ -31,15 +31,15 @@ test_release( {
         {
             my $file = $self->file_by_path('Makefile.PL');
 
-            ok !$file->indexed, 'Makefile.PL not indexed';
-            ok $file->authorized,
+            ok !$file->{indexed}, 'Makefile.PL not indexed';
+            ok $file->{authorized},
                 'Makefile.PL authorized, i suppose (not *un*authorized)';
-            is $file->sloc, 1, 'sloc';
-            is $file->slop, 3, 'slop';
+            is $file->{sloc}, 1, 'sloc';
+            is $file->{slop}, 3, 'slop';
 
-            is scalar( @{ $file->pod_lines } ), 1, 'one pod section';
+            is scalar( @{ $file->{pod_lines} } ), 1, 'one pod section';
 
-            is $file->abstract, undef, 'no abstract';
+            is $file->{abstract}, undef, 'no abstract';
         }
 
     },

t/release/documentation-not-readme.t

@@ -22,14 +22,15 @@ sub test_modules {
     is( @files, 1, 'includes one file with modules' );
 
     my $file = shift @files;
-    is( @{ $file->module }, 1, 'file contains one module' );
+    is( @{ $file->{module} }, 1, 'file contains one module' );
 
-    my ($indexed) = grep { $_->{indexed} } @{ $file->module };
+    my ($indexed) = grep { $_->{indexed} } @{ $file->{module} };
 
-    is( $indexed->name,       'Documentation::Not::Readme', 'module name' );
-    is( $file->documentation, 'Documentation::Not::Readme', 'documentation' );
+    is( $indexed->{name}, 'Documentation::Not::Readme', 'module name' );
+    is( $file->{documentation},
+        'Documentation::Not::Readme', 'documentation' );
 
-    is( $indexed->associated_pod,
+    is( $indexed->{associated_pod},
         'RWSTAUNER/Documentation-Not-Readme-0.01/lib/Documentation/Not/Readme.pm'
     );
 }

t/release/file-duplicates.t

@@ -65,7 +65,7 @@ test_release(
             );
 
             while ( my ( $path, $count ) = each %dup ) {
-                is( scalar( grep { $_->path =~ m{\Q$path\E$} } @$files ),
+                is( scalar( grep { $_->{path} =~ m{\Q$path\E$} } @$files ),
                     $count, "multiple files match $path" );
             }
         },