diff options
| -rw-r--r-- | CHANGELOG.md | 1 | ||||
| -rw-r--r-- | perllib/DBIx/Class/SQLMaker/Pg/ServerCursor.pm | 21 | ||||
| -rw-r--r-- | perllib/DBIx/Class/Storage/DBI/Pg/ServerCursor.pm | 101 | ||||
| -rw-r--r-- | perllib/DBIx/Class/Storage/DBI/PgServerCursor.pm | 10 | ||||
| -rw-r--r-- | perllib/FixMyStreet/App/Controller/Admin/Reports.pm | 8 | ||||
| -rw-r--r-- | perllib/FixMyStreet/App/Controller/Dashboard.pm | 5 | ||||
| -rw-r--r-- | perllib/FixMyStreet/Cobrand/BathNES.pm | 4 | ||||
| -rw-r--r-- | perllib/FixMyStreet/Cobrand/TfL.pm | 7 | ||||
| -rw-r--r-- | perllib/FixMyStreet/DB/Schema.pm | 1 |
9 files changed, 151 insertions, 7 deletions
diff --git a/CHANGELOG.md b/CHANGELOG.md index cefc72f00..1ab1c2a1c 100644 --- a/CHANGELOG.md +++ b/CHANGELOG.md @@ -5,6 +5,7 @@ - order unsent reports by confirmed date - Disable staff private tickbox on new reports if category is private. #2961 - Move stats from main admin index to stats index. + - Speed up dashboard export and report search. - Bugfixes - Application user in Docker container can't install packages. #2914 - Look at all categories when sending reports. diff --git a/perllib/DBIx/Class/SQLMaker/Pg/ServerCursor.pm b/perllib/DBIx/Class/SQLMaker/Pg/ServerCursor.pm new file mode 100644 index 000000000..dc1be419e --- /dev/null +++ b/perllib/DBIx/Class/SQLMaker/Pg/ServerCursor.pm @@ -0,0 +1,21 @@ +package DBIx::Class::SQLMaker::Pg::ServerCursor; +use strict; +use warnings; +use base 'DBIx::Class::SQLMaker'; +use mro 'c3'; + +# SQLMaker to return the SQL which creates a server-side cursor on Postgres if +# _as_cursor is passed with the name of the cursor to create. +sub select { + my $self = shift; + my ($table, $fields, $where, $rs_attrs, $limit, $offset) = @_; + my ($sql, @all_bind) = $self->next::method(@_); + + if( my $cursor_name = $rs_attrs->{_as_cursor} ) { + $sql = "DECLARE $cursor_name CURSOR WITH HOLD FOR $sql"; + } + + return wantarray ? ($sql, @all_bind) : $sql; +} + +1 diff --git a/perllib/DBIx/Class/Storage/DBI/Pg/ServerCursor.pm b/perllib/DBIx/Class/Storage/DBI/Pg/ServerCursor.pm new file mode 100644 index 000000000..83ce8a1ac --- /dev/null +++ b/perllib/DBIx/Class/Storage/DBI/Pg/ServerCursor.pm @@ -0,0 +1,101 @@ +package DBIx::Class::Storage::DBI::Pg::ServerCursor; +use strict; +use warnings; +use base 'DBIx::Class::Storage::DBI::Cursor'; +use mro 'c3'; +use Try::Tiny; + +__PACKAGE__->mk_group_accessors('simple' => + qw/cursor_name cursor_sth/ +); + +# Track cursor numbers through the lifetime of the program. Only really needs to be tracked for each dbh connection though. +my $cursor_counter = 1; +sub _generate_cursor_name { 'dbic_cursor_' . $cursor_counter++ } + +sub cursor_page_size { shift->{args}[3]{cursor_page_size} || 0 } + +sub fetch_next_page { + my $self = shift; + + $self->cursor_sth->finish if $self->cursor_sth; + (undef, my $cursor_sth, undef) = $self->storage->_dbh_execute( $self->sth->{Database}, 'FETCH ' . $self->cursor_page_size . ' FROM ' . $self->cursor_name, [] ); + + $self->cursor_sth($cursor_sth); +} + +# Modification of the standard next function so that if C<cursor_page_size> is +# specified in the ResultSet search attrs it will declare a server-side cursor +# and fetch that number of rows at a time. Support for software offset/limit +# is removed as postgres has great server-side offset/limit support. If +# C<cursor_page_size> is not specified then it behaves exactly as a normal DBIC +# software cursor including support for software offset/limit + +# Note: We use $self->sth->{Database} for the FETCH/CLOSE access so that its +# fate is tied to that of the connection that started the cursor +sub next { + my $self = shift; + return if $self->{_done}; + + # Short-circuit to main method if we are not using server-side cursor + return $self->next::method( @_ ) if $self->sth && !$self->cursor_name; + + unless ($self->sth) { + return $self->next::method( @_ ) unless $self->cursor_page_size; + + # Create the main server-side cursor if we didn't get it already + $self->cursor_name($self->_generate_cursor_name); + + # Issue the server-side declare cursor query + $self->{args}[3]{_as_cursor} = $self->cursor_name; + (undef, my $sth, undef) = $self->storage->_select( @{$self->{args}} ); + + $self->sth($sth); + $self->fetch_next_page; + + $self->{_results} = [ (undef) x $self->cursor_sth->FETCH('NUM_OF_FIELDS') ]; + $self->cursor_sth->bind_columns( \( @{$self->{_results}} ) ); + } + + for my $refetched (0, 1) { + if ($self->cursor_sth->fetch) { + $self->{_pos}++; + return @{$self->{_results}}; + } + + $self->fetch_next_page if !$refetched; + } + + $self->{_done} = 1; + return (); +} + +sub __finish_sth { + # It is (sadly) extremely important to finish() handles we are about + # to lose (due to reset() or a DESTROY() ). $rs->reset is the closest + # thing the user has to getting to the underlying finish() API and some + # DBDs mandate this (e.g. DBD::InterBase will segfault, DBD::Sybase + # won't start a transaction sanely, etc) + # We also can't use the accessor here, as it will trigger a fork/thread + # check, and resetting a cursor in a child is perfectly valid + + my $self = shift; + return $self->next::method( @_ ) unless $self->cursor_name; + + # No need to care about failures here + try { local $SIG{__WARN__} = sub {}; $self->{cursor_sth}->finish } if ( + $self->{cursor_sth} and ! try { ! $self->{cursor_sth}->FETCH('Active') } + ); + + # Close the server-side cursor nicely + if ( $self->{sth} ) { + try { + local $SIG{__WARN__} = sub {}; + $self->storage->_dbh_execute( $self->{sth}{Database}, 'CLOSE ' . $self->cursor_name, [] ); + $self->{sth}->finish; + $self->{sth} = undef; + }; + } +} + +1 diff --git a/perllib/DBIx/Class/Storage/DBI/PgServerCursor.pm b/perllib/DBIx/Class/Storage/DBI/PgServerCursor.pm new file mode 100644 index 000000000..440002071 --- /dev/null +++ b/perllib/DBIx/Class/Storage/DBI/PgServerCursor.pm @@ -0,0 +1,10 @@ +package DBIx::Class::Storage::DBI::PgServerCursor; +use strict; +use warnings; +use base 'DBIx::Class::Storage::DBI::Pg'; +use mro 'c3'; + +__PACKAGE__->sql_maker_class('DBIx::Class::SQLMaker::Pg::ServerCursor'); +__PACKAGE__->cursor_class('DBIx::Class::Storage::DBI::Pg::ServerCursor'); + +1 diff --git a/perllib/FixMyStreet/App/Controller/Admin/Reports.pm b/perllib/FixMyStreet/App/Controller/Admin/Reports.pm index ef9736ff6..7300fe676 100644 --- a/perllib/FixMyStreet/App/Controller/Admin/Reports.pm +++ b/perllib/FixMyStreet/App/Controller/Admin/Reports.pm @@ -108,7 +108,8 @@ sub index : Path { my $problems = $c->cobrand->problems->search( $query, { - prefetch => 'user', + join => 'user', + '+columns' => 'user.email', rows => 50, order_by => $order, } @@ -150,8 +151,9 @@ sub index : Path { -or => $query, }, { - -select => [ 'me.*', qw/problem.bodies_str problem.state/ ], - prefetch => [qw/user problem/], + '+columns' => ['user.email'], + join => 'user', + prefetch => [qw/problem/], rows => 50, order_by => { -desc => 'me.id' } } diff --git a/perllib/FixMyStreet/App/Controller/Dashboard.pm b/perllib/FixMyStreet/App/Controller/Dashboard.pm index 058fa3806..ad6c9ba98 100644 --- a/perllib/FixMyStreet/App/Controller/Dashboard.pm +++ b/perllib/FixMyStreet/App/Controller/Dashboard.pm @@ -328,6 +328,7 @@ sub export_as_csv_updates : Private { objects => $c->stash->{objects_rs}->search_rs({}, { order_by => ['me.confirmed', 'me.id'], '+columns' => ['problem.bodies_str'], + cursor_page_size => 1000, }), headers => [ 'Report ID', 'Update ID', 'Date', 'Status', 'Problem state', @@ -348,8 +349,10 @@ sub export_as_csv : Private { my $csv = $c->stash->{csv} = { objects => $c->stash->{objects_rs}->search_rs({}, { - prefetch => 'comments', + join => 'comments', + '+columns' => ['comments.problem_state', 'comments.state', 'comments.confirmed', 'comments.mark_fixed'], order_by => ['me.confirmed', 'me.id'], + cursor_page_size => 1000, }), headers => [ 'Report ID', diff --git a/perllib/FixMyStreet/Cobrand/BathNES.pm b/perllib/FixMyStreet/Cobrand/BathNES.pm index 6a4f1c00b..06095734b 100644 --- a/perllib/FixMyStreet/Cobrand/BathNES.pm +++ b/perllib/FixMyStreet/Cobrand/BathNES.pm @@ -194,7 +194,7 @@ sub dashboard_export_updates_add_columns { $c->stash->{csv}->{objects} = $c->stash->{csv}->{objects}->search(undef, { '+columns' => ['user.email'], - prefetch => 'user', + join => 'user', }); my $user_lookup = $self->_dashboard_user_lookup; @@ -237,7 +237,7 @@ sub dashboard_export_problems_add_columns { $c->stash->{csv}->{objects} = $c->stash->{csv}->{objects}->search(undef, { '+columns' => ['user.email', 'user.phone'], - prefetch => 'user', + join => 'user', }); my $user_lookup = $self->_dashboard_user_lookup; diff --git a/perllib/FixMyStreet/Cobrand/TfL.pm b/perllib/FixMyStreet/Cobrand/TfL.pm index 8e133fa58..b98ad1d8b 100644 --- a/perllib/FixMyStreet/Cobrand/TfL.pm +++ b/perllib/FixMyStreet/Cobrand/TfL.pm @@ -293,7 +293,12 @@ sub dashboard_export_problems_add_columns { my $change = $report->admin_log_entries->search( { action => 'category_change' }, - { prefetch => 'user', rows => 1, order_by => { -desc => 'me.id' } } + { + join => 'user', + '+columns' => ['user.name'], + rows => 1, + order_by => { -desc => 'me.id' } + } )->single; my $reassigned_at = $change ? $change->whenedited : ''; my $reassigned_by = $change ? $change->user->name : ''; diff --git a/perllib/FixMyStreet/DB/Schema.pm b/perllib/FixMyStreet/DB/Schema.pm index be39069d8..e39a8422e 100644 --- a/perllib/FixMyStreet/DB/Schema.pm +++ b/perllib/FixMyStreet/DB/Schema.pm @@ -21,6 +21,7 @@ __PACKAGE__->load_namespaces( use Moo; use FixMyStreet; +__PACKAGE__->storage_type('::DBI::PgServerCursor'); __PACKAGE__->connection(FixMyStreet->dbic_connect_info); has lang => ( is => 'rw' ); |