Add parent object to hold query objects

This allows query objects to fetch the parent object, and then fetch
other query objects via it. This makes it much easier for query methods
to call other query objects, which is needed for convert some of the
model queries.

Author: haarg

lib/MetaCPAN/Query.pm

@@ -0,0 +1,52 @@
+package MetaCPAN::Query;
+use Moose;
+
+use Module::Runtime              qw( require_module );
+use Module::Pluggable::Object    ();
+use MooseX::Types::ElasticSearch qw( ES );
+
+has es => (
+    is       => 'ro',
+    required => 1,
+    isa      => ES,
+    coerce   => 1,
+);
+
+my @plugins = Module::Pluggable::Object->new(
+    search_path => [__PACKAGE__],
+    max_depth   => 3,
+    require     => 0,
+)->plugins;
+
+for my $class (@plugins) {
+    require_module($class);
+    my $name = $class->can('name') && $class->name
+        or next;
+
+    my $in  = "_in_$name";
+    my $gen = "_gen_$name";
+
+    has $in => (
+        is       => 'ro',
+        init_arg => $name,
+        weak_ref => 1,
+    );
+
+    has $gen => (
+        is       => 'ro',
+        init_arg => undef,
+        lazy     => 1,
+        default  => sub {
+            my $self = shift;
+            $class->new(
+                es    => $self->es,
+                query => $self,
+            );
+        },
+    );
+
+    no strict 'refs';
+    *$name = sub { $_[0]->$in // $_[0]->$gen };
+}
+
+1;

lib/MetaCPAN/Query/Role/Common.pm

@@ -1,7 +1,46 @@
 package MetaCPAN::Query::Role::Common;
-
 use Moose::Role;
 
-has es => ( is => 'ro', );
+use MooseX::Types::ElasticSearch qw( ES );
+
+has es => (
+    is       => 'ro',
+    required => 1,
+    isa      => ES,
+    coerce   => 1,
+);
+
+sub name {
+    my $self  = shift;
+    my $class = ref $self || $self;
+
+    $class =~ /^MetaCPAN::Query::([^:]+)$/
+        or return undef;
+    return lc $1;
+}
+
+has _in_query => (
+    is       => 'ro',
+    init_arg => 'query',
+    weak_ref => 1,
+);
+
+has _gen_query => (
+    is       => 'ro',
+    lazy     => 1,
+    init_arg => undef,
+    default  => sub {
+        my $self = shift;
+        my $name = $self->name;
+
+        require MetaCPAN::Query;
+        MetaCPAN::Query->new(
+            es => $self->es,
+            ( $name ? ( $name => $self ) : () ),
+        );
+    },
+);
+
+sub query { $_[0]->_in_query // $_[0]->_gen_query }
 
 1;

t/query.t

@@ -0,0 +1,44 @@
+use strict;
+use warnings;
+
+use lib 't/lib';
+
+use MetaCPAN::Query;
+use MetaCPAN::Server::Test ();
+use Test::More;
+use Scalar::Util qw(weaken);
+
+my $es = MetaCPAN::Server::Test::model->es;
+
+{
+    my $query   = MetaCPAN::Query->new( es => $es );
+    my $release = $query->release;
+
+    isa_ok $release, 'MetaCPAN::Query::Release';
+    is $release->query, $query, 'got same parent object';
+
+    weaken $release;
+    weaken $query;
+    is $query,   undef, 'parent object properly released'
+        or diag explain $query;
+    is $release, undef, 'release object properly released'
+        or diag explain $release;
+
+}
+
+{
+    my $release = MetaCPAN::Query::Release->new( es => $es );
+    my $query   = $release->query;
+
+    isa_ok $query, 'MetaCPAN::Query';
+    is $query->release, $release, 'got same child object';
+
+    weaken $release;
+    weaken $query;
+    is $query,   undef, 'parent object properly released'
+        or diag explain $query;
+    is $release, undef, 'release object properly released'
+        or diag explain $release;
+}
+
+done_testing;