lib/CXGN/BreederSearch.pm

   1 =head1 NAME
   2
   3 CXGN::BreederSearch - class for retrieving breeder information for the breeder search wizard
   4
   5 =head1 AUTHORS
   6
   7 Lukas Mueller <lam87@cornell.edu>
   8 Aimin Yan <ay247@cornell.edu>
   9
  10 =head1 METHODS
  11
  12 =cut
  13
  14 package CXGN::BreederSearch;
  15
  16 use Moose;
  17 use Data::Dumper;
  18 use Try::Tiny;
  19
  20 has 'dbh' => (
  21     is  => 'rw',
  22     required => 1,
  23     );
  24 has 'dbname' => (
  25     is => 'rw',
  26     isa => 'Str',
  27     );
  28
  29 =head2 metadata_query
  30
  31  Usage:        my %info = $bs->metadata_query($criteria_list, $dataref, $queryref);
  32  Desc:
  33  Ret:          returns a hash with a key called results that contains
  34                a listref of listrefs specifying the matching list with ids
  35                and names.
  36  Args:         criteria_list: a comma separated string called a criteria_list,
  37                listing all the criteria that need to be applied. Possible
  38                criteria are trials, years, traits, and locations. The last
  39                criteria in the list is the return type.
  40                dataref: The dataref is a hashref of hashrefs. The first key
  41                is the target of the transformation, and the second is the
  42                source type of the transformation, containing comma separated
  43                values of the source type.
  44                queryref: same structure as dataref, but instead of storing ids it stores a
  45                1 if user requested intersect, or 0 for default union
  46  Side Effects: will run refresh_matviews() if matviews aren't already populated
  47  Example:
  48
  49 =cut
  50
  51 sub metadata_query {
  52   my $self = shift;
  53   my $c = shift;
  54   my $criteria_list = shift;
  55   my $dataref = shift;
  56   my $queryref = shift;
  57   my $h;
  58   print STDERR "criteria_list=" . Dumper($criteria_list);
  59   print STDERR "dataref=" . Dumper($dataref);
  60   print STDERR "queryref=" . Dumper($queryref);
  61
  62   # Check if matviews are populated, and run refresh if they aren't. Which, as of postgres 9.5, will be the case when our databases are loaded from a dump. This should no longer be necessary once this bug is fixed in newer postgres versions
  63   my ($status, %response_hash);
  64   try {
  65     my $populated_query = "select * from materialized_phenoview limit 1";
  66     my $sth = $self->dbh->prepare($populated_query);
  67     $sth->execute();
  68   } catch { #if test query fails because views aren't populated
  69     print STDERR "Using basic refresh to populate views . . .\n";
  70     $status = $self->refresh_matviews($c->config->{dbhost}, $c->config->{dbname}, $c->config->{dbuser}, $c->config->{dbpass}, 'basic');
  71     %response_hash = %$status;
  72   };
  73
  74   if (%response_hash && $response_hash{'message'} eq 'Wizard update completed!') {
  75     print STDERR "Populated views, now proceeding with query . . . .\n";
  76   } elsif (%response_hash && $response_hash{'message'} eq 'Wizard update initiated.') {
  77     return { error => "The search wizard is temporarily unavailable while database indexes are being repopulated. Please try again later. Depending on the size of the database, it will be ready within a few seconds to an hour."};
  78   } elsif (%response_hash && $response_hash{'error'}) {
  79     return { error => $response_hash{'error'} };
  80   }
  81
  82   my $target_table = $criteria_list->[-1];
  83   print STDERR "target_table=". $target_table . "\n";
  84   my $target = $target_table;
  85   $target =~ s/s$//;
  86
  87   my $select = "SELECT ".$target."_id, ".$target."_name ";
  88   my $group = "GROUP BY ".$target."_id, ".$target."_name ";
  89
  90   my $full_query;
  91   if (!$dataref->{"$target_table"}) {
  92     my $from = "FROM public.". $target_table;
  93     my $where = " WHERE ".$target."_id IS NOT NULL";
  94           $full_query = $select . $from . $where;
  95   }
  96   else {
  97           my @queries;
  98           foreach my $category (@$criteria_list) {
  99
 100       if ($dataref->{$criteria_list->[-1]}->{$category}) {
 101         my $query;
 102                     my @categories = ($target_table, $category);
 103               @categories = sort @categories;
 104               my $from = "FROM public.". $categories[0] ."x". $categories[1] . " JOIN public." . $target_table . " USING(" . $target."_id) ";
 105         my $criterion = $category;
 106         $criterion =~ s/s$//;
 107         my $intersect = $queryref->{$criteria_list->[-1]}->{$category};
 108
 109         if ($intersect) {
 110           my @parts;
 111           my @ids = split(/,/, $dataref->{$criteria_list->[-1]}->{$category});
 112           foreach my $id (@ids) {
 113             my $where = "WHERE ". $criterion. "_id IN (". $id .") ";
 114             my $statement = $select . $from . $where . $group;
 115             push @parts, $statement;
 116           }
 117           $query = join (" INTERSECT ", @parts);
 118           push @queries, $query;
 119         }
 120         else {
 121           my $where = "WHERE ". $criterion. "_id IN (" . $dataref->{$criteria_list->[-1]}->{$category} . ") ";
 122           $query = $select . $from . $where . $group;
 123           push @queries, $query;
 124         }
 125       }
 126     }
 127     $full_query = join (" INTERSECT ", @queries);
 128   }
 129   $full_query .= " ORDER BY 2";
 130   print STDERR "QUERY: $full_query\n";
 131   $h = $self->dbh->prepare($full_query);
 132   $h->execute();
 133
 134   my @results;
 135   while (my ($id, $name) = $h->fetchrow_array()) {
 136     push @results, [ $id, $name ];
 137   }
 138
 139   if (@results >= 10_000) {
 140     return { error => scalar(@results).' matches. Too many results to display' };
 141   }
 142   elsif (@results < 1) {
 143     return { error => scalar(@results).' matches. No results to display' };
 144   }
 145   else {
 146     return { results => \@results };
 147   }
 148 }
 149
 150 =head2 avg_phenotypes_query
 151
 152 parameters: trait_id, trial_id, allow_missing
 153
 154 returns: values, the avg pheno value of each accession in a trial for the given trait, and column_names, an array of the trait names
 155
 156 Side Effects: none
 157
 158 =cut
 159
 160 sub avg_phenotypes_query {
 161   my $self = shift;
 162   my $trial_id = shift;
 163   my $trait_ids = shift;
 164   my $weights = shift;
 165   my $allow_missing = shift;
 166   my $reference_accession = shift;
 167
 168
 169   my $select = "SELECT table0.accession_id, table0.accession_name";
 170   my $from = " FROM (SELECT accession_id, accession_name FROM materialized_phenoview WHERE trial_id = $trial_id GROUP BY 1,2) AS table0";
 171   for (my $i = 1; $i <= scalar @$trait_ids; $i++) {
 172     $select .= ",  ROUND( CAST(table$i.trait$i AS NUMERIC), 2)";
 173     $from .= " JOIN (SELECT accession_id, accession_name, AVG(phenotype_value::REAL) AS trait$i FROM materialized_phenoview WHERE trial_id = $trial_id AND trait_id = ? GROUP BY 1,2) AS table$i USING (accession_id)";
 174   }
 175   my $query = $select . $from . " ORDER BY 2";
 176   if ($allow_missing eq 'true') { $query =~ s/JOIN/FULL OUTER JOIN/g; }
 177
 178   print STDERR "QUERY: $query\n";
 179
 180   my $h = $self->dbh->prepare($query);
 181   $h->execute(@$trait_ids);
 182
 183   my @weights = @$weights;
 184   my (@raw_avg_values, @reference_values, @rows_to_scale, @weighted_values);
 185
 186   if ($reference_accession) {
 187
 188     while (my @row = $h->fetchrow_array()) {
 189       push @rows_to_scale, @row;
 190       my ($id, $name, @avg_values) = @row;
 191       if ($id == $reference_accession) { @reference_values = @avg_values; }
 192     }
 193
 194     print STDERR "reference accession id = $reference_accession and reference values = @reference_values\n";
 195
 196     $h->execute(@$trait_ids);
 197     while (my ($id, $name, @avg_values) = $h->fetchrow_array()) {
 198
 199       my @scaled_values = map {sprintf("%.2f", $avg_values[$_] / $reference_values[$_])} 0..$#avg_values;
 200       my @scaled_and_weighted = map {sprintf("%.2f", $scaled_values[$_] * $weights[$_])} 0..$#scaled_values;
 201       unshift @scaled_values, '<a href="/stock/'.$id.'/view">'.$name.'</a>';
 202       unshift @scaled_and_weighted, '<a href="/stock/'.$id.'/view">'.$name.'</a>';
 203
 204       push @raw_avg_values, [@scaled_values];
 205
 206       my $sum;
 207       map { $sum += $_ } @scaled_and_weighted;
 208       my $rounded_sum = sprintf("%.2f", $sum);
 209       push @scaled_and_weighted, $rounded_sum;
 210       push @weighted_values, [@scaled_and_weighted];
 211     }
 212
 213   } else {
 214
 215   while (my ($id, $name, @avg_values) = $h->fetchrow_array()) {
 216
 217     my @values_to_weight = @avg_values;
 218     unshift @avg_values, '<a href="/stock/'.$id.'/view">'.$name.'</a>';
 219     push @raw_avg_values, [@avg_values];
 220
 221     @values_to_weight = map {$values_to_weight[$_] * $weights[$_]} 0..$#values_to_weight;
 222     my $sum;
 223     map { $sum += $_ } @values_to_weight;
 224     unshift @values_to_weight, '<a href="/stock/'.$id.'/view">'.$name.'</a>';
 225     my $rounded_sum = sprintf("%.2f", $sum);
 226     push @values_to_weight, $rounded_sum;
 227     push @weighted_values, [@values_to_weight];
 228   }
 229
 230 }
 231
 232   my @weighted_values2 = sort { $b->[-1] <=> $a->[-1] } @weighted_values;
 233   my @weighted_values3;
 234   for (my $i = 0; $i < scalar @weighted_values2; $i++ ) {
 235     my $temp_array = $weighted_values2[$i];
 236     my @temp_array = @$temp_array;
 237     push @temp_array, $i+1;
 238     push @weighted_values3, [@temp_array];
 239   }
 240
 241   print STDERR "avg_phenotypes: ".Dumper(@raw_avg_values);
 242   print STDERR "avg_phenotypes: ".Dumper(@weighted_values3);
 243
 244   return {
 245     raw_avg_values => \@raw_avg_values,
 246     weighted_values => \@weighted_values3
 247   };
 248
 249 }
 250
 251 =head2 refresh_matviews
 252
 253 parameters: string to specify desired refresh type, basic or concurrent. defaults to concurrent
 254
 255 returns: message detailing success or error
 256
 257 Side Effects: Refreshes materialized views
 258
 259 =cut
 260
 261 sub refresh_matviews {
 262
 263   my $self = shift;
 264   my $dbhost = shift;
 265   my $dbname = shift;
 266   my $dbuser = shift;
 267   my $dbpass = shift;
 268   my $refresh_type = shift || 'concurrent';
 269   my $refresh_finished = 0;
 270   my $async_refresh;
 271
 272   my $q = "SELECT currently_refreshing FROM public.matviews WHERE mv_id=?";
 273   my $h = $self->dbh->prepare($q);
 274   $h->execute(1);
 275
 276   my $refreshing = $h->fetchrow_array();
 277
 278   if ($refreshing) {
 279     return { error => 'Wizard update already in progress . . . ' };
 280   }
 281   else {
 282     try {
 283       my $dbh = $self->dbh();
 284       if ($refresh_type eq 'concurrent') {
 285         #print STDERR "Using CXGN::Tools::Run to run perl bin/refresh_matviews.pl -H $dbhost -D $dbname -U $dbuser -P $dbpass -c";
 286         $async_refresh = CXGN::Tools::Run->run_async("perl bin/refresh_matviews.pl -H $dbhost -D $dbname -U $dbuser -P $dbpass -c");
 287       } else {
 288         print STDERR "Using CXGN::Tools::Run to run perl bin/refresh_matviews.pl -H $dbhost -D $dbname -U $dbuser -P $dbpass";
 289         $async_refresh = CXGN::Tools::Run->run_async("perl bin/refresh_matviews.pl -H $dbhost -D $dbname -U $dbuser -P $dbpass");
 290       }
 291
 292       for (my $i = 1; $i < 10; $i++) {
 293         sleep($i/5);
 294         if ($async_refresh->alive) {
 295           next;
 296         } else {
 297           $refresh_finished = 1;
 298         }
 299       }
 300
 301       if ($refresh_finished) {
 302         return { message => 'Wizard update completed!' };
 303       } else {
 304         return { message => 'Wizard update initiated.' };
 305       }
 306     } catch {
 307       print STDERR 'Error initiating wizard update.' . $@ . "\n";
 308       return { error => 'Error initiating wizard update.' . $@ };
 309     }
 310   }
 311 }
 312
 313 =head2 matviews_status
 314
 315 Desc: checks tracking table to see if materialized views are updating, and if not, when they were last updated.
 316
 317 parameters: None.
 318
 319 returns: refreshing message or timestamp
 320
 321 Side Effects: none
 322
 323 =cut
 324
 325 sub matviews_status {
 326   my $self = shift;
 327   my $q = "SELECT currently_refreshing, last_refresh FROM public.matviews WHERE mv_id=?";
 328   my $h = $self->dbh->prepare($q);
 329   $h->execute(1);
 330
 331   my ($refreshing, $timestamp) = $h->fetchrow_array();
 332
 333   if ($refreshing) {
 334     print STDERR "Wizard is already refreshing, current status: $refreshing \n";
 335     return { refreshing => "<p id='wizard_status'>Wizard update in progress . . . </p>"};
 336   }
 337   else {
 338     print STDERR "materialized fullview last updated $timestamp\n";
 339     return { timestamp => "<p id='wizard_status'>Wizard last updated: $timestamp</p>" };
 340   }
 341 }
 342
 343 sub get_phenotype_info {
 344     my $self = shift;
 345     my $accession_sql = shift;
 346     my $trial_sql = shift;
 347     my $trait_sql = shift;
 348
 349     print STDERR "GET_PHENOTYPE_INFO: $accession_sql - $trial_sql - $trait_sql \n\n";
 350
 351     my $rep_type_id = $self->get_stockprop_type_id("replicate");
 352     my $block_number_type_id = $self -> get_stockprop_type_id("block");
 353     my $year_type_id = $self->get_projectprop_type_id("project year");
 354     my $plot_type_id = $self->get_stock_type_id("plot");
 355     my $plant_type_id = $self->get_stock_type_id("plant");
 356     my $accession_type_id = $self->get_stock_type_id("accession");
 357
 358     my @where_clause = ();
 359     if ($accession_sql) { push @where_clause,  "stock.stock_id in ($accession_sql)"; }
 360     if ($trial_sql) { push @where_clause, "project.project_id in ($trial_sql)"; }
 361     if ($trait_sql) { push @where_clause, "cvterm.cvterm_id in ($trait_sql)"; }
 362
 363     my $where_clause = "";
 364
 365     if (@where_clause>0) {
 366         $where_clause .= $rep_type_id ? "WHERE (stockprop.type_id = $rep_type_id OR stockprop.type_id IS NULL) " : "WHERE stockprop.type_id IS NULL";
 367         $where_clause .= "AND (plot.type_id = $plot_type_id OR plot.type_id = $plant_type_id) AND stock.type_id = $accession_type_id";
 368         $where_clause .= $block_number_type_id  ? " AND (block_number.type_id = $block_number_type_id OR block_number.type_id IS NULL)" : " AND block_number.type_id IS NULL";
 369         $where_clause .= $year_type_id ? " AND projectprop.type_id = $year_type_id" :"" ;
 370         $where_clause .= " AND " . (join (" AND " , @where_clause));
 371
 372         #$where_clause = "where (stockprop.type_id=$rep_type_id or stockprop.type_id IS NULL) AND (block_number.type_id=$block_number_type_id or block_number.type_id IS NULL) AND  ".(join (" and ", @where_clause));
 373     }
 374
 375     my $order_clause = " order by project.name, string_to_array(plot_number.value, '.')::int[]";
 376     my $q = "SELECT projectprop.value, project.name, stock.uniquename, nd_geolocation.description, cvterm.name, phenotype.value, plot.uniquename, db.name, db.name ||  ':' || dbxref.accession AS accession, stockprop.value, block_number.value, cvterm.cvterm_id, project.project_id, nd_geolocation.nd_geolocation_id, stock.stock_id, plot.stock_id, phenotype.uniquename
 377              FROM stock as plot JOIN stock_relationship ON (plot.stock_id=subject_id)
 378              JOIN stock ON (object_id=stock.stock_id)
 379              LEFT JOIN stockprop ON (plot.stock_id=stockprop.stock_id)
 380              LEFT JOIN stockprop AS block_number ON (plot.stock_id=block_number.stock_id)
 381              LEFT JOIN stockprop AS plot_number ON (plot.stock_id=plot_number.stock_id) AND plot_number.type_id = (SELECT cvterm_id from cvterm where cvterm.name = 'plot number')
 382              JOIN nd_experiment_stock ON(nd_experiment_stock.stock_id=plot.stock_id)
 383              JOIN nd_experiment ON (nd_experiment_stock.nd_experiment_id=nd_experiment.nd_experiment_id)
 384              JOIN nd_geolocation USING(nd_geolocation_id)
 385              JOIN nd_experiment_phenotype ON (nd_experiment_phenotype.nd_experiment_id=nd_experiment.nd_experiment_id)
 386              JOIN phenotype USING(phenotype_id) JOIN cvterm ON (phenotype.cvalue_id=cvterm.cvterm_id)
 387              JOIN cv USING(cv_id)
 388              JOIN dbxref ON (cvterm.dbxref_id = dbxref.dbxref_id)
 389              JOIN db USING(db_id)
 390              JOIN nd_experiment_project ON (nd_experiment_project.nd_experiment_id=nd_experiment.nd_experiment_id)
 391              JOIN project USING(project_id)
 392   JOIN projectprop USING(project_id)
 393              $where_clause
 394              $order_clause";
 395
 396     #print STDERR "QUERY: $q\n\n";
 397     my $h = $self->dbh()->prepare($q);
 398     $h->execute();
 399
 400     my $result = [];
 401     while (my ($year, $project_name, $stock_name, $location, $trait, $value, $plot_name, $cv_name, $cvterm_accession, $rep, $block_number, $trait_id, $project_id, $location_id, $stock_id, $plot_id, $phenotype_uniquename) = $h->fetchrow_array()) {
 402         push @$result, [ $year, $project_name, $stock_name, $location, $trait, $value, $plot_name, $cv_name, $cvterm_accession, $rep, $block_number, $trait_id, $project_id, $location_id, $stock_id, $plot_id, $phenotype_uniquename ];
 403
 404     }
 405     #print STDERR Dumper $result;
 406     print STDERR "QUERY returned ".scalar(@$result)." rows.\n";
 407     return $result;
 408 }
 409
 410 sub get_phenotype_info_matrix {
 411     my $self = shift;
 412     my $accession_sql = shift;
 413     my $trial_sql = shift;
 414     my $trait_sql = shift;
 415
 416     my $data = $self->get_phenotype_info($accession_sql, $trial_sql, $trait_sql);
 417     #data contains [$year, $project_name, $stock_name, $location, $trait, $value, $plot_name, $cv_name, $cvterm_accession, $rep, $block_number, $trait_id, $project_id, $location_id, $stock_id, $plot_id]
 418
 419     my %plot_data;
 420     my %traits;
 421
 422     foreach my $d (@$data) {
 423         print STDERR "PRINTING TRAIT DATA FOR TERM " . $d->[4] . "\n\n";
 424         my $cvterm = $d->[4]."|".$d->[8];
 425         my $trait_data = $d->[5];
 426         my $plot = $d->[6];
 427         $plot_data{$plot}->{$cvterm} = $trait_data;
 428         $traits{$cvterm}++;
 429     }
 430
 431     my @info = ();
 432     my $line = "";
 433
 434     # generate header line
 435     #
 436     my @sorted_traits = sort keys(%traits);
 437     foreach my $trait (@sorted_traits) {
 438         $line .= "\t".$trait;  # first header has to be empty (plot name column)
 439     }
 440     push @info, $line;
 441
 442     # dump phenotypic values
 443     #
 444     my $count2 = 0;
 445     foreach my $plot (sort keys (%plot_data)) {
 446         $line = $plot;
 447
 448         foreach my $trait (@sorted_traits) {
 449             my $tab = $plot_data{$plot}->{$trait}; # ? "\t".$plot_data{$plot}->{$trait} : "\t";
 450             $line .= defined($tab) ? "\t".$tab : "\t";
 451
 452         }
 453         push @info, $line;
 454     }
 455
 456     return @info;
 457 }
 458
 459 sub get_extended_phenotype_info_matrix {
 460     my $self = shift;
 461     my $accession_sql = shift;
 462     my $trial_sql = shift;
 463     my $trait_sql = shift;
 464     my $include_timestamp = shift // 0;
 465
 466     my $data = $self->get_phenotype_info($accession_sql, $trial_sql, $trait_sql);
 467     #data contains [$year, $project_name, $stock_name, $location, $trait, $value, $plot_name, $cv_name, $cvterm_accession, $rep, $block_number, $trait_id, $project_id, $location_id, $stock_id, $plot_id, $phenotype_uniquename]
 468
 469     my %plot_data;
 470     my %traits;
 471
 472     print STDERR "No of lines retrieved: ".scalar(@$data)."\n";
 473     foreach my $d (@$data) {
 474
 475         my ($year, $project_name, $stock_name, $location, $trait, $trait_data, $plot, $cv_name, $cvterm_accession, $rep, $block_number, $trait_id, $project_id, $location_id, $stock_id, $plot_id, $phenotype_uniquename) = @$d;
 476
 477         my $cvterm = $d->[4]."|".$d->[8];
 478         if ($include_timestamp) {
 479             my ($p1, $p2) = split /date: /, $phenotype_uniquename;
 480             my ($timestamp, $p3) = split /  operator/, $p2;
 481             if( $timestamp =~ m/(\d{4})-(\d{2})-(\d{2}) (\d{2}):(\d{2}):(\d{2})(\S)(\d{4})/) {
 482                 $plot_data{$plot}->{$cvterm} = "$trait_data,$timestamp";
 483             } else {
 484                 $plot_data{$plot}->{$cvterm} = $trait_data;
 485             }
 486         } else {
 487             $plot_data{$plot}->{$cvterm} = $trait_data;
 488         }
 489
 490         if (!defined($rep)) { $rep = ""; }
 491         $plot_data{$plot}->{metadata} = {
 492             rep => $rep,
 493             studyName => $project_name,
 494             germplasmName => $stock_name,
 495             locationName => $location,
 496             blockNumber => $block_number,
 497             plotName => $plot,
 498             cvterm => $cvterm,
 499             trait_data => $trait_data,
 500             year => $year,
 501             cvterm_id => $trait_id,
 502             studyDbId => $project_id,
 503             locationDbId => $location_id,
 504             germplasmDbId => $stock_id,
 505             plotDbId => $plot_id
 506         };
 507         $traits{$cvterm}++;
 508     }
 509     #print STDERR Dumper \%plot_data;
 510
 511     my @info = ();
 512     my $line = join "\t", qw | studyYear studyDbId studyName locationDbId locationName germplasmDbId germplasmName plotDbId plotName rep blockNumber |;
 513
 514     # generate header line
 515     #
 516     my @sorted_traits = sort keys(%traits);
 517     foreach my $trait (@sorted_traits) {
 518         $line .= "\t".$trait;
 519     }
 520     push @info, $line;
 521
 522     # dump phenotypic values
 523     #
 524     my $count2 = 0;
 525
 526     my @unique_plot_list = ();
 527     foreach my $d (keys \%plot_data) {
 528         push @unique_plot_list, $d;
 529     }
 530     #print STDERR Dumper \@unique_plot_list;
 531
 532     foreach my $p (@unique_plot_list) {
 533       #$line = join "\t", map { $plot_data{$p}->{metadata}->{$_} } ( "year", "trial_name", "location", "accession", "plot", "rep", "block_number" );
 534       $line = join "\t", map { $plot_data{$p}->{metadata}->{$_} } ( "year", "studyDbId", "studyName", "locationDbId", "locationName", "germplasmDbId", "germplasmName", "plotDbId", "plotName", "rep", "blockNumber" );
 535
 536       #print STDERR "Adding line for plot $p\n";
 537       foreach my $trait (@sorted_traits) {
 538         my $tab = $plot_data{$p}->{$trait};
 539         $line .= defined($tab) ? "\t".$tab : "\t";
 540       }
 541       push @info, $line;
 542     }
 543
 544     return @info;
 545 }
 546
 547
 548
 549 =head2 get_genotype_info
 550
 551 parameters: comma-separated lists of accession, trial, and trait IDs. May be empty.
 552
 553 returns: an array with genotype information
 554
 555 =cut
 556
 557 sub get_genotype_info {
 558
 559     my $self = shift;
 560     my $accession_idref = shift;
 561     my $protocol_id = shift;
 562     my $snp_genotype_id = shift || '76434';
 563     my @accession_ids = @$accession_idref;
 564     my ($q, @result, $protocol_name);
 565
 566     if (@accession_ids) {
 567       $q = "SELECT name, uniquename, value FROM (SELECT nd_protocol.name, stock.uniquename, genotypeprop.value, row_number() over (partition by stock.uniquename order by genotypeprop.genotype_id) as rownum from genotypeprop join nd_experiment_genotype USING (genotype_id) JOIN nd_experiment_protocol USING(nd_experiment_id) JOIN nd_protocol USING(nd_protocol_id) JOIN nd_experiment_stock USING(nd_experiment_id) JOIN stock USING(stock_id) WHERE genotypeprop.type_id = ? AND stock.stock_id in (@{[join',', ('?') x @accession_ids]}) AND nd_experiment_protocol.nd_protocol_id=?) tmp WHERE rownum <2";
 568     }
 569     print STDERR "QUERY: $q\n\n";
 570
 571     my $h = $self->dbh()->prepare($q);
 572     $h->execute($snp_genotype_id, @accession_ids,$protocol_id);
 573
 574
 575     while (my($name,$uniquename,$genotype_string) = $h->fetchrow_array()) {
 576       push @result, [ $uniquename, $genotype_string ];
 577       $protocol_name = $name;
 578     }
 579
 580     return {
 581       protocol_name => $protocol_name,
 582       genotypes => \@result
 583     };
 584 }
 585
 586
 587 sub get_type_id {
 588     my $self = shift;
 589     my $term = shift;
 590     my $q = "SELECT projectprop.type_id FROM projectprop JOIN cvterm on (projectprop.type_id=cvterm.cvterm_id) WHERE cvterm.name='$term'";
 591     my $h = $self->dbh->prepare($q);
 592     $h->execute();
 593     my ($type_id) = $h->fetchrow_array();
 594     return $type_id;
 595 }
 596
 597
 598 sub get_stock_type_id {
 599     my $self = shift;
 600     my $term =shift;
 601     my $q = "SELECT stock.type_id FROM stock JOIN cvterm on (stock.type_id=cvterm.cvterm_id) WHERE cvterm.name='$term'";
 602     my $h = $self->dbh->prepare($q);
 603     $h->execute();
 604     my ($type_id) = $h->fetchrow_array();
 605     return $type_id;
 606 }
 607
 608 sub get_stockprop_type_id {
 609     my $self = shift;
 610     my $term = shift;
 611     my $q = "SELECT stockprop.type_id FROM stockprop JOIN cvterm on (stockprop.type_id=cvterm.cvterm_id) WHERE cvterm.name=?";
 612     my $h = $self->dbh->prepare($q);
 613     $h->execute($term);
 614     my ($type_id) = $h->fetchrow_array();
 615     return $type_id;
 616 }
 617
 618 sub get_projectprop_type_id {
 619     my $self = shift;
 620     my $term = shift;
 621     my $q = "SELECT projectprop.type_id FROM projectprop JOIN cvterm ON (projectprop.type_id=cvterm.cvterm_id) WHERE cvterm.name=?";
 622     my $h = $self->dbh->prepare($q);
 623     $h->execute($term);
 624     my ($type_id) = $h->fetchrow_array();
 625     return $type_id;
 626 }
 627
 628 1;