Speed up fetching lists of bodies.

Use a HashRefInflator wherever all_sorted is used, with consequential
changes to deal with it now not being an object (e.g. add some with_*
functions for manual fetching of extra data).

6 files changed, 102 insertions, 20 deletions

diff --git a/perllib/FixMyStreet/App/Controller/Admin.pm b/perllib/FixMyStreet/App/Controller/Admin.pm
index 7c81251e8..1158b688a 100644
--- a/perllib/FixMyStreet/App/Controller/Admin.pm
+++ b/perllib/FixMyStreet/App/Controller/Admin.pm
@@ -2147,10 +2147,14 @@ sub check_page_allowed : Private {
 sub fetch_all_bodies : Private {
     my ($self, $c ) = @_;
 
-    my @bodies = $c->model('DB::Body')->translated->all_sorted;
-    if ( $c->cobrand->moniker eq 'zurich' ) {
-        @bodies = $c->cobrand->admin_fetch_all_bodies( @bodies );
-    }
+    my @bodies = $c->cobrand->call_hook('admin_fetch_all_bodies') || do {
+        my $bodies = $c->model('DB::Body')->search(undef, {
+            columns => [ "id", "name", "deleted", "parent" ],
+        })->with_parent_name;
+        $bodies = $bodies->with_defect_type_count if $c->stash->{with_defect_type_count};
+        $bodies->translated->all_sorted;
+    };
+
     $c->stash->{bodies} = \@bodies;
 
     return 1;
diff --git a/perllib/FixMyStreet/App/Controller/Admin/DefectTypes.pm b/perllib/FixMyStreet/App/Controller/Admin/DefectTypes.pm
index 5dab1da2c..ed9b40fd0 100644
--- a/perllib/FixMyStreet/App/Controller/Admin/DefectTypes.pm
+++ b/perllib/FixMyStreet/App/Controller/Admin/DefectTypes.pm
@@ -12,6 +12,7 @@ sub index : Path : Args(0) {
     my $user = $c->user;
 
     if ($user->is_superuser) {
+        $c->stash->{with_defect_type_count} = 1;
         $c->forward('/admin/fetch_all_bodies');
     } elsif ( $user->from_body ) {
         $c->forward('load_user_body', [ $user->from_body->id ]);
diff --git a/perllib/FixMyStreet/App/Controller/Dashboard.pm b/perllib/FixMyStreet/App/Controller/Dashboard.pm
index 790e7ec29..aadd913ca 100644
--- a/perllib/FixMyStreet/App/Controller/Dashboard.pm
+++ b/perllib/FixMyStreet/App/Controller/Dashboard.pm
@@ -99,7 +99,9 @@ sub index : Path : Args(0) {
             $c->stash->{body_name} = join "", map { $children->{$_}->{name} } grep { $children->{$_} } $c->user->area_id;
         }
     } else {
-        my @bodies = $c->model('DB::Body')->active->translated->with_area_count->all_sorted;
+        my @bodies = $c->model('DB::Body')->search(undef, {
+            columns => [ "id", "name" ],
+        })->active->translated->with_area_count->all_sorted;
         $c->stash->{bodies} = \@bodies;
     }
 
diff --git a/perllib/FixMyStreet/App/Controller/Reports.pm b/perllib/FixMyStreet/App/Controller/Reports.pm
index ade04fc7c..005397fda 100644
--- a/perllib/FixMyStreet/App/Controller/Reports.pm
+++ b/perllib/FixMyStreet/App/Controller/Reports.pm
@@ -66,7 +66,9 @@ sub index : Path : Args(0) {
             $c->stash->{children} = $children;
         }
     } else {
-        my @bodies = $c->model('DB::Body')->active->translated->with_area_count->all_sorted;
+        my @bodies = $c->model('DB::Body')->search(undef, {
+            columns => [ "id", "name" ],
+        })->active->translated->with_area_count->all_sorted;
         @bodies = @{$c->cobrand->call_hook('reports_hook_restrict_bodies_list', \@bodies) || \@bodies };
         $c->stash->{bodies} = \@bodies;
     }
diff --git a/perllib/FixMyStreet/Cobrand/Zurich.pm b/perllib/FixMyStreet/Cobrand/Zurich.pm
index fd0201f02..1d219ce37 100644
--- a/perllib/FixMyStreet/Cobrand/Zurich.pm
+++ b/perllib/FixMyStreet/Cobrand/Zurich.pm
@@ -1063,7 +1063,7 @@ sub munge_sendreport_params {
 }
 
 sub admin_fetch_all_bodies {
-    my ( $self, @bodies ) = @_;
+    my ( $self ) = @_;
 
     sub tree_sort {
         my ( $level, $id, $sorted, $out ) = @_;
@@ -1073,26 +1073,30 @@ sub admin_fetch_all_bodies {
         if ( $level == 0 ) {
             @sorted = sort {
                 # Want Zurich itself at the top.
-                return -1 if $sorted->{$a->id};
-                return 1 if $sorted->{$b->id};
+                return -1 if $sorted->{$a->{id}};
+                return 1 if $sorted->{$b->{id}};
                 # Otherwise, by name
-                strcoll($a->name, $b->name)
+                strcoll($a->{name}, $b->{name})
             } @$array;
         } else {
-            @sorted = sort { strcoll($a->name, $b->name) } @$array;
+            @sorted = sort { strcoll($a->{name}, $b->{name}) } @$array;
         }
         foreach ( @sorted ) {
-            $_->api_key( $level ); # Misuse
+            $_->{indent_level} = $level;
             push @$out, $_;
-            if ($sorted->{$_->id}) {
-                tree_sort( $level+1, $_->id, $sorted, $out );
+            if ($sorted->{$_->{id}}) {
+                tree_sort( $level+1, $_->{id}, $sorted, $out );
             }
         }
     }
 
+    my @bodies = FixMyStreet::DB->resultset('Body')->search(undef, {
+        columns => [ "id", "name", "deleted", "parent", "endpoint" ],
+    })->translated->with_children_count->all_sorted;
+
     my %sorted;
     foreach (@bodies) {
-        my $p = $_->parent ? $_->parent->id : 0;
+        my $p = $_->{parent} || 0;
         push @{$sorted{$p}}, $_;
     }
 
diff --git a/perllib/FixMyStreet/DB/ResultSet/Body.pm b/perllib/FixMyStreet/DB/ResultSet/Body.pm
index 0aa3e8240..1855a45c1 100644
--- a/perllib/FixMyStreet/DB/ResultSet/Body.pm
+++ b/perllib/FixMyStreet/DB/ResultSet/Body.pm
@@ -41,7 +41,7 @@ This restricts the ResultSet to bodies that are not marked as deleted.
 
 sub active {
     my $rs = shift;
-    $rs->search({ deleted => 0 });
+    $rs->search({ 'me.deleted' => 0 });
 }
 
 =item translated
@@ -61,6 +61,22 @@ sub translated {
     });
 }
 
+=item with_parent_name
+
+This adds the parent name associated with each body to the ResultSet,
+in the parent_name column.
+
+=cut
+
+sub with_parent_name {
+    my $rs = shift;
+    $rs->search(undef, {
+        '+select' => [ 'parent.name' ],
+        '+as' => [ 'parent_name' ],
+        join => 'parent',
+    });
+}
+
 =item with_area_count
 
 This adds the number of areas associated with each body to the ResultSet,
@@ -78,10 +94,45 @@ sub with_area_count {
     });
 }
 
+=item with_defect_type_count
+
+This adds the number of defect types associated with each body to the
+ResultSet, in the defect_type_count column.
+
+=cut
+
+sub with_defect_type_count {
+    my $rs = shift;
+    $rs->search(undef, {
+        '+select' => [ { count => 'defect_types.name' } ],
+        '+as' => [ 'defect_type_count' ],
+        join => 'defect_types',
+        distinct => 1,
+    });
+}
+
+=item with_children_count
+
+This adds the number of children associated with each body to the
+ResultSet, in the children_count column.
+
+=cut
+
+sub with_children_count {
+    my $rs = shift;
+    $rs->search(undef, {
+        '+select' => [ { count => 'bodies.id' } ],
+        '+as' => [ 'children_count' ],
+        join => 'bodies',
+        distinct => 1,
+    });
+}
+
 =item all_sorted
 
-This returns all results, as C<all()>, but sorted by their name column
-(which will be the translated names if present).
+This returns all results, as C<all()>, but sorted by their name (including
+the translated names, if present), and as simple hashrefs not objects, for
+performance reasons.
 
 =back
 
@@ -89,8 +140,26 @@ This returns all results, as C<all()>, but sorted by their name column
 
 sub all_sorted {
     my $rs = shift;
-    my @bodies = $rs->all;
-    @bodies = sort { strcoll($a->name, $b->name) } @bodies;
+
+    # Use a HashRefInflator here to return simple hashrefs rather than full
+    # objects. This is quicker if you have a large number of bodies; note
+    # fetching only the columns you need provides even more of a speed up.
+    my @bodies = $rs->search(undef, {
+        result_class => 'DBIx::Class::ResultClass::HashRefInflator',
+    })->all;
+    @bodies = sort { strcoll($a->{msgstr} || $a->{name}, $b->{msgstr} || $b->{name}) } @bodies;
+
+    foreach my $body (@bodies) {
+        $body->{parent} = { id => $body->{parent}, name => $body->{parent_name} } if $body->{parent};
+
+        # DEPRECATED: get_column('area_count') -> area_count
+        next unless defined $body->{area_count};
+        $body->{get_column} = sub {
+            my $key = shift;
+            return $body->{$key};
+        };
+    }
+
     return @bodies;
 }