lib/CXGN/Marker/SearchBrAPI.pm

   1 package CXGN::Marker::SearchBrAPI;
   2
   3 =head1 NAME
   4
   5 CXGN::Marker::SearchBrAPI - an object to handle searching for markers given criteria
   6
   7 =head1 USAGE
   8
   9 my $marker_search = CXGN::Marker::SearchBrAPI->new({
  10     bcs_schema=>$schema,
  11     marker_ids=>\@marker_ids,
  12     marker_names=>\@marker_names,
  13     get_synonyms=>$synonyms,
  14     match_method=>$method,
  15     types=>\@types,
  16     offset=>$page_size*$page,
  17     limit=>$page_size
  18 });
  19 my ($result, $total_count) = $marker_search->search();
  20
  21 =head1 DESCRIPTION
  22
  23
  24 =head1 AUTHORS
  25
  26
  27 =cut
  28
  29 use strict;
  30 use warnings;
  31 use Moose;
  32 use Try::Tiny;
  33 use Data::Dumper;
  34
  35 use CXGN::Marker;
  36 use CXGN::Marker::LocMarker;
  37 use CXGN::Marker::Tools qw(clean_marker_name);
  38 use SGN::Model::Cvterm;
  39 use CXGN::Trial;
  40 use JSON;
  41
  42 has 'bcs_schema' => (
  43     isa => 'Bio::Chado::Schema',
  44     is => 'rw',
  45     required => 1,
  46 );
  47
  48 has 'nd_protocol_id' => (
  49     isa => 'Int',
  50     is => 'rw',
  51 );
  52
  53 has 'marker_ids' => (
  54     isa => 'ArrayRef[Int]|Undef',
  55     is => 'rw',
  56 );
  57
  58 has 'marker_names' => (
  59     isa => 'ArrayRef[Str]|Undef',
  60     is => 'rw'
  61 );
  62
  63 has 'marker_name_list' => (
  64     isa => 'ArrayRef[Str]|Undef',
  65     is => 'rw'
  66 );
  67
  68 has 'get_synonyms' => (
  69     isa => 'Bool|Undef',
  70     is => 'rw',
  71     default => 0
  72 );
  73
  74 has 'match_method' => (
  75     isa => 'Str|Undef',
  76     is => 'rw'
  77 );
  78
  79 has 'project_id_list' => (
  80     isa => 'ArrayRef[Int]',
  81     is => 'rw',
  82 );
  83
  84 has 'protocol_id_list' => (
  85     isa => 'ArrayRef[Int]',
  86     is => 'rw',
  87 );
  88
  89 has 'protocol_name_list' => (
  90     isa => 'ArrayRef[Str]|Undef',
  91     is => 'rw',
  92 );
  93
  94 has 'protocolprop_marker_hash_select' => (
  95     isa => 'ArrayRef[Str]',
  96     is => 'ro',
  97     default => sub {['name', 'chrom', 'pos', 'alt', 'ref', 'qual', 'filter', 'info', 'format']} #THESE ARE ALL POSSIBLE PROTOCOLPROP MARKER HASH KEYS BASED ON VCF LOADING
  98 );
  99
 100 has 'reference_genome_name' => (
 101     isa => 'Str',
 102     is => 'rw'
 103 );
 104
 105 has 'types' => (
 106     isa => 'ArrayRef[Int]|Undef',
 107     is => 'rw'
 108 );
 109
 110 has 'limit' => (
 111     isa => 'Int|Undef',
 112     is => 'rw'
 113 );
 114
 115 has 'offset' => (
 116     isa => 'Int|Undef',
 117     is => 'rw'
 118 );
 119
 120
 121 sub searchv1 {
 122     my $self = shift;
 123     my $schema = $self->bcs_schema();
 124     my $marker_ids = $self->marker_ids;
 125     my $marker_names = $self->marker_names;
 126     my $get_synonyms = $self->get_synonyms;
 127     my $match_method = $self->match_method;
 128     my $types = $self->types;
 129     my $limit = $self->limit;
 130     my $offset = $self->offset;
 131     my @where_clause;
 132     my $comparison;
 133
 134     if ($match_method eq 'exact'){ $comparison = 'in';}
 135     elsif ($match_method eq 'case_insensitive'){ $comparison = 'ilike'; }
 136     else { $comparison = 'like'; }
 137
 138     if ($marker_ids && scalar(@$marker_ids)>0) {
 139         my $sql = join ("," , @$marker_ids);
 140         push @where_clause, "marker.marker_id in ($sql)";
 141     }
 142
 143     if ($marker_names && scalar(@$marker_names)>0) {
 144         my $sql = join ("," , @$marker_names);
 145         push @where_clause, "marker_names.name in ($sql)";
 146     }
 147
 148     if ($types && scalar(@$types)>0) {
 149         my $sql = join ("," , @$types);
 150         push @where_clause, "protocol in ($sql)";
 151     }
 152
 153     my $where_clause = scalar(@where_clause)>0 ? " WHERE " . (join (" AND " , @where_clause)) : '';
 154
 155
 156     my $subquery = "SELECT distinct m2m.marker_id,name,alias,protocol,organism_name,common_name.common_name FROM sgn.marker
 157         LEFT JOIN sgn.marker_to_map as m2m using(marker_id)
 158         INNER JOIN sgn.accession ON(parent_1 = accession.accession_id OR parent_2 = accession.accession_id)
 159         INNER JOIN sgn.organism using(organism_id)
 160         INNER JOIN sgn.common_name USING(common_name_id)
 161         INNER JOIN marker_names ON(m2m.marker_id=marker_names.marker_id)
 162         INNER JOIN marker_alias ON(m2m.marker_id=marker_alias.marker_id) $where_clause";
 163
 164     my $h = $schema->storage->dbh()->prepare($subquery);
 165     $h->execute();
 166
 167     my @result;
 168     my $total_count = 0;
 169     my $subtract_count = 0;
 170
 171     while (my ($marker_id, $marker_name, $reference, $alias, $protocol, $full_count) = $h->fetchrow_array()) {
 172         push @result, {
 173             marker_id => $marker_id,
 174             marker_name => $marker_name,
 175             method => $protocol,
 176             references => $reference,
 177             synonyms => $alias,
 178             type => $protocol
 179         };
 180         $total_count = $full_count;
 181     }
 182
 183     my @data_window;
 184     if (($limit && defined($limit) || ($offset && defined($offset)))){
 185         my $start = $offset;
 186         my $end = $offset + $limit - 1;
 187         for( my $i = $start; $i <= $end; $i++ ) {
 188             if ($result[$i]) {
 189                 push @data_window, $result[$i];
 190             }
 191         }
 192     } else {
 193         @data_window = @result;
 194     }
 195
 196     $total_count = $total_count-$subtract_count;
 197     return (\@data_window, $total_count);
 198
 199 }
 200
 201
 202 sub search {
 203     my $self = shift;
 204     my $schema = $self->bcs_schema;
 205     my $protocol_id_list = $self->protocol_id_list;
 206     my $protocol_name_list = $self->protocol_name_list;
 207     my $marker_name_list = $self->marker_name_list;
 208     my $protocolprop_marker_hash_select = $self->protocolprop_marker_hash_select;
 209     my $project_id_list = $self->project_id_list;
 210     my $limit = $self->limit;
 211     my $offset = $self->offset;
 212     my @data;
 213     my %search_params;
 214     my @where_clause;
 215     my $where;
 216     my @or_clause;
 217
 218     my $snp_genotyping_cvterm_id = SGN::Model::Cvterm->get_cvterm_row($self->bcs_schema, 'snp genotyping', 'genotype_property')->cvterm_id();
 219     my $vcf_snp_genotyping_cvterm_id = SGN::Model::Cvterm->get_cvterm_row($self->bcs_schema, 'vcf_snp_genotyping', 'genotype_property')->cvterm_id();
 220     my $vcf_map_details_cvterm_id = SGN::Model::Cvterm->get_cvterm_row($self->bcs_schema, 'vcf_map_details', 'protocol_property')->cvterm_id();
 221     my $vcf_map_details_markers_cvterm_id = SGN::Model::Cvterm->get_cvterm_row($self->bcs_schema, 'vcf_map_details_markers', 'protocol_property')->cvterm_id();
 222     my $vcf_map_details_markers_array_cvterm_id = SGN::Model::Cvterm->get_cvterm_row($self->bcs_schema, 'vcf_map_details_markers_array', 'protocol_property')->cvterm_id();
 223     my $igd_genotypeprop_cvterm_id = SGN::Model::Cvterm->get_cvterm_row($self->bcs_schema, 'igd number', 'genotype_property')->cvterm_id();
 224     my $accession_cvterm_id = SGN::Model::Cvterm->get_cvterm_row($self->bcs_schema, 'accession', 'stock_type')->cvterm_id();
 225     my $tissue_sample_cvterm_id = SGN::Model::Cvterm->get_cvterm_row($self->bcs_schema, 'tissue_sample', 'stock_type')->cvterm_id();
 226     my $tissue_sample_of_cvterm_id = SGN::Model::Cvterm->get_cvterm_row($self->bcs_schema, 'tissue_sample_of', 'stock_relationship')->cvterm_id();
 227
 228     my $protocol_where = "";
 229     if ($protocol_id_list && scalar(@$protocol_id_list)>0) {
 230         my $protocol_sql = join ("," , @$protocol_id_list);
 231         $protocol_where = "nd_protocolprop.nd_protocol_id in ($protocol_sql)";
 232         push @where_clause, $protocol_where;
 233     }
 234
 235     if ($marker_name_list && scalar(@$marker_name_list)>0) {
 236         foreach (@$marker_name_list) {
 237             push @or_clause, " s.key = '$_'";
 238         }
 239     }
 240     push @where_clause, "nd_protocolprop.type_id = $vcf_map_details_markers_cvterm_id";
 241
 242     my $where_clause = " WHERE " . (join (" AND " , @where_clause));
 243     if (scalar(@or_clause) == 1 ) {
 244         $where_clause .=  " AND " . (join (" OR " , @or_clause))."  ";
 245     } elsif (scalar(@or_clause) > 1) {
 246         $where_clause .=  " AND (" . (join (" OR " , @or_clause))." ) ";
 247     }
 248
 249     my $project_where = "";
 250     if ($project_id_list && scalar(@$project_id_list)>0) {
 251         my $project_sql = join ("," , @$project_id_list);
 252         $project_where = " and project_id in ($project_sql)";
 253     }
 254
 255     my $offset_clause = '';
 256     my $limit_clause = '';
 257     if ($limit){
 258         $limit_clause = " LIMIT $limit ";
 259     }
 260     if ($offset){
 261         $offset_clause = " OFFSET $offset ";
 262     }
 263
 264     my @protocolprop_marker_hash_select_arr;
 265     foreach (@$protocolprop_marker_hash_select){
 266         push @protocolprop_marker_hash_select_arr, "s.value->>'$_'";
 267     }
 268     my $protocolprop_hash_select_sql = scalar(@protocolprop_marker_hash_select_arr) > 0 ? ', '.join ',', @protocolprop_marker_hash_select_arr : '';
 269
 270     my $protocolprop_q = "SELECT nd_protocolprop.nd_protocol_id, s.key, array_agg(project.project_id)
 271         $protocolprop_hash_select_sql
 272         FROM nd_protocolprop, jsonb_each(nd_protocolprop.value) as s,  (select DISTINCT nd_experiment_project.project_id as project_id, nd_experiment_protocol.nd_protocol_id from  nd_experiment_protocol
 273         inner join nd_experiment ON(nd_experiment.nd_experiment_id = nd_experiment_protocol.nd_experiment_id )
 274         inner join nd_experiment_project ON(nd_experiment_project.nd_experiment_id = nd_experiment_protocol.nd_experiment_id))  project
 275         $where_clause and nd_protocolprop.nd_protocol_id = project.nd_protocol_id  $project_where
 276         GROUP BY nd_protocolprop.nd_protocol_id, nd_protocolprop.value, s.key $protocolprop_hash_select_sql
 277         ORDER BY s.key ASC
 278         $limit_clause
 279         $offset_clause;";
 280
 281     my $protocolprop_h = $schema->storage->dbh()->prepare($protocolprop_q);
 282     $protocolprop_h->execute();
 283     my @results;
 284     my $total_marker_count = 0;
 285
 286     while (my ($protocol_id, $marker_name, $project_id, @protocolprop_info_return) = $protocolprop_h->fetchrow_array()) {
 287         my $marker_obj = {
 288             nd_protocol_id => $protocol_id,
 289             marker_name => $marker_name,
 290             project_id => $project_id
 291         };
 292         for my $s (0 .. scalar(@protocolprop_marker_hash_select_arr)-1){
 293             $marker_obj->{$protocolprop_marker_hash_select->[$s]} = $protocolprop_info_return[$s];
 294         }
 295         push @results, $marker_obj;
 296         $total_marker_count++;
 297     }
 298
 299     return (\@results, $total_marker_count);
 300 }
 301
 302 1;