Commit 55e64f47 authored by Keith Jolley's avatar Keith Jolley

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

parent b0698dd1
......@@ -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;
......
......@@ -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' );
......
Markdown is supported
0% or
You are about to add 0 people to the discussion. Proceed with caution.
Finish editing this message first!
Please register or to comment