From f9e05d7368187c82bfd67440ef76a0f017935765 Mon Sep 17 00:00:00 2001
From: Agustin Moyano <agustinmoyano@theke.io>
Date: Tue, 21 Jan 2020 12:39:49 -0300
Subject: [PATCH] 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/db_dependent/Koha/REST/Plugin/Query.t
=> SUCCESS: Tests pass!
3. Sign off :-D
---
 Koha/Object.pm              | 24 ++++++++++++++++++
 Koha/Objects.pm             | 16 ++++++++++++
 Koha/REST/Plugin/Objects.pm |  8 ++++++
 Koha/REST/Plugin/Query.pm   | 49 +++++++++++++++++++++++++++++++++++++
 4 files changed, 97 insertions(+)

diff --git a/Koha/Object.pm b/Koha/Object.pm
index 5f28c35808..dda2bdd9bf 100644
--- a/Koha/Object.pm
+++ b/Koha/Object.pm
@@ -372,6 +372,30 @@ 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;
+            $whitelist->{$key} = $obj->koha_object_class if $obj->can('koha_object_class');
+        }
+    }
+
+    return $whitelist;
+}
+
 =head3 to_api
 
     my $object_for_api = $object->to_api(
diff --git a/Koha/Objects.pm b/Koha/Objects.pm
index 6d9493308c..7948eae2a7 100644
--- a/Koha/Objects.pm
+++ b/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
diff --git a/Koha/REST/Plugin/Objects.pm b/Koha/REST/Plugin/Objects.pm
index 4ce9c5134d..5bac69ea44 100644
--- a/Koha/REST/Plugin/Objects.pm
+++ b/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 ) {
 
diff --git a/Koha/REST/Plugin/Query.pm b/Koha/REST/Plugin/Query.pm
index b2ebd8f77a..f6d6c2ce88 100644
--- a/Koha/REST/Plugin/Query.pm
+++ b/Koha/REST/Plugin/Query.pm
@@ -100,6 +100,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 );
@@ -287,4 +316,24 @@ sub _merge_embed {
     }
 }
 
+sub _parse_prefetch {
+    my ( $key, $embed, $result_set) = @_;
+
+    my $ko_class = $result_set->prefetch_whitelist->{$key};
+
+    return unless defined $ko_class;
+
+    return $key unless defined $embed->{$key}->{children};
+
+    my $prefetch = {};
+    foreach my $child (keys %{$embed->{$key}->{children}}) {
+        my $parsed = _parse_prefetch($child, $embed->{$key}->{children}, $ko_class->new);
+        $prefetch->{$child} = $parsed if defined $parsed;
+    }
+
+    return unless scalar(keys %{$prefetch});
+
+    return $prefetch;
+}
+
 1;
-- 
2.17.1