Bug 24356: Make objects.search prefetch embedded relations

This patch makes the Koha::Object(s) derived classes expose information
about prefetch-able relations. This is then used by a new helper to
generate the prefetch information for the DBIC query.

To test:
1. Apply this patch
2. Run:
   $ kshell
  k$ prove t/db_dependent/Koha/Object* \
           t/db_dependent/Koha/REST/Plugin/Objects.t \
           t/Koha/REST/Plugin/Query.t
=> SUCCESS: Tests pass!
3. Sign off :-D

Signed-off-by: David Nind <david@davidnind.com>
Signed-off-by: Martin Renvoize <martin.renvoize@ptfs-europe.com>

Koha/Object.pm

@@ -373,6 +373,35 @@ sub _numeric_column_type {
     return ( grep { $column_type eq $_ } @numeric_types) ? 1 : 0;
 }
 
+=head3 prefetch_whitelist
+
+    my $whitelist = $object->prefetch_whitelist()
+
+Returns a hash of prefetchable subs and the type they return.
+
+=cut
+
+sub prefetch_whitelist {
+    my ( $self ) = @_;
+
+    my $whitelist = {};
+    my $relations = $self->_result->result_source->_relationships;
+
+    foreach my $key (keys %{$relations}) {
+        if($self->can($key)) {
+            my $result_class = $relations->{$key}->{class};
+            my $obj = $result_class->new;
+            try {
+                $whitelist->{$key} = $obj->koha_object_class;
+            } catch {
+                $whitelist->{$key} = undef;
+            }
+        }
+    }
+
+    return $whitelist;
+}
+
 =head3 to_api
 
     my $object_for_api = $object->to_api(

Koha/Objects.pm

@@ -351,6 +351,22 @@ sub from_api_mapping {
     return $self->{_singular_object}->from_api_mapping;
 }
 
+=head3 prefetch_whitelist
+
+    my $whitelist = $object->prefetch_whitelist()
+
+Returns a hash of prefetchable subs and the type it returns
+
+=cut
+
+sub prefetch_whitelist {
+    my ( $self ) = @_;
+
+    $self->{_singular_object} ||= $self->object_class->new();
+
+    $self->{_singular_object}->prefetch_whitelist;
+}
+
 =head3 Koha::Objects->_wrap
 
 wraps the DBIC object in a corresponding Koha object

Koha/REST/Plugin/Objects.pm

@@ -71,6 +71,14 @@ sub register {
                 }
             );
 
+            # Generate prefetches for embedded stuff
+            $c->dbic_merge_prefetch(
+                {
+                    attributes => $attributes,
+                    result_set => $result_set
+                }
+            );
+
             # Call the to_model function by reference, if defined
             if ( defined $filtered_params ) {
 

Koha/REST/Plugin/Query.pm

@@ -105,6 +105,35 @@ Generates the DBIC order_by attributes based on I<$params>, and merges into I<$a
         }
     );
 
+=head3 dbic_merge_prefetch
+
+    $attributes = $c->dbic_merge_prefetch({ attributes => $attributes, result_set => $result_set });
+
+Generates the DBIC prefetch attribute based on embedded relations, and merges into I<$attributes>.
+
+=cut
+
+    $app->helper(
+        'dbic_merge_prefetch' => sub {
+            my ( $c, $args ) = @_;
+            my $attributes = $args->{attributes};
+            my $result_set = $args->{result_set};
+            my $embed = $c->stash('koha.embed');
+
+            return unless defined $embed;
+
+            my @prefetches;
+            foreach my $key (keys %{$embed}) {
+                my $parsed = _parse_prefetch($key, $embed, $result_set);
+                push @prefetches, $parsed if defined $parsed;
+            }
+
+            if(scalar(@prefetches)) {
+                $attributes->{prefetch} = \@prefetches;
+            }
+        }
+    );
+
 =head3 _build_query_params_from_api
 
     my $params = _build_query_params_from_api( $filtered_params, $reserved_params );
@@ -298,4 +327,23 @@ sub _merge_embed {
     }
 }
 
+sub _parse_prefetch {
+    my ( $key, $embed, $result_set) = @_;
+
+    return unless exists $result_set->prefetch_whitelist->{$key};
+
+    my $ko_class = $result_set->prefetch_whitelist->{$key};
+    return $key unless defined $embed->{$key}->{children} && defined $ko_class;
+
+    my $prefetch = {};
+    foreach my $child (keys %{$embed->{$key}->{children}}) {
+        my $parsed = _parse_prefetch($child, $embed->{$key}->{children}, $ko_class->new);
+        $prefetch->{$key} = $parsed if defined $parsed;
+    }
+
+    return unless scalar(keys %{$prefetch});
+
+    return $prefetch;
+}
+
 1;

t/Koha/REST/Plugin/Query.t

@@ -113,6 +113,27 @@ get '/dbic_merge_sorting_date' => sub {
     $c->render( json => $attributes, status => 200 );
 };
 
+get '/dbic_merge_prefetch' => sub {
+    my $c = shift;
+    my $attributes = {};
+    my $result_set = Koha::Holds->new;
+    $c->stash('koha.embed', {
+            "item" => {},
+            "biblio" => {
+                children => {
+                    "orders" => {}
+                }
+            }
+        });
+
+    $c->dbic_merge_prefetch({
+        attributes => $attributes,
+        result_set => $result_set
+    });
+
+    $c->render( json => $attributes, status => 200 );
+};
+
 get '/build_query' => sub {
     my $c = shift;
     my ( $filtered_params, $reserved_params ) =
@@ -188,7 +209,7 @@ sub to_model {
 
 # The tests
 
-use Test::More tests => 4;
+use Test::More tests => 5;
 use Test::Mojo;
 
 subtest 'extract_reserved_params() tests' => sub {
@@ -266,6 +287,16 @@ subtest 'dbic_merge_sorting() tests' => sub {
       );
 };
 
+subtest '/dbic_merge_prefetch' => sub {
+    plan tests => 4;
+
+    my $t = Test::Mojo->new;
+
+    $t->get_ok('/dbic_merge_prefetch')->status_is(200)
+      ->json_like( '/prefetch/0' => qr/item|biblio/ )
+      ->json_like( '/prefetch/1' => qr/item|biblio/ );
+};
+
 subtest '_build_query_params_from_api' => sub {
 
     plan tests => 16;