lib/CXGN/DB/PhenoPopulation.pm

   1 package CXGN::DB::PhenoPopulation;
   2
   3 #####################################################################
   4 #
   5 #  Program : $Id: phenotype_db_tools.pm 1413 2005-05-31 15:53:05Z john $
   6 #  Author  : $Author: john $
   7 #  Date    : $Date: 2005-05-31 11:53:05 -0400 (Tue, 31 May 2005) $
   8 #  Version : 2.0
   9 #  CHECKOUT TAG: $Name:  $
  10 #
  11 #  This module provides facilitating methods for the phenotypic
  12 #  images database developed by Jennifer Lee.  It operates on
  13 #  the pheno_population database in pg, using web_usr to read from it
  14 #  and phenotype_editor to write to it.
  15 #
  16 ####################################################################
  17
  18 #Used in all scripts with images
  19 #  get_generated_image_dir ()
  20 #  get_original_image_dir ()
  21
  22 #Used in main_phenotype.pl
  23 #  get_all_populations ()
  24 #  get_pop_name_from_pop_id (pop_id)
  25 #  get_all_gen_from_pop_id (pop_id)
  26 #  get_all_prop_by_organ_from_pop_id (pop_id)
  27
  28 #Used in diplay_plants_from_property.pl
  29 #  get_plant_info_by_loc_from_pop_and_prop (pop_id, prop_id)
  30 #  get_prop_name_from_prop_id (prop_id)
  31 #  get_loc_info_from_loc_id (loc_id)
  32
  33 #Used in display_plants_from_genotype.pl
  34 #  get_gen_name_from_gen_id (gen_id)
  35 #  get_all_plant_info_from_gen_id (gen_id)
  36 #  get_all_prop_by_organ_from_plant_id (plant_id)
  37
  38 #Used in display_property_data_from_plant.pl
  39 #  get_prop_name_from_prop_id (prop_id)
  40 #    --> also used in display_plants_from_property.pl
  41 #  get_gen_info_from_plant_id (plant_id)
  42 #  get_dp_image_from_plant_and_prop (plant_id, prop_id)
  43 #  get_dp_info_from_plant_and_prop (plant_id, prop_id)
  44
  45 #Used in display_samples_from_plant.pl
  46 #  get_images_by_organ_from_plant_id (plant_id)
  47
  48 #Used in display_image_and_data.pl
  49 #  get_dp_info_from_filepath (filepath)
  50
  51 #Used in various scripts to create and load db
  52 #  get_organ_name (organ_id)
  53 #  get_prop_name (prop_id)
  54 #  get_plant_id (plant_name, loc_id)
  55 #  create_samples_entry_for_flower (sample_name, sample_group, organ_id, plant_id)
  56 #  get_sample_id (plant_id, sample_group, sample_name)
  57 #  get_prop_id (prop_name, organ_id)
  58 #  get_image_id (organ, plant_num, type, sample_num)
  59
  60 #Used in display_prop_list.pl
  61 #  get_all_prop_images ()
  62
  63 use strict;
  64 use CXGN::DB::Connection;
  65 use CXGN::Tools::File;
  66 use CXGN::DB::Connection;
  67
  68
  69 #------------------------------------------------------
  70 #used for all scripts with images----------------------
  71 #------------------------------------------------------
  72 use CatalystX::GlobalContext '$c';
  73
  74 sub get_generated_image_dir {
  75     $c->get_conf('static_datasets_url').'/phenotype_images/generated_images/';
  76 }
  77
  78 sub get_original_image_dir {
  79     # This is for use by Apache.
  80     $c->get_conf('static_datasets_url').'/phenotype_images/plant_images/';
  81 }
  82
  83 sub get_prop_image_dir {
  84     # This is for use within Apache.
  85     $c->get_conf('static_datasets_url').'/phenotype_images/prop_images/';
  86 }
  87
  88 sub get_system_prop_image_dir {
  89     # This is for use by the system.
  90     File::Spec->catdir( $c->get_conf('static_datasets_path'),
  91                         'phenotype_images',
  92                         'prop_images',
  93                        );
  94 }
  95
  96
  97 #------------------------------------------------------
  98 #display_prop_list.pl----------------------------------
  99 #------------------------------------------------------
 100 sub get_all_props_by_organ {
 101   my %all_prop_by_organ;
 102
 103   my $dbh = CXGN::DB::Connection->new('pheno_population');
 104
 105   my $stm = "SELECT properties.prop_name, properties.annotation, organs.organ_name,
 106                     properties.unit_name
 107              FROM properties, organs
 108              WHERE properties.organ_id = organs.organ_id";
 109   my $sth = $dbh->prepare($stm);
 110   $sth->execute or die "ERROR getting all properties by organ\n";
 111
 112   while (my @row = $sth->fetchrow_array) {
 113     my $prop_name = $row[0];
 114     my $description = $row[1];
 115     my $organ_name = $row[2];
 116     my $unit_name = $row[3];
 117
 118     if ($unit_name ne "none") {
 119       $prop_name = "$prop_name"." \($unit_name\)";
 120     }
 121
 122     $all_prop_by_organ{$organ_name}{$prop_name} =  $description;
 123   }
 124
 125   $sth->finish;
 126
 127
 128   return %all_prop_by_organ;
 129 }
 130
 131 #------------------------------------------------------
 132 sub get_all_prop_images_from_organ ($) {
 133   my ($organ) = @_;
 134
 135   my $source_dir = &get_system_prop_image_dir;
 136   $source_dir =~ s|/$||; #remove a trailing dir separator
 137   my @all_files = CXGN::Tools::File::traverse_dir("$source_dir"."/");
 138   my @image_files = grep /(.*)($organ)(.*)(png|jpg|tiff|tif|gif)$/i, @all_files;
 139
 140   my @image_names;
 141   foreach my $image (sort @image_files) {
 142     $image =~ /($source_dir)(.*)(\/)(.*)(\.)(png|jpg|tiff|tif|gif|psd)$/i;
 143     my $just_name = "$4"."$5"."$6";
 144     push @image_names, $just_name;
 145   }
 146
 147   return @image_names;
 148 }
 149
 150
 151 #------------------------------------------------------
 152 #main_phenotype.pl-------------------------------------
 153 #------------------------------------------------------
 154 sub get_all_populations () {
 155   my @populations;
 156
 157   my $dbh = CXGN::DB::Connection->new('pheno_population');
 158
 159   my $stm = "SELECT pop_id, pedigree
 160              FROM populations";
 161   my $sth = $dbh->prepare($stm);
 162   $sth->execute or die "ERROR getting all populations\n";
 163
 164   my $index = 0;
 165   while (my @row = $sth->fetchrow_array) {
 166     push @ {$populations[$index]}, $row[0];
 167     push @ {$populations[$index]}, $row[1];
 168     $index++;
 169   }
 170
 171   $sth->finish;
 172
 173
 174   return @populations;
 175 }
 176
 177 #------------------------------------------------------
 178 sub get_pop_name_from_pop_id ($) {
 179   my ($pop_id) = @_;
 180
 181   my $dbh = CXGN::DB::Connection->new('pheno_population');
 182   my $stm = "SELECT pedigree
 183              FROM populations
 184              WHERE pop_id = $pop_id";
 185   my $sth = $dbh->prepare($stm);
 186   $sth->execute or die "ERROR getting population name\n";
 187   my @row = $sth->fetchrow_array;
 188   my $pop_name = $row[0];
 189
 190
 191   return $pop_name;
 192 }
 193
 194 #------------------------------------------------------
 195 sub get_all_gen_from_pop_id ($) {
 196   my ($pop_id) = @_;
 197   my @genotypes;
 198
 199   my $dbh = CXGN::DB::Connection->new('pheno_population');
 200   my $stm = "SELECT gen_id, gen_name
 201              FROM genotypes
 202              WHERE pop_id = $pop_id";
 203   my $sth = $dbh->prepare($stm);
 204   $sth->execute or die "ERROR getting genotypes by population\n";
 205
 206   my $index = 0;
 207   while (my @row = $sth->fetchrow_array) {
 208     push @ {$genotypes[$index]}, $row[0];
 209     push @ {$genotypes[$index]}, $row[1];
 210     $index++;
 211   }
 212
 213   $sth->finish;
 214
 215
 216   return @genotypes;
 217 }
 218
 219
 220 #------------------------------------------------------
 221 sub get_all_prop_info_by_organ_from_pop_id ($) {
 222   my ($pop_id)= @_;
 223   my @prop_info_by_organ;
 224
 225   my $dbh = CXGN::DB::Connection->new('pheno_population');
 226   my $stm = "SELECT properties.prop_id, properties.prop_name, properties.organ_id, organs.organ_name
 227              FROM genotypes, plants, samples, data_points, properties, organs
 228              WHERE genotypes.pop_id = $pop_id AND
 229                    genotypes.gen_id = plants.gen_id AND
 230                    plants.plant_id = samples.plant_id AND
 231                    samples.sample_id = data_points.sample_id AND
 232                    data_points.prop_id = properties.prop_id AND
 233                    properties.organ_id = organs.organ_id";
 234
 235   my $sth = $dbh->prepare($stm);
 236   $sth->execute or die "ERROR getting all properties";
 237
 238   my @added;
 239   while (my @row = $sth->fetchrow_array) {
 240     my $prop_id = $row[0];
 241     my $prop_name = $row[1];
 242     my $organ_id = $row[2];
 243     my $organ_name = $row[3];
 244
 245     if (!grep/^$prop_id$/, @added) {
 246       my @info;
 247       push @info, $prop_id;
 248       push @info, $prop_name;
 249       push @info, $organ_name;
 250
 251       push @{$prop_info_by_organ[$organ_id]}, [@info];
 252       push @added, $prop_id;
 253     }
 254   }
 255
 256   $sth->finish;
 257
 258
 259   return @prop_info_by_organ;
 260 }
 261
 262
 263 #-----------------------------------------------------
 264 #display_plants_from_property.pl----------------------
 265 #-----------------------------------------------------
 266 #input: prop_id
 267 #output: plants ordered by location
 268 sub get_plant_info_by_loc_from_pop_and_prop ($$) {
 269
 270   my ($pop_id, $prop_id) = @_;
 271   my @plant_info_by_location;
 272
 273   my $dbh = CXGN::DB::Connection->new('pheno_population');
 274   my $stm = "SELECT plants.plant_id, plants.loc_id, plants.plant_name, data_points.image_id, images.filepath
 275              FROM genotypes, plants, samples, data_points, images
 276              WHERE genotypes.pop_id = $pop_id AND
 277                    genotypes.gen_id = plants.gen_id AND
 278                    plants.plant_id = samples.plant_id AND
 279                    samples.sample_id = data_points.sample_id AND
 280                    data_points.prop_id = $prop_id AND
 281                    data_points.image_id = images.image_id";
 282   my $sth = $dbh->prepare($stm);
 283   $sth->execute or die "ERROR getting plant info by pop and prop\n";
 284
 285   my @added;
 286   while (my @row = $sth->fetchrow_array) {
 287     my $plant_id = $row[0];
 288     my $loc_id = $row[1];
 289     my $plant_name = $row[2];
 290     my $image_id = $row[3];
 291     my $filepath = $row[4];
 292
 293     if (!grep /^$plant_id$/, @added) {
 294       my @plant_info;
 295       push @plant_info, $plant_id;
 296       push @plant_info, $plant_name;
 297       push @plant_info, $image_id;
 298       push @plant_info, $filepath;
 299
 300       push @{$plant_info_by_location[$loc_id]}, [@plant_info];
 301       push @added, $plant_id;
 302     }
 303   }
 304
 305
 306
 307   return @plant_info_by_location;
 308 }
 309
 310
 311 #------------------------------------------------------
 312 sub get_prop_name_from_prop_id ($) {
 313  my ($prop_id) = @_;
 314
 315   my $dbh = CXGN::DB::Connection->new('pheno_population');
 316
 317   my $stm = "SELECT prop_name FROM properties WHERE prop_id = ?";
 318   my $sth = $dbh->prepare($stm);
 319
 320   $sth->execute($prop_id) or die "ERROR getting property name from prop_id";
 321   my @row = $sth->fetchrow_array;
 322   my $prop_name = $row[0];
 323
 324   $sth->finish;
 325
 326   return $prop_name;
 327 }
 328
 329 #-----------------------------------------------------
 330 sub get_loc_info_from_loc_id ($) {
 331   my ($loc_id) = @_;
 332   my @loc_info;
 333
 334   my $dbh = CXGN::DB::Connection->new('pheno_population');
 335
 336   my $stm = "SELECT institution, environment, year
 337              FROM locations
 338              WHERE loc_id = $loc_id";
 339
 340   my $sth = $dbh->prepare($stm);
 341   $sth->execute or die "ERROR getting loc info by loc_id\n";
 342
 343   my @row = $sth->fetchrow_array;
 344   push @loc_info, $row[0];
 345   push @loc_info, $row[1];
 346   push @loc_info, $row[2];
 347
 348   $sth->finish;
 349
 350
 351   return @loc_info;
 352 }
 353
 354
 355 #------------------------------------------------------
 356 #display_plants_from_genotype.pl-----------------------
 357 #------------------------------------------------------
 358 sub get_gen_name_from_gen_id ($) {
 359   my ($gen_id) = @_;
 360   my $gen_name;
 361
 362   my $dbh = CXGN::DB::Connection->new('pheno_population');
 363
 364   my $stm = "SELECT gen_name
 365              FROM genotypes
 366              WHERE gen_id = $gen_id";
 367   my $sth = $dbh->prepare($stm);
 368   $sth->execute or die "ERROR getting genotype name\n";
 369   my @row = $sth->fetchrow_array;
 370   $gen_name = $row[0];
 371
 372
 373   return $gen_name;
 374 }
 375
 376 #------------------------------------------------------
 377 sub get_all_plant_info_from_gen_id ($) {
 378   my ($gen_id) = @_;
 379   my @plant_info_from_gen;
 380
 381   my $dbh = CXGN::DB::Connection->new('pheno_population');
 382
 383   my $stm = "SELECT plants.plant_id, plants.plant_name,
 384                     locations.institution, locations.environment, locations.year
 385              FROM plants, locations
 386              WHERE plants.gen_id = $gen_id AND
 387                    plants.loc_id = locations.loc_id";
 388   my $sth = $dbh->prepare($stm);
 389   $sth->execute or die "ERROR getting plant info by gen_id\n";
 390
 391   my $index = 0;
 392   while (my @row = $sth->fetchrow_array) {
 393     my @plant_info;
 394     my $plant_id = $row[0];
 395     my $plant_name = $row[1];
 396     my $institution = $row[2];
 397     my $environment = $row[3];
 398     my $year = $row[4];
 399
 400     push @plant_info, $plant_id;
 401     push @plant_info, $plant_name;
 402     push @plant_info, $institution;
 403     push @plant_info, $environment;
 404     push @plant_info, $year;
 405
 406     push @ {$plant_info_from_gen[$index]}, [@plant_info];
 407     $index++;
 408   }
 409
 410   $sth->finish;
 411
 412
 413   return @plant_info_from_gen;
 414 }
 415
 416 #-----------------------------------------------------
 417 sub get_all_prop_by_organ_from_plant_id ($) {
 418   my ($plant_id) = @_;
 419   my @prop_by_organ;
 420
 421   my $dbh = CXGN::DB::Connection->new('pheno_population');
 422   my $stm = "SELECT properties.prop_id, properties.prop_name,
 423                     properties.organ_id, organs.organ_name
 424              FROM organs, properties, data_points, samples
 425              WHERE samples.plant_id = $plant_id AND
 426                    samples.sample_id = data_points.sample_id AND
 427                    data_points.prop_id = properties.prop_id AND
 428                    properties.organ_id = organs.organ_id";
 429   my $sth = $dbh->prepare($stm);
 430   $sth->execute or die "ERROR getting prop by organ from plant\n";
 431
 432   my @added;
 433   while (my @row = $sth->fetchrow_array) {
 434     my $prop_id = $row[0];
 435     my $prop_name = $row[1];
 436     my $organ_id = $row[2];
 437     my $organ_name = $row[3];
 438
 439     if (!grep /^$prop_id$/, @added){
 440       my @prop_info;
 441       push @prop_info, $prop_id;
 442       push @prop_info, $prop_name;
 443       push @prop_info, $organ_name;
 444
 445       push @{$prop_by_organ[$organ_id]}, [@prop_info];
 446       push @added, $prop_id;
 447     }
 448   }
 449
 450   $sth->finish;
 451
 452
 453   return @prop_by_organ;
 454 }
 455
 456 #------------------------------------------------------
 457 #display_property_data_from_plant.pl-------------------
 458 #------------------------------------------------------
 459 sub get_gen_info_from_plant_id ($) {
 460   my ($plant_id) = @_;
 461   my @gen_info;
 462
 463   my $dbh = CXGN::DB::Connection->new('pheno_population');
 464
 465   my $stm = "SELECT genotypes.gen_name, genotypes.gen_id
 466              FROM plants, genotypes
 467              WHERE plants.plant_id=$plant_id AND
 468                    genotypes.gen_id=plants.gen_id";
 469   my $sth = $dbh->prepare($stm);
 470   $sth->execute or die "ERROR getting genotype info by plant_id\n";
 471
 472   my @row = $sth->fetchrow_array;
 473   my $gen_name = $row[0];
 474   my $gen_id = $row[1];
 475   push @gen_info, $gen_name;
 476   push @gen_info, $gen_id;
 477
 478
 479   return @gen_info;
 480 }
 481
 482 #-----------------------------------------------------
 483 sub get_unit_name_from_prop ($) {
 484   my ($prop_id) = @_;
 485
 486   my $dbh = CXGN::DB::Connection->new('pheno_population');
 487
 488   my $stm = "SELECT unit_name
 489              FROM properties
 490              WHERE prop_id = ?";
 491   my $sth = $dbh->prepare($stm);
 492
 493   $sth->execute($prop_id) or die "ERROR getting unit_name";
 494   my @row = $sth->fetchrow_array;
 495   my $unit_name = $row[0];
 496
 497   $sth->finish;
 498
 499
 500   return $unit_name;
 501 }
 502
 503 #-----------------------------------------------------
 504 sub get_unit_precision_from_prop ($) {
 505   my ($prop_id) = @_;
 506   my $dbh = CXGN::DB::Connection->new('pheno_population');
 507
 508   my $stm = "SELECT unit_precision
 509              FROM properties
 510              WHERE prop_id = $prop_id";
 511   my $sth = $dbh->prepare($stm);
 512
 513   $sth->execute or die "ERROR getting unit_precision";
 514   my @row = $sth->fetchrow_array;
 515   my $unit_precision = $row[0];
 516
 517   $sth->finish;
 518
 519
 520   return $unit_precision;
 521 }
 522
 523 #-----------------------------------------------------
 524 #output: returns an array of arrays (sample_name, sample_group, data value, filepath)
 525 sub get_dp_info_from_plant_and_prop ($$) {
 526   my ($plant_id, $prop_id) = @_;
 527   my %dp_value_by_key;
 528
 529   my $dbh = CXGN::DB::Connection->new('pheno_population');
 530
 531   my $stm = "SELECT samples.sample_id, samples.sample_name, samples.sample_group,
 532                     data_points.value, images.filepath,
 533                     properties.unit_name, properties.unit_precision
 534              FROM plants, samples, data_points, images, properties
 535              WHERE plants.plant_id=? AND
 536                    samples.plant_id=plants.plant_id AND
 537                    data_points.sample_id=samples.sample_id AND
 538                    data_points.prop_id=? AND
 539                    data_points.image_id=images.image_id AND
 540                    properties.prop_id=?";
 541   my $sth = $dbh->prepare($stm);
 542   $sth->execute($plant_id,$prop_id,$prop_id) or die "ERROR getting dp info for samples by plant and property\n";
 543
 544   while (my @row = $sth->fetchrow_array) {
 545     my $sample_name = $row[1];
 546     my $sample_group = $row[2];
 547     my $dp_value = $row[3];
 548     my $filepath = $row[4];
 549     my $unit_name = $row[5];
 550     my $unit_precision = $row[6];
 551
 552     my $sample_key;
 553     if ($sample_group eq $sample_name) {
 554       if ($sample_group eq "0") {
 555         $sample_key = "ALL"."hash_key"."$filepath";
 556       }
 557       else {
 558         $sample_key = "$sample_group"."hash_key"."$filepath";
 559       }
 560     }
 561     elsif ($sample_group eq "0") {
 562       $sample_key = "$sample_name"."hash_key"."$filepath";
 563     }
 564     elsif ($sample_name eq "0") {
 565         $sample_key = "$sample_group"."hash_key"."$filepath";
 566     }
 567     else {
 568       $sample_key = "$sample_group, "."$sample_name"."hash_key"."$filepath";
 569     }
 570
 571     if (($unit_precision > 0) && ($dp_value) && ($dp_value =~ /(\d+)((\.\d+)*)/)) {
 572       $dp_value = sprintf("%10.${unit_precision}f", $dp_value);
 573     }
 574
 575     push @{$dp_value_by_key{$sample_key}}, $dp_value;
 576   }
 577
 578
 579   return %dp_value_by_key;
 580 }
 581
 582 #-----------------------------------------------------
 583 #output: returns an array of arrays (sample_name, sample_group, data value, filepath)
 584 sub get_dp_image_from_plant_and_prop ($$) {
 585   my ($plant_id, $prop_id) = @_;
 586   my %dp_info_by_image;
 587
 588   my $dbh = CXGN::DB::Connection->new('pheno_population');
 589
 590   my $stm = "SELECT samples.sample_id, samples.sample_name, samples.sample_group,
 591                     images.filepath
 592              FROM plants, samples, data_points, images
 593              WHERE plants.plant_id=$plant_id AND
 594                    samples.plant_id=plants.plant_id AND
 595                    data_points.sample_id=samples.sample_id AND
 596                    data_points.prop_id=$prop_id AND
 597                    data_points.image_id=images.image_id";
 598   my $sth = $dbh->prepare($stm);
 599   $sth->execute or die "ERROR getting dp images for samples by plant and property\n";
 600
 601   my @added;
 602   while (my @row = $sth->fetchrow_array) {
 603     my $sample_id = $row[0];
 604     my $sample_name = $row[1];
 605     my $sample_group = $row[2];
 606     my $filepath = $row[3];
 607
 608     if (!grep/^$sample_id$/, @added) {
 609       my $fullname;
 610       if ($sample_group eq $sample_name) {
 611         if ($sample_group eq "0") {
 612           $fullname = "ALL";
 613         }
 614         else {
 615           $fullname = "$sample_group";
 616         }
 617       }
 618       elsif ($sample_name eq "0") {
 619         $fullname = $sample_group;
 620       }
 621       elsif ($sample_group eq "0") {
 622         $fullname = $sample_name;
 623       }
 624       else {
 625         $fullname = "$sample_group, "."$sample_name";
 626       }
 627
 628       push @ {$dp_info_by_image{$filepath}}, $fullname;
 629       push @added, $sample_id;
 630     }
 631   }
 632
 633
 634   return %dp_info_by_image;
 635 }
 636
 637
 638
 639 #-----------------------------------------------------
 640 #display_samples_from_plant.pl------------------------
 641 #-----------------------------------------------------
 642 #input: plant_id
 643 #output: returns array of image info in a three dim array, where the first index refers to the organ_id and the second index stores the filepath,and the third is sample name
 644 sub get_images_by_organ_from_plant_id ($) {
 645   my ($plant_id) = @_;
 646   my @image_info_by_organ;
 647
 648   my $dbh = CXGN::DB::Connection->new('pheno_population');
 649
 650   my $stm = "SELECT images.image_id, images.filepath,
 651                     samples.sample_group, samples.sample_name,
 652                     organs.organ_id, organs.organ_name
 653              FROM images, samples, data_points, organs
 654              WHERE samples.plant_id = $plant_id AND
 655                    samples.organ_id = organs.organ_id AND
 656                    samples.sample_id = data_points.sample_id AND
 657                    data_points.image_id = images.image_id";
 658   my $sth = $dbh->prepare($stm);
 659   $sth->execute or die "ERROR getting images by plant";
 660
 661   my @added;
 662   while (my @row = $sth->fetchrow_array) {
 663     my $image_id = $row[0];
 664     my $filepath = $row[1];
 665     my $sample_group = $row[2];
 666     my $sample_name = $row[3];
 667     my $organ_id = $row[4];
 668     my $organ_name = $row[5];
 669
 670     if (!grep /^$image_id$/, @added){
 671       my @info;
 672       push @info, $image_id;
 673       push @info, $filepath;
 674       push @info, $sample_group;
 675       push @info, $sample_name;
 676       push @info, $organ_name;
 677
 678       push @ {$image_info_by_organ[$organ_id]}, [@info];
 679       push @added, $image_id;
 680     }
 681   }
 682
 683   $sth->finish;
 684
 685
 686   return @image_info_by_organ;
 687 }
 688
 689
 690 #-----------------------------------------------------
 691 #display_image_and_data.pl----------------------------
 692 #-----------------------------------------------------
 693 #return a hash of hash of arrays (property_name, dp_value)
 694 sub get_dp_info_from_filepath ($) {
 695   my ($filepath) = @_;
 696   my %dp_value_by_prop_and_sample_name;
 697
 698   my $dbh = CXGN::DB::Connection->new('pheno_population');
 699
 700   my $stm = "SELECT data_points.dp_id, properties.prop_name, data_points.value,
 701                     samples.sample_name, samples.sample_group,
 702                     properties.unit_name, properties.unit_precision
 703              FROM data_points, properties, images, samples
 704              WHERE images.filepath=\'$filepath\' AND
 705                    images.image_id = data_points.image_id AND
 706                    data_points.prop_id=properties.prop_id AND
 707                    data_points.sample_id = samples.sample_id";
 708   my $sth = $dbh->prepare($stm);
 709   $sth->execute or die "ERROR getting dp info from filepath\n";
 710
 711   while (my @row = $sth->fetchrow_array) {
 712     my $dp_id = $row[0];
 713     my $prop_name = $row[1];
 714     my $dp_value = $row[2];
 715     my $sample_name = $row[3];
 716     my $sample_group = $row[4];
 717     my $unit_name = $row[5];
 718     my $unit_precision = $row[6];
 719
 720     my $fullname;
 721     if ($sample_name eq $sample_group) {
 722       if ($sample_group eq "0") {
 723         $fullname = "ALL";
 724       }
 725       else {
 726         $fullname = $sample_group;
 727       }
 728     }
 729     elsif ($sample_group eq "0") {
 730       $fullname = $sample_name;
 731     }
 732     elsif ($sample_name eq "0") {
 733       $fullname = $sample_group;
 734     }
 735     else {
 736       $fullname = "$sample_group, "."$sample_name";
 737     }
 738
 739     my $hash_key;
 740     if ($unit_name ne "none") {
 741       $hash_key = "$prop_name \($unit_name\)"."hash_key"."$fullname";
 742     }
 743     else {
 744       $hash_key = "$prop_name"."hash_key"."$fullname";
 745     }
 746
 747     if (($unit_precision > 0) && ($dp_value) && ($dp_value =~ /(\d+)((\.\d+)*)/)) {
 748       $dp_value = sprintf ("%10.${unit_precision}f", $dp_value);
 749     }
 750
 751     push @ {$dp_value_by_prop_and_sample_name{$hash_key}}, $dp_value;
 752   }
 753
 754
 755   return %dp_value_by_prop_and_sample_name;
 756 }
 757
 758
 759 #------------------------------------------------------
 760 #various scripts to create and load db-----------------
 761 #------------------------------------------------------
 762 sub get_organ_name ($) {
 763   my ($organ_id) = @_;
 764
 765   my $dbh = CXGN::DB::Connection->new('pheno_population');
 766
 767   my $stm = "SELECT organ_name
 768              FROM organs
 769              WHERE organ_id = $organ_id";
 770   my $sth = $dbh->prepare($stm);
 771
 772   $sth->execute or die "ERROR getting organ name";
 773   my @row = $sth->fetchrow_array;
 774   my $organ_name = $row[0];
 775
 776   $sth->finish;
 777
 778   return $organ_name;
 779 }
 780
 781 #------------------------------------------------------
 782 sub get_prop_name ($) {
 783  my ($prop_id) = @_;
 784
 785   my $dbh = CXGN::DB::Connection->new('pheno_population');
 786
 787   my $stm = "SELECT prop_name
 788              FROM properties
 789              WHERE prop_id = $prop_id";
 790   my $sth = $dbh->prepare($stm);
 791
 792   $sth->execute or die "ERROR getting property name";
 793   my @row = $sth->fetchrow_array;
 794   my $prop_name = $row[0];
 795
 796   $sth->finish;
 797
 798   return $prop_name;
 799 }
 800
 801
 802 #------------------------------------------------------
 803 sub get_plant_id ($$) {
 804   my ($plant_name, $loc_id) = @_;
 805   #print "plant_name: $plant_name, loc_id: $loc_id\n";
 806
 807   my $dbh = CXGN::DB::Connection->new('pheno_population');
 808
 809   my $stm = "SELECT plant_id
 810              FROM plants
 811              WHERE plant_name = $plant_name AND
 812                    loc_id = $loc_id;";
 813   my $sth = $dbh->prepare($stm);
 814
 815   $sth->execute or die "ERROR getting plant_id\nplant_name: $plant_name, loc_id: $loc_id\n";
 816   my @row = $sth->fetchrow_array;
 817   my $plant_id = $row[0];
 818
 819   $sth->finish;
 820
 821
 822   if ($plant_id) {
 823     return $plant_id;
 824   }
 825   else {
 826     die "ERROR getting plant_id\nplant_name: $plant_name, loc_id: $loc_id\n";
 827   }
 828 }
 829
 830 #------------------------------------------------------
 831 sub create_samples_entry_for_flower ($$$$) {
 832   my ($sample_name, $sample_group, $organ_id, $plant_id) = @_;
 833
 834   my $dbh = CXGN::DB::Connection->new('pheno_population');
 835
 836   my $stm = "INSERT INTO samples
 837              VALUES(NULL, '$sample_name', '$sample_group', '$organ_id', '$plant_id', NULL);";
 838   my $sth = $dbh->prepare($stm);
 839   $sth->execute or die "ERROR creating samples entry";
 840
 841   $stm = "SELECT sample_id
 842           FROM samples
 843           WHERE plant_id = $plant_id AND
 844                    sample_name = $sample_name AND
 845                    sample_group = $sample_group";
 846   $sth = $dbh->prepare($stm);
 847   $sth->execute or die "ERROR getting sample_id";
 848   my @row = $sth->fetchrow_array;
 849   my $new_sample_id = $row[0];
 850
 851   $sth->finish;
 852
 853
 854   if ($new_sample_id) {
 855     return $new_sample_id;
 856   }
 857   else {
 858     die "\nphenotype_db_tools::create_samples_entry_for_flower problem making new entry for flower sample:\n$sample_name, $sample_group, $organ_id, $plant_id\n";
 859   }
 860 }
 861
 862
 863 #------------------------------------------------------
 864 sub get_sample_id($$$$) {
 865   my ($plant_id, $organ_id, $sample_group, $sample_name) = @_;
 866
 867   my $dbh = CXGN::DB::Connection->new('pheno_population');
 868
 869   my $stm = "SELECT sample_id
 870              FROM samples
 871              WHERE plant_id = $plant_id AND
 872                    organ_id = $organ_id AND
 873                    sample_name = \"$sample_name\" AND
 874                    sample_group = \"$sample_group\"";
 875   my $sth = $dbh->prepare($stm);
 876
 877   $sth->execute or die "ERROR getting sample_id";
 878   my @row = $sth->fetchrow_array;
 879   my $sample_id = $row[0];
 880
 881   $sth->finish;
 882
 883
 884   if ($sample_id) {
 885     return $sample_id;
 886   }
 887   else {
 888     return $sample_id;
 889     #die "In get_sample_id...  plant_id: $plant_id, sample_name: $sample_name\nERROR getting sample_id";
 890   }
 891 }
 892
 893
 894 #------------------------------------------------------
 895 sub get_prop_id ($$) {
 896   my ($property, $organ_id) = @_;
 897   #print "In get_prop_id... property: $property, organ_id: $organ_id\n";
 898
 899   my $dbh = CXGN::DB::Connection->new('pheno_population');
 900
 901   my $stm = "SELECT prop_id
 902              FROM properties
 903              WHERE (prop_name = \"$property\") AND
 904                    organ_id = $organ_id";
 905   my $sth = $dbh->prepare($stm);
 906
 907   $sth->execute or die "ERROR getting prop_id";
 908   my @row = $sth->fetchrow_array;
 909   my $prop_id = $row[0];
 910
 911   $sth->finish;
 912
 913
 914   if ($prop_id) {
 915     return $prop_id;
 916   }
 917   else {
 918     #print "In get_prop_id... property: $property, organ_id: $organ_id\n";
 919     die "ERROR getting prop_id\nIn get_prop_id... property: $property, organ_id: $organ_id\n";
 920   }
 921 }
 922
 923 #------------------------------------------------------
 924 sub get_image_id ($$$$) {
 925   my ($organ, $plant_num, $type, $sample_num) = @_;
 926   #print "organ: $organ, plant_num: $plant_num, type: $type, sample_num: $sample_num\n";
 927
 928   #select the key file names
 929   my $file_part;
 930   if ($organ eq "flower") {
 931     $file_part = "%"."flower_"."$type"."_plant"."$plant_num"."_sample"."$sample_num"."\."."%";
 932   }
 933   elsif ($organ eq "fruit") {
 934     $file_part = "%"."fruit_"."plant"."$plant_num"."\."."%";
 935   }
 936   elsif ($organ eq "ovary") {
 937     $file_part = "%"."ovary_"."$type"."_plant"."$plant_num"."_sample"."$sample_num"."\."."%";
 938   }
 939   elsif ($organ eq "leaf") {
 940     $file_part = "%"."leaf_"."$type"."_plant"."$plant_num"."\."."%";
 941   }
 942   elsif ($organ eq "mhc_leaf") {
 943     $file_part = "%"."leaf_"."$type"."_plant"."$plant_num"."_"."$sample_num"."\.png";
 944   }
 945   else {
 946     die "ERROR:unknown organ while trying to find image_id\norgan: $organ, plant_num: $plant_num, type: $type, sample_num: $sample_num\n";
 947   }
 948
 949   my $dbh = CXGN::DB::Connection->new('pheno_population');
 950
 951   my $stm = "SELECT image_id
 952              FROM images
 953              WHERE filepath LIKE \"$file_part\"";
 954
 955   my $sth = $dbh->prepare($stm);
 956
 957   $sth->execute or die "ERROR getting image_id";
 958   my @row = $sth->fetchrow_array;
 959   my $image_id = $row[0];
 960
 961   #CU LEAF IMAGES
 962   #if the leaf images are separated then parses sample name to select image
 963   if (!($image_id) && ($organ eq "leaf")) {
 964     #print "separated...\n";
 965
 966     $sample_num =~ /(\w)(_)(.*)/;
 967     my $sample_name = $1;
 968     $file_part = "%"."leaf_"."$type"."_plant"."$plant_num"."_"."$sample_name"."\."."%";
 969     #print "$file_part\n";
 970
 971     $stm = "SELECT image_id
 972             FROM images
 973             WHERE filepath LIKE \"$file_part\"";
 974     $sth = $dbh->prepare($stm);
 975     $sth->execute or die "ERROR getting leaf image_id\norgan: $organ, plant_num: $plant_num, type: $type, sample_num: $sample_num\n";
 976     @row = $sth->fetchrow_array;
 977     $image_id = $row[0];
 978   }
 979
 980   #MHC LEAF IMAGES
 981   if (!($image_id) && ($organ eq "mhc_leaf")) {
 982     $file_part = "%"."leaf_"."$type"."_plant"."$plant_num"."_"."AB"."\.png";
 983
 984     $stm = "SELECT image_id
 985             FROM images
 986             WHERE filepath LIKE \"$file_part\"";
 987     $sth = $dbh->prepare($stm);
 988     $sth->execute or die "ERROR getting leaf image_id\norgan: $organ, plant_num: $plant_num, type: $type, sample_num: $sample_num\n";
 989     @row = $sth->fetchrow_array;
 990     $image_id = $row[0];
 991   }
 992
 993   #close
 994   $sth->finish;
 995
 996
 997   #this is just a mess... doesn't look good, huh?
 998   if ($image_id) {
 999     return $image_id;
1000   }
1001   elsif ($organ eq "flower") {
1002     #print "organ: $organ, plant_num: $plant_num, type: $type, sample_num: $sample_num\n";
1003     #die "\nERROR finding image_id...\n";
1004     return $image_id;
1005   }
1006   elsif ($organ eq "mhc_leaf") {
1007     return $image_id;
1008   }
1009   elsif ($organ eq "leaf") {
1010     #print "organ: $organ, plant_num: $plant_num, type: $type, sample_num: $sample_num\n";
1011     return $image_id;
1012   }
1013   elsif ($organ eq "ovary") {
1014     #print "organ: $organ, plant_num: $plant_num, type: $type, sample_num: $sample_num\n";
1015      return $image_id;
1016      #return "\\N";
1017   }
1018   else {
1019     #die "ERROR finding image_id\norgan: $organ, plant_num: $plant_num, type: $type, sample_num: $sample_num\n";
1020     return $image_id;
1021   }
1022
1023 }
1024
1025
1026
1027 #------------------------------------------------------
1028 return 1;