Sort profiles for download in Perl - much quicker than within query.

lib/BIGSdb/DownloadProfilesPage.pm

@@ -21,6 +21,7 @@ use strict;
 use warnings;
 use 5.010;
 use parent qw(BIGSdb::Page);
+use List::MoreUtils qw(uniq);
 use Log::Log4perl qw(get_logger);
 my $logger = get_logger('BIGSdb.Page');
 
@@ -60,13 +61,14 @@ sub print_content {
 	}
 	my $loci = $self->{'datastore'}->get_scheme_loci($scheme_id);
 	print $primary_key;
-	my @fields = ($primary_key);
+	my @fields = ( $primary_key, 'profile' );
+	my $locus_indices = $self->{'datastore'}->get_scheme_locus_indices($scheme_id);
+	my @order;
 	foreach my $locus (@$loci) {
 		my $locus_info = $self->{'datastore'}->get_locus_info( $locus, { set_id => $set_id } );
 		my $header_value = $locus_info->{'set_name'} // $locus;
 		print qq(\t$header_value);
-		my $cleaned = $self->{'datastore'}->get_scheme_warehouse_locus_name( $scheme_id, $locus );
-		push @fields, $cleaned;
+		push @order, $locus_indices->{$locus};
 	}
 	foreach my $field (@$scheme_fields) {
 		next if $field eq $primary_key;
@@ -83,8 +85,10 @@ sub print_content {
 	local $" = qq(\t);
 	{
 		no warnings 'uninitialized';    #scheme field values may be undefined
-		foreach my $profile (@$data) {
-			say qq(@$profile);
+		foreach my $definition (@$data) {
+			my $pk      = shift @$definition;
+			my $profile = shift @$definition;
+			say qq($pk\t@$profile[@order]\t@$definition);
 		}
 	}
 	return;

lib/BIGSdb/REST/Routes/Profiles.pm

@@ -44,8 +44,7 @@ sub _get_profiles {
 	my $pages            = ceil( $profile_count / $self->{'page_size'} );
 	my $offset           = ( $page - 1 ) * $self->{'page_size'};
 	my $pk_info          = $self->{'datastore'}->get_scheme_field_info( $scheme_id, $scheme_info->{'primary_key'} );
-	$qry =
-	  $self->add_filters( "SELECT $scheme_info->{'primary_key'} FROM $scheme_warehouse", $allowed_filters );
+	$qry = $self->add_filters( "SELECT $scheme_info->{'primary_key'} FROM $scheme_warehouse", $allowed_filters );
 	$qry .= ' ORDER BY '
 	  . (
 		$pk_info->{'type'} eq 'integer'
@@ -74,23 +73,21 @@ sub _get_profiles_csv {
 	my ( $db, $scheme_id ) = @{$params}{qw(db scheme_id)};
 	my $allowed_filters = [qw(added_after updated_after)];
 	$self->check_scheme( $scheme_id, { pk => 1 } );
-	my $set_id      = $self->get_set_id;
-	my $scheme_info = $self->{'datastore'}->get_scheme_info( $scheme_id, { set_id => $set_id, get_pk => 1 } );
-	my $primary_key = $scheme_info->{'primary_key'};
-	if ( !$scheme_info ) {
-		send_error( "Scheme $scheme_id does not exist.", 404 );
-	} elsif ( !$primary_key ) {
-		send_error( "Scheme $scheme_id does not have a primary key field.", 404 );
-	}
+	my $set_id        = $self->get_set_id;
+	my $scheme_info   = $self->{'datastore'}->get_scheme_info( $scheme_id, { set_id => $set_id, get_pk => 1 } );
+	my $primary_key   = $scheme_info->{'primary_key'};
 	my @heading       = ( $scheme_info->{'primary_key'} );
 	my $loci          = $self->{'datastore'}->get_scheme_loci($scheme_id);
 	my $scheme_fields = $self->{'datastore'}->get_scheme_fields($scheme_id);
-	my @fields        = ( $scheme_info->{'primary_key'} );
+	my @fields        = ( $scheme_info->{'primary_key'}, 'profile' );
+	my $locus_indices = $self->{'datastore'}->get_scheme_locus_indices($scheme_id);
+	my @order;
+
 	foreach my $locus (@$loci) {
 		my $locus_info = $self->{'datastore'}->get_locus_info( $locus, { set_id => $set_id } );
 		my $header_value = $locus_info->{'set_name'} // $locus;
 		push @heading, $header_value;
-		push @fields, $self->{'datastore'}->get_scheme_warehouse_locus_name( $scheme_id, $locus );
+		push @order,   $locus_indices->{$locus};
 	}
 	foreach my $field (@$scheme_fields) {
 		next if $field eq $scheme_info->{'primary_key'};
@@ -112,8 +109,10 @@ sub _get_profiles_csv {
 	local $" = "\t";
 	{
 		no warnings 'uninitialized';    #scheme field values may be undefined
-		foreach my $profile (@$data) {
-			$buffer .= "@$profile\n";
+		foreach my $definition (@$data) {
+			my $pk      = shift @$definition;
+			my $profile = shift @$definition;
+			$buffer .= qq($pk\t@$profile[@order]\t@$definition\n);
 		}
 	}
 	send_file( \$buffer, content_type => 'text/plain; charset=UTF-8' );