lib/SGN/Image.pm

   1 package SGN::Image;
   2
   3 =head1 NAME
   4
   5 SGN::Image - SGN Images
   6
   7 =head1 DESCRIPTION
   8
   9 This class provides database access and store functions as well as
  10 image upload and certain image manipulation functions, such as image
  11 file type conversion and image resizing; and functions to associate
  12 tags with the image. Note that this was forked off from the insitu
  13 image object. The insitu database needs to be re-factored to use this
  14 image object.
  15
  16 The philosophy of the image object has changed slightly from the
  17 Insitu::Image object. It now stores the images in a directory
  18 specified by the conf object parameter "static_datasets_dir" plus
  19 the conf parameter "image_dir" plus the directory name "image_files"
  20 for the production server and the directory "image_files_sandbox" for
  21 the test server. In those directories, it creates a subdirectory for
  22 each image, with the subdirectory name being the corresponding image
  23 id. In that directory are then several files, the originial image file
  24 with the orignial name, the converted image into jpg in the standard
  25 image sizes: large, medium, small and thumbnail with the names:
  26 large.jpg, medium.jpg, small.jpg and thumbnail.jpg . All other
  27 metadata about the image is stored in the database.
  28
  29 =head1 AUTHOR(S)
  30
  31 Lukas Mueller (lam87@cornell.edu)
  32 Naama Menda (nm249@cornell.edu)
  33
  34
  35 =head1 MEMBER FUNCTIONS
  36
  37 The following functions are provided in this class:
  38
  39 =cut
  40
  41 use Modern::Perl;
  42
  43 use IO::File;
  44 use File::Path 'make_path';
  45 use File::Temp qw/ tempfile tempdir /;
  46 use File::Copy qw/ copy move /;
  47 use File::Basename qw/ basename /;
  48 use File::Spec;
  49 use CXGN::DB::Connection;
  50 use CXGN::Tag;
  51 use CXGN::Metadata::Metadbdata;
  52 use SGN::Model::Cvterm;
  53 use Data::Dumper;
  54
  55 use CatalystX::GlobalContext '$c';
  56
  57 use base qw| CXGN::Image |;
  58
  59 =head2 new
  60
  61  Usage:        my $image = SGN::Image->new($dbh)
  62  Desc:         constructor
  63  Ret:
  64  Args:         a database handle, optional identifier
  65  Side Effects: an empty object is returned.
  66                a database connection is established.
  67  Example:
  68
  69 =cut
  70
  71 sub new {
  72     my ( $class, $dbh, $image_id, $context ) = @_;
  73     $context ||= $c;
  74
  75     my $self = $class->SUPER::new(
  76         dbh       => $dbh || $context->dbc->dbh,
  77         image_id  => $image_id,
  78         image_dir => $context->get_conf('static_datasets_path')."/".$context->get_conf('image_dir'),
  79       );
  80
  81     $self->config( $context );
  82
  83     return $self;
  84 }
  85
  86
  87
  88 =head2 get_image_url
  89
  90  Usage: $self->get_image_url($size)
  91  Desc:  get the url for the image with a given size
  92  Ret:   a url for the image
  93  Args:  size (large, medium, small, thumbnail,  original)
  94  Side Effects: none
  95  Example:
  96
  97 =cut
  98
  99 sub get_image_url {
 100     my $self = shift;
 101     my $size = shift;
 102
 103     if( $self->config->test_mode && ! -e $self->get_filename($size) ) {
 104         # for performance, only try to stat the file if running in
 105         # test mode. doing lots of file stats over NFS can actually be
 106         # quite expensive.
 107         return '/img/image_temporarily_unavailable.png';
 108     }
 109
 110     my $url = join '/', (
 111          '',
 112          $self->config()->get_conf('static_datasets_url'),
 113          $self->config()->get_conf('image_dir'),
 114          $self->get_filename($size, 'partial'),
 115      );
 116     $url =~ s!//!/!g;
 117     return $url;
 118 }
 119
 120 =head2 process_image
 121
 122  Usage:        $image->process_image($filename, "stock", 234);
 123  Desc:         creates the image and associates it to the type and type_id
 124  Ret:
 125  Args:         filename, type (experiment, stock, fish, locus, organism) , type_id
 126  Side Effects: Calls the relevant $image->associate_$type function
 127  Example:
 128
 129 =cut
 130
 131 sub process_image {
 132     my $self = shift;
 133     my ($filename, $type, $type_id, $linking_table_type_id) = @_;
 134
 135     $self->SUPER::process_image($filename);
 136
 137     if ( $type eq "experiment" ) {
 138         #print STDERR "Associating experiment $type_id...\n";
 139         $self->associate_experiment($type_id);
 140     }
 141     elsif ( $type eq "stock" ) {
 142         #print STDERR "Associating stock $type_id...\n";
 143         $self->associate_stock($type_id);
 144     }
 145     elsif ( $type eq "fish" ) {
 146         #print STDERR "Associating to fish experiment $type_id\n";
 147         $self->associate_fish_result($type_id);
 148     }
 149     elsif ( $type eq "locus" ) {
 150         #print STDERR "Associating to locus $type_id\n";
 151         $self->associate_locus($type_id);
 152     }
 153     elsif ( $type eq "organism" ) {
 154         $self->associate_organism($type_id);
 155     }
 156     elsif ( $type eq "cvterm" ) {
 157         $self->associate_cvterm($type_id);
 158     }
 159     elsif ( $type eq "project" ) {
 160         $self->associate_project($type_id, $linking_table_type_id);
 161     }
 162
 163     elsif ( $type eq "test") {
 164         # need to return something to make this function happy
 165         return 1;
 166
 167     }
 168     else {
 169         warn "type $type is not recognized as one of the legal types. Not associating image with any object. Please check if your loading script links the image with an sgn object! \n";
 170     }
 171
 172 }
 173
 174 =head2 config, context, _app
 175
 176 Get the Catalyst context object we are running with.
 177
 178 =cut
 179
 180 sub config {
 181     my ($self,$obj) = @_;
 182
 183     $self->{configuration_object} = $obj if $obj;
 184
 185     return $self->{configuration_object};
 186 }
 187 *context = \&config;
 188 *_app    = \&config;
 189
 190 =head2 get_img_src_tag
 191
 192  Usage:
 193  Desc:
 194  Ret:
 195  Args:         "large" | "medium" | "small" | "thumbnail" | "original" | "tiny"
 196                default is medium
 197  Side Effects:
 198  Example:
 199
 200 =cut
 201
 202 sub get_img_src_tag {
 203     my $self = shift;
 204     my $size = shift;
 205     my $url  = $self->get_image_url($size);
 206     my $name = $self->get_name() || '';
 207     if ( $size && $size eq "original" ) {
 208
 209         my $static = $self->config()->get_conf("static_datasets_url");
 210
 211         return
 212             "<a href=\""
 213           . ($url)
 214           . "\"><span class=\"glyphicon glyphicon-floppy-save\" alt=\""
 215           . $name
 216           . "\" ></a>";
 217     }
 218     elsif ( $size && $size eq "tiny" ) {
 219         return
 220             "<img src=\""
 221           . ($url)
 222           . "\" width=\"20\" height=\"15\" border=\"0\" alt=\""
 223           . $name
 224           . "\" />\n";
 225     }
 226     else {
 227         return
 228             "<img src=\""
 229           . ($url)
 230           . "\" border=\"0\" alt=\""
 231           . $name
 232           . "\" />\n";
 233     }
 234 }
 235
 236 =head2 get_temp_filename
 237
 238  Usage:
 239  Desc:
 240  Ret:
 241  Args:
 242  Side Effects:
 243  Example:
 244
 245 =cut
 246
 247 sub get_temp_filename {
 248     my $self = shift;
 249     return $self->{temp_filename};
 250
 251 }
 252
 253 =head2 set_temp_filename
 254
 255  Usage:
 256  Desc:
 257  Ret:
 258  Args:
 259  Side Effects:
 260  Example:
 261
 262 =cut
 263
 264 sub set_temp_filename {
 265     my $self = shift;
 266     $self->{temp_filename} = shift;
 267 }
 268
 269 =head2 apache_upload_image
 270
 271  DEPRECATED.
 272
 273  Usage:        my $temp_file_name = $image->apache_upload_image($apache_upload_object);
 274  Desc:
 275  Ret:          the name of the intermediate tempfile that can be
 276                used to access down the road.
 277  Args:         an apache upload object
 278  Side Effects: generates an intermediate temp file from an apache request
 279                that can be handled more easily. Adds the remote IP addr to the
 280                filename so that different uploaders don\'t clobber but
 281                allows only one upload per remote addr at a time.
 282  Errors:       change 11/30/07 - removes temp file if already exists
 283                # returns -1 if the intermediate temp file already exists.
 284                # this probably means that the submission button was hit twice
 285                # and that an upload is already in progress.
 286  Example:
 287
 288 =cut
 289
 290 sub apache_upload_image {
 291     my $self   = shift;
 292     my $upload = shift;
 293     ###  deanx jan 03 2007
 294 # Adjust File name if using Windows IE - it sends whole paht; drive letter, path, and filename
 295     my $upload_filename;
 296     if ( $ENV{HTTP_USER_AGENT} =~ /msie/i ) {
 297         my ( $directory, $filename ) = $upload->filename =~ m/(.*\\)(.*)$/;
 298         $upload_filename = $filename;
 299     }
 300     else {
 301         $upload_filename = $upload->filename;
 302     }
 303
 304     my $upload_fh = $upload->fh;
 305
 306     my $temp_file =
 307         $self->config()->get_conf("basepath") . "/"
 308       . $self->config()->get_conf("tempfiles_subdir")
 309       . "/temp_images/"
 310       . $ENV{REMOTE_ADDR} . "-"
 311       . $upload_filename;
 312
 313     my $ret_temp_file = $self->upload_image($temp_file, $upload_fh);
 314     return $ret_temp_file;
 315
 316 }
 317
 318 sub upload_fieldbook_zipfile {
 319     my $self = shift;
 320     my $image_zip = shift;
 321     my $user_id = shift;
 322     my $c = $self->config();
 323     my $error_status;
 324     my $schema = $c->dbic_schema("Bio::Chado::Schema");
 325     my $metadata_schema = $c->dbic_schema("CXGN::Metadata::Schema");
 326     my $dbh = $schema->storage->dbh;
 327     my $archived_zip = CXGN::ZipFile->new(archived_zipfile_path=>$image_zip);
 328     my $file_members = $archived_zip->file_members();
 329     if (!$file_members){
 330         $error_status = 'Could not read your zipfile. Is is .zip format?</br></br>';
 331         return $error_status;
 332     }
 333     my $plot_cvterm_id = SGN::Model::Cvterm->get_cvterm_row($schema, 'plot', 'stock_type')->cvterm_id();
 334     my $plant_cvterm_id = SGN::Model::Cvterm->get_cvterm_row($schema, 'plant', 'stock_type')->cvterm_id();
 335
 336     foreach (@$file_members) {
 337         my $image = SGN::Image->new( $dbh, undef, $c );
 338         #print STDERR Dumper $_;
 339         my $img_name = substr($_->fileName(), 0, -24);
 340         $img_name =~ s/^.*photos\///;
 341         my $stock = $schema->resultset("Stock::Stock")->find( { uniquename => $img_name, 'me.type_id' => [$plot_cvterm_id, $plant_cvterm_id] } );
 342         my $stock_id = $stock->stock_id;
 343
 344         my $temp_file = $image->upload_zipfile_images($_);
 345
 346         #Check if image already stored in database
 347         my $md5checksum = $image->calculate_md5sum($temp_file);
 348         #print STDERR "MD5: $md5checksum\n";
 349         my $md_image = $metadata_schema->resultset("MdImage")->search({md5sum=>$md5checksum})->count();
 350         #print STDERR "Count: $md_image\n";
 351         if ($md_image > 0) {
 352             print STDERR Dumper "Image $temp_file has already been added to the database and will not be added again.";
 353             $error_status .= "Image $temp_file has already been added to the database and will not be added again.<br/><br/>";
 354         } else {
 355             $image->set_sp_person_id($user_id);
 356             my $ret = $image->process_image($temp_file, 'stock', $stock_id);
 357             if (!$ret ) {
 358                 $error_status .= "Image processing for $temp_file did not work. Image not associated to stock_id $stock_id.<br/><br/>";
 359             }
 360         }
 361     }
 362     return $error_status;
 363 }
 364
 365 sub upload_phenotypes_associated_images_zipfile {
 366     my $self = shift;
 367     my $image_zip = shift;
 368     my $user_id = shift;
 369     my $image_observation_unit_hash = shift;
 370     my $image_type_name = shift;
 371     print STDERR "Doing upload_phenotypes_associated_images_zipfile\n";
 372     my $c = $self->config();
 373     my $schema = $c->dbic_schema("Bio::Chado::Schema");
 374     my $metadata_schema = $c->dbic_schema("CXGN::Metadata::Schema");
 375     my $dbh = $schema->storage->dbh;
 376     my $archived_zip = CXGN::ZipFile->new(archived_zipfile_path=>$image_zip);
 377     my $file_members = $archived_zip->file_members();
 378     if (!$file_members){
 379         return {error => 'Could not read your zipfile. Is is .zip format?</br></br>'};
 380     }
 381
 382     my $linking_table_type_id = SGN::Model::Cvterm->get_cvterm_row($schema, $image_type_name, 'project_md_image')->cvterm_id();
 383
 384     my $image_tag_id = CXGN::Tag::exists_tag_named($schema->storage->dbh, $image_type_name);
 385     if (!$image_tag_id) {
 386         my $image_tag = CXGN::Tag->new($schema->storage->dbh);
 387         $image_tag->set_name($image_type_name);
 388         $image_tag->set_description('Upload phenotype spreadsheet with associated images: '.$image_type_name);
 389         $image_tag->set_sp_person_id($user_id);
 390         $image_tag_id = $image_tag->store();
 391     }
 392     my $image_tag = CXGN::Tag->new($schema->storage->dbh, $image_tag_id);
 393
 394     my %observationunit_stock_id_image_id;
 395     foreach (@$file_members) {
 396         my $image = SGN::Image->new( $dbh, undef, $c );
 397         my $img_name = basename($_->fileName());
 398         my $basename;
 399         my $file_ext;
 400         if ($img_name =~ m/(.*)(\.(?!\.).*)$/) {  # extension is what follows last .
 401             $basename = $1;
 402             $file_ext = $2;
 403         }
 404         my $stock_id = $image_observation_unit_hash->{$img_name}->{stock_id};
 405         my $project_id = $image_observation_unit_hash->{$img_name}->{project_id};
 406         if ($stock_id && $project_id) {
 407             my $temp_file = $image->upload_zipfile_images($_);
 408
 409             #Check if image already stored in database
 410             $image = SGN::Image->new( $schema->storage->dbh, undef, $c );
 411             my $q = "SELECT md_image.image_id FROM metadata.md_image AS md_image
 412                 JOIN phenome.project_md_image AS project_md_image ON(project_md_image.image_id = md_image.image_id)
 413                 JOIN phenome.stock_image AS stock_image ON (stock_image.image_id = md_image.image_id)
 414                 WHERE md_image.obsolete = 'f' AND project_md_image.type_id = $linking_table_type_id AND project_md_image.project_id = $project_id AND stock_image.stock_id = $stock_id AND md_image.original_filename = '$basename';";
 415             my $h = $schema->storage->dbh->prepare($q);
 416             $h->execute();
 417             my ($saved_image_id) = $h->fetchrow_array();
 418             my $image_id;
 419             if ($saved_image_id) {
 420                 print STDERR Dumper "Image $temp_file has already been added to the database and will not be added again.";
 421                 $image = SGN::Image->new( $schema->storage->dbh, $saved_image_id, $c );
 422                 $image_id = $image->get_image_id();
 423             }
 424             else {
 425                 $image->set_sp_person_id($user_id);
 426                 my $ret = $image->process_image($temp_file, 'project', $project_id, $linking_table_type_id);
 427                 if (!$ret ) {
 428                     return {error => "Image processing for $temp_file did not work. Image not associated to stock_id $stock_id.<br/><br/>"};
 429                 }
 430                 print STDERR "Saved $temp_file\n";
 431                 my $stock_associate = $image->associate_stock($stock_id);
 432                 $image_id = $image->get_image_id();
 433                 my $added_image_tag_id = $image->add_tag($image_tag);
 434             }
 435             $observationunit_stock_id_image_id{$stock_id} = $image_id;
 436         }
 437         else {
 438             print STDERR "$img_name Not Included in the uploaded phenotype spreadsheet, skipping..\n";
 439         }
 440     }
 441     return {return => \%observationunit_stock_id_image_id};
 442 }
 443
 444 sub upload_drone_imagery_zipfile {
 445     my $self = shift;
 446     my $image_zip = shift;
 447     my $user_id = shift;
 448     my $project_id = shift;
 449     my $c = $self->config();
 450     my $schema = $c->dbic_schema("Bio::Chado::Schema");
 451     my $metadata_schema = $c->dbic_schema("CXGN::Metadata::Schema");
 452     my $dbh = $schema->storage->dbh;
 453
 454     my $archived_zip = CXGN::ZipFile->new(archived_zipfile_path=>$image_zip);
 455     my $file_members = $archived_zip->file_members();
 456     if (!$file_members){
 457         return {error => 'Could not read your zipfile. Is it .zip format?</br></br>'};
 458     }
 459
 460     my $linking_table_type_id = SGN::Model::Cvterm->get_cvterm_row($schema, 'raw_drone_imagery', 'project_md_image')->cvterm_id();
 461     print STDERR Dumper scalar(@$file_members);
 462     my @image_files;
 463     foreach (@$file_members) {
 464         my $image = SGN::Image->new( $dbh, undef, $c );
 465         #print STDERR Dumper $_;
 466         my $temp_file = $image->upload_zipfile_images($_);
 467         push @image_files, $temp_file;
 468     }
 469     return {image_files => \@image_files};
 470 }
 471
 472 sub upload_zipfile_images {
 473     my $self   = shift;
 474     my $file_member = shift;
 475
 476     my $filename = $file_member->fileName();
 477
 478     my $zipfile_image_temp_path = $self->config()->get_conf("basepath") . $self->config()->get_conf("tempfiles_subdir") . "/temp_images/photos";
 479     make_path($zipfile_image_temp_path);
 480     my $temp_file =
 481         $self->config()->get_conf("basepath")
 482       . $self->config()->get_conf("tempfiles_subdir")
 483       . "/temp_images/"
 484       . $filename;
 485     system("chmod 775 $zipfile_image_temp_path");
 486     $file_member->extractToFileNamed($temp_file);
 487     return $temp_file;
 488 }
 489
 490
 491 sub upload_image {
 492     my $self = shift;
 493     my $temp_file = shift;
 494     my $upload_fh = shift;
 495
 496     ### 11/30/07 - change this so it removes existing file
 497     #     -deanx
 498     # # only copy file if it doesn't already exist
 499     # #
 500     if ( -e $temp_file ) {
 501         unlink $temp_file;
 502     }
 503
 504     open UPLOADFILE, '>', $temp_file or die "Could not write to $temp_file: $!\n";
 505
 506     binmode UPLOADFILE;
 507     while (<$upload_fh>) {
 508
 509         #warn "Read another chunk...\n";
 510         print UPLOADFILE;
 511     }
 512     close UPLOADFILE;
 513     warn "Done uploading.\n";
 514
 515     return $temp_file;
 516 }
 517
 518 =head2 associate_stock
 519
 520  Usage: $image->associate_stock($stock_id);
 521  Desc:  associate a Bio::Chado::Schema::Result::Stock::Stock object with this image
 522  Ret:   a database id (stock_image_id)
 523  Args:  stock_id
 524  Side Effects:
 525  Example:
 526
 527 =cut
 528
 529 sub associate_stock  {
 530     my $self = shift;
 531     my $stock_id = shift;
 532     my $username = shift;
 533     if ($stock_id) {
 534         if (!$username) {
 535             $username = $self->config->can('user_exists') ? $self->config->user->get_object->get_username : $self->config->username;
 536         }
 537         if ($username) {
 538             my $metadata_schema = $self->config->dbic_schema('CXGN::Metadata::Schema');
 539             my $metadata = CXGN::Metadata::Metadbdata->new($metadata_schema, $username);
 540             my $metadata_id = $metadata->store()->get_metadata_id();
 541
 542             my $q = "INSERT INTO phenome.stock_image (stock_id, image_id, metadata_id) VALUES (?,?,?) RETURNING stock_image_id";
 543             my $sth = $self->get_dbh->prepare($q);
 544             $sth->execute($stock_id, $self->get_image_id, $metadata_id);
 545             my ($stock_image_id) = $sth->fetchrow_array;
 546             return $stock_image_id;
 547         }
 548         else {
 549             die "No username. Could not save image-stock association!\n";
 550         }
 551     }
 552     return undef;
 553 }
 554
 555 =head2 remove_stock
 556
 557  Usage: $image->remove_stock($stock_id);
 558  Desc:  remove an association to Bio::Chado::Schema::Result::Stock::Stock object with this image
 559  Ret:   a database id (stock_image_id)
 560  Args:  stock_id
 561  Side Effects:
 562  Example:
 563
 564 =cut
 565
 566 sub remove_stock  {
 567     my $self = shift;
 568     my $stock_id = shift;
 569     if ($stock_id) {
 570         my $q = "DELETE FROM phenome.stock_image WHERE stock_id = ? AND image_id = ?";
 571         my $sth = $self->get_dbh->prepare($q);
 572         $sth->execute($stock_id, $self->get_image_id);
 573     }
 574     return undef;
 575 }
 576
 577 =head2 get_stocks
 578
 579  Usage: $image->get_stocks
 580  Desc:  find all stock objects linked with this image
 581  Ret:   a list of Bio::Chado::Schema::Result::Stock::Stock
 582  Args:  none
 583
 584 =cut
 585
 586 sub get_stocks {
 587     my $self = shift;
 588     my $schema = $self->config->dbic_schema('Bio::Chado::Schema' , 'sgn_chado');
 589     my @stocks;
 590     my $q = "SELECT stock_id FROM phenome.stock_image WHERE image_id = ? ";
 591     my $sth = $self->get_dbh->prepare($q);
 592     $sth->execute($self->get_image_id);
 593     while (my ($stock_id) = $sth->fetchrow_array) {
 594         my $stock = $schema->resultset("Stock::Stock")->find( { stock_id => $stock_id } ) ;
 595         push @stocks, $stock;
 596     }
 597     return @stocks;
 598 }
 599 =head2 associate_individual
 600
 601  Usage:        DEPRECATED, Individual table is not used any more . Please use stock instead
 602                $image->associate_individual($individual_id)
 603  Desc:         associate a CXGN::Phenome::Individual with this image
 604  Ret:          a database id (individual_image)
 605  Args:         individual_id
 606  Side Effects:
 607  Example:
 608
 609 =cut
 610
 611 sub associate_individual {
 612     my $self = shift;
 613     my $individual_id = shift;
 614     warn "DEPRECATED. Individual table is not used any more . Please use stock instead";
 615     my $query = "INSERT INTO phenome.individual_image
 616                    (individual_id, image_id) VALUES (?, ?)";
 617     my $sth = $self->get_dbh()->prepare($query);
 618     $sth->execute($individual_id, $self->get_image_id());
 619
 620     my $id= $self->get_currval("phenome.individual_image_individual_image_id_seq");
 621     return $id;
 622 }
 623
 624
 625 =head2 get_individuals
 626
 627  Usage:  DEPRECATED. Use the stock table .
 628         $self->get_individuals()
 629  Desc:  find associated individuals with the image
 630  Ret:   list of 'Individual' objects
 631  Args:  none
 632  Side Effects: none
 633  Example:
 634
 635 =cut
 636
 637 sub get_individuals {
 638     my $self = shift;
 639     warn "DEPRECATED. Individual table is not used any more . Please use stock instead";
 640     my $query = "SELECT individual_id FROM phenome.individual_image WHERE individual_image.image_id=?";
 641     my $sth = $self->get_dbh()->prepare($query);
 642     $sth->execute($self->get_image_id());
 643     my @individuals;
 644     while (my ($individual_id) = $sth->fetchrow_array()) {
 645         my $i = CXGN::Phenome::Individual->new($self->get_dbh(), $individual_id);
 646         if ( $i->get_individual_id() ) { push @individuals, $i; } #obsolete individuals should be ignored!
 647     }
 648     return @individuals;
 649 }
 650
 651
 652 =head2 associate_experiment
 653
 654  Usage: $image->associate_experiment($experiment_id);
 655  Desc:  associate and image with and insitu experiment
 656  Ret:   a database id
 657  Args:  experiment_id
 658  Side Effects:
 659  Example:
 660
 661 =cut
 662
 663 sub associate_experiment {
 664     my $self = shift;
 665     my $experiment_id = shift;
 666     my $query = "INSERT INTO insitu.experiment_image
 667                  (image_id, experiment_id)
 668                  VALUES (?, ?)";
 669     my $sth = $self->get_dbh()->prepare($query);
 670     $sth->execute($self->get_image_id(), $experiment_id);
 671     my $id= $self->get_currval("insitu.experiment_image_experiment_image_id_seq");
 672     return $id;
 673
 674 }
 675
 676 =head2 get_experiments
 677
 678  Usage:
 679  Desc:
 680  Ret:          a list of CXGN::Insitu::Experiment objects associated
 681                with this image
 682  Args:
 683  Side Effects:
 684  Example:
 685
 686 =cut
 687
 688 sub get_experiments {
 689     my $self = shift;
 690     my $query = "SELECT experiment_id FROM insitu.experiment_image
 691                  WHERE image_id=?";
 692     my $sth = $self->get_dbh()->prepare($query);
 693     $sth->execute($self->get_image_id());
 694     my @experiments = ();
 695     while (my ($experiment_id) = $sth->fetchrow_array()) {
 696         push @experiments, CXGN::Insitu::Experiment->new($self->get_dbh(), $experiment_id);
 697     }
 698     return @experiments;
 699 }
 700
 701 =head2 associate_project
 702
 703  Usage: $image->associate_project($project_id);
 704  Desc:  associate an image with an project entry via the phenome.project_md_image table
 705  Ret:   a database id
 706  Args:  experiment_id
 707  Side Effects:
 708  Example:
 709
 710 =cut
 711
 712 sub associate_project {
 713     my $self = shift;
 714     my $project_id = shift;
 715     my $linking_table_type_id = shift;
 716     my $query = "INSERT INTO phenome.project_md_image
 717                  (image_id, project_id, type_id)
 718                  VALUES (?, ?, ?)";
 719     my $sth = $self->get_dbh()->prepare($query);
 720     $sth->execute($self->get_image_id(), $project_id, $linking_table_type_id);
 721     my $id= $self->get_currval("phenome.project_md_image_project_md_image_id_seq");
 722     return $id;
 723 }
 724
 725 =head2 associate_fish_result
 726
 727  Usage:        $image->associate_fish_result($fish_result_id)
 728  Desc:         associate a CXGN::Phenome::Individual with this image
 729  Ret:          database_id
 730  Args:         fish_result_id
 731  Side Effects:
 732  Example:
 733
 734 =cut
 735
 736 sub associate_fish_result {
 737     my $self = shift;
 738     my $fish_result_id = shift;
 739     my $query = "INSERT INTO sgn.fish_result_image
 740                    (fish_result_id, image_id) VALUES (?, ?)";
 741     my $sth = $self->get_dbh()->prepare($query);
 742     $sth->execute($fish_result_id, $self->get_image_id());
 743     my $id= $self->get_currval("sgn.fish_result_image_fish_result_image_id_seq");
 744     return $id;
 745 }
 746
 747 =head2 get_fish_result_clone_ids
 748
 749  Usage:        my @clone_ids = $image->get_fish_result_clones();
 750  Desc:         because fish results are associated with genomic
 751                clones, this function returns the genomic clone ids
 752                that are associated through the fish results to
 753                this image. The clone ids can be used to construct
 754                links to the BAC detail page.
 755  Ret:          A list of clone_ids
 756  Args:
 757  Side Effects:
 758  Example:
 759
 760 =cut
 761
 762 sub get_fish_result_clone_ids {
 763     my $self = shift;
 764     my $query = "SELECT distinct(clone_id) FROM sgn.fish_result_image join sgn.fish_result using(fish_result_id)  WHERE fish_result_image.image_id=?";
 765     my $sth = $self->get_dbh()->prepare($query);
 766     $sth->execute($self->get_image_id());
 767     my @fish_result_clone_ids = ();
 768     while (my ($fish_result_clone_id) = $sth->fetchrow_array()) {
 769         push @fish_result_clone_ids, $fish_result_clone_id;
 770     }
 771     return @fish_result_clone_ids;
 772 }
 773
 774 =head2 get_associated_objects
 775
 776   Synopsis:
 777   Arguments:
 778   Returns:
 779   Side effects:
 780   Description:
 781
 782 =cut
 783
 784 sub get_associated_objects {
 785     my $self = shift;
 786     my @associations = ();
 787     my @stocks=$self->get_stocks();
 788     foreach my $stock (@stocks) {
 789         my $stock_id = $stock->stock_id();
 790         my $stock_name = $stock->name();
 791         push @associations, [ "stock", $stock_id, $stock_name ];
 792     }
 793
 794     foreach my $exp ($self->get_experiments()) {
 795         my $experiment_id = $exp->get_experiment_id();
 796         my $experiment_name = $exp->get_name();
 797
 798         push @associations, [ "experiment", $experiment_id, $experiment_name ];
 799
 800         #print "<a href=\"/insitu/detail/experiment.pl?experiment_id=$experiment_id&amp;action=view\">".($exp->get_name())."</a>";
 801     }
 802
 803     foreach my $fish_result_clone_id ($self->get_fish_result_clone_ids()) {
 804         push @associations, [ "fished_clone", $fish_result_clone_id ];
 805     }
 806     foreach my $locus ($self->get_loci() ) {
 807         push @associations, ["locus", $locus->get_locus_id(), $locus->get_locus_name];
 808     }
 809     foreach my $o ($self->get_organisms ) {
 810         push @associations, ["organism", $o->organism_id, $o->species];
 811     }
 812
 813     foreach my $cvterm ( $self->get_cvterms ) {
 814         push @associations, ["cvterm" , $cvterm->cvterm_id, $cvterm->name];
 815     }
 816     return @associations;
 817 }
 818
 819 =head2 associate_locus
 820
 821  Usage:        $image->associate_locus($locus_id)
 822  Desc:         associate a locus with this image
 823  Ret:          database_id
 824  Args:         locus_id
 825  Side Effects:
 826  Example:
 827
 828 =cut
 829
 830 sub associate_locus {
 831     my $self = shift;
 832     my $locus_id = shift;
 833     my $sp_person_id= $self->get_sp_person_id();
 834     my $query = "INSERT INTO phenome.locus_image
 835                    (locus_id,
 836                    sp_person_id,
 837                    image_id)
 838                  VALUES (?, ?, ?)";
 839     my $sth = $self->get_dbh()->prepare($query);
 840     $sth->execute(
 841                 $locus_id,
 842                 $sp_person_id,
 843                 $self->get_image_id()
 844                 );
 845
 846     my $locus_image_id= $self->get_currval("phenome.locus_image_locus_image_id_seq");
 847     return $locus_image_id;
 848 }
 849
 850
 851 =head2 get_loci
 852
 853  Usage:   $self->get_loci
 854  Desc:    find the locus objects asociated with this image
 855  Ret:     a list of locus objects
 856  Args:    none
 857  Side Effects: none
 858  Example:
 859
 860 =cut
 861
 862 sub get_loci {
 863     my $self = shift;
 864     my $query = "SELECT locus_id FROM phenome.locus_image WHERE locus_image.obsolete = 'f' and locus_image.image_id=?";
 865     my $sth = $self->get_dbh()->prepare($query);
 866     $sth->execute($self->get_image_id());
 867     my $locus;
 868     my @loci = ();
 869     while (my ($locus_id) = $sth->fetchrow_array()) {
 870        $locus = CXGN::Phenome::Locus->new($self->get_dbh(), $locus_id);
 871         push @loci, $locus;
 872     }
 873     return @loci;
 874 }
 875
 876
 877 =head2 associate_organism
 878
 879  Usage:        $image->associate_organism($organism_id)
 880  Desc:
 881  Ret:
 882  Args:
 883  Side Effects:
 884  Example:
 885
 886 =cut
 887
 888 sub associate_organism {
 889     my $self = shift;
 890     my $organism_id = shift;
 891     my $sp_person_id= $self->get_sp_person_id();
 892     my $query = "INSERT INTO metadata.md_image_organism
 893                    (image_id,
 894                    sp_person_id,
 895                    organism_id)
 896                  VALUES (?, ?, ?) RETURNING md_image_organism_id";
 897     my $sth = $self->get_dbh()->prepare($query);
 898     $sth->execute(
 899         $self->get_image_id,
 900         $sp_person_id,
 901         $organism_id,
 902         );
 903     my ($image_organism_id) = $sth->fetchrow_array;
 904     return $image_organism_id;
 905 }
 906
 907 =head2 get_organisms
 908
 909  Usage:   $self->get_organisms
 910  Desc:    find the organism objects asociated with this image
 911  Ret:     a list of BCS Organism objects
 912  Args:    none
 913  Side Effects: none
 914  Example:
 915
 916 =cut
 917
 918 sub get_organisms {
 919     my $self = shift;
 920     my $schema = $self->config->dbic_schema('Bio::Chado::Schema' , 'sgn_chado');
 921     my $query = "SELECT organism_id FROM metadata.md_image_organism WHERE md_image_organism.obsolete != 't' and md_image_organism.image_id=?";
 922     my $sth = $self->get_dbh()->prepare($query);
 923     $sth->execute($self->get_image_id());
 924     my @organisms = ();
 925     while (my ($o_id) = $sth->fetchrow_array ) {
 926         push @organisms, $schema->resultset("Organism::Organism")->find(
 927             { organism_id => $o_id } );
 928     }
 929     return @organisms;
 930 }
 931
 932
 933 =head2 get_associated_object_links
 934
 935   Synopsis:
 936   Arguments:
 937   Returns:      a string
 938   Side effects:
 939   Description:  gets the associated objects as links in tabular format
 940
 941 =cut
 942
 943 sub get_associated_object_links {
 944     my $self = shift;
 945     my $s = "";
 946     foreach my $assoc ($self->get_associated_objects()) {
 947
 948         if ($assoc->[0] eq "stock") {
 949             $s .= "<a href=\"/stock/$assoc->[1]/view\">Stock name: $assoc->[2].</a>";
 950         }
 951
 952         if ($assoc->[0] eq "experiment") {
 953             $s .= "<a href=\"/insitu/detail/experiment.pl?experiment_id=$assoc->[1]&amp;action=view\">insitu experiment $assoc->[2]</a>";
 954         }
 955
 956         if ($assoc->[0] eq "fished_clone") {
 957             $s .= qq { <a href="/maps/physical/clone_info.pl?id=$assoc->[1]">FISHed clone id:$assoc->[1]</a> };
 958         }
 959         if ($assoc->[0] eq "locus" ) {
 960             $s .= qq { <a href="/phenome/locus_display.pl?locus_id=$assoc->[1]">Locus name:$assoc->[2]</a> };
 961         }
 962         if ($assoc->[0] eq "organism" ) {
 963             $s .= qq { <a href="/organism/$assoc->[1]/view/">Organism name:$assoc->[2]</a> };
 964         }
 965         if ($assoc->[0] eq "cvterm" ) {
 966             $s .= qq { <a href="/cvterm/$assoc->[1]/view/">Cvterm: $assoc->[2]</a> };
 967         }
 968     }
 969     return $s;
 970 }
 971
 972
 973 =head2 associate_cvterm
 974
 975  Usage: $image->associate_cvterm($cvterm_id)
 976  Desc:  link uploaded image with a cvterm
 977  Ret:   database ID md_image_cvterm_id
 978  Args:  $cvterm_id
 979  Side Effects: Insert database row
 980  Example:
 981
 982 =cut
 983
 984 sub associate_cvterm {
 985     my $self = shift;
 986     my $cvterm_id = shift;
 987     my $sp_person_id= $self->get_sp_person_id();
 988     my $query = "INSERT INTO metadata.md_image_cvterm
 989                    (image_id,
 990                    sp_person_id,
 991                    cvterm_id)
 992                  VALUES (?, ?, ?) RETURNING md_image_cvterm_id";
 993     my $sth = $self->get_dbh()->prepare($query);
 994     $sth->execute(
 995         $self->get_image_id,
 996         $sp_person_id,
 997         $cvterm_id,
 998         );
 999     my ($image_cvterm_id) = $sth->fetchrow_array;
1000     return $image_cvterm_id;
1001 }
1002
1003 =head2 get_cvterms
1004
1005  Usage:   $self->get_cvterms
1006  Desc:    find the cvterm objects asociated with this image
1007  Ret:     a list of BCS Cvterm objects
1008  Args:    none
1009  Side Effects: none
1010  Example:
1011
1012 =cut
1013
1014 sub get_cvterms {
1015     my $self = shift;
1016     my $schema = $self->config->dbic_schema('Bio::Chado::Schema' , 'sgn_chado');
1017     my $query = "SELECT cvterm_id FROM metadata.md_image_cvterm WHERE md_image_cvterm.obsolete != 't' and md_image_cvterm.image_id=?";
1018     my $sth = $self->get_dbh()->prepare($query);
1019     $sth->execute( $self->get_image_id() );
1020     my @cvterms = ();
1021     while (my ($cvterm_id) = $sth->fetchrow_array ) {
1022         push @cvterms, $schema->resultset("Cv::Cvterm")->find(
1023             { cvterm_id => $cvterm_id } );
1024     }
1025     return @cvterms;
1026 }
1027
1028 =head2 remove_associated_cvterm
1029
1030  Usage:   $self->remove_associated_cvterm($cvterm_id)
1031  Desc:    removes the specified cvterm associated with this image
1032  Ret:     none
1033  Args:    none
1034  Side Effects: none
1035  Example:
1036
1037 =cut
1038
1039 sub remove_associated_cvterm {
1040
1041     my $self = shift;
1042     my $cvterm_id = shift;
1043     my $query = "DELETE FROM metadata.md_image_cvterm
1044                     WHERE cvterm_id=? and image_id=?";
1045
1046     my $sth = $self->get_dbh()->prepare($query);
1047     $sth->execute(
1048         $cvterm_id,
1049         $self->get_image_id,
1050     );
1051
1052     return undef;
1053 }
1054
1055 sub associate_phenotype {
1056
1057     my $self = shift;
1058     my $image_hash = shift;
1059
1060     # Copied from CXGN::Phenotypes:StorePhenotypes->save_archived_images_metadata because
1061     # the class required too many parameters to instantiate.
1062     my $query = "INSERT into phenome.nd_experiment_md_images (nd_experiment_id, image_id) VALUES (?, ?);";
1063     my $sth = $self->get_dbh()->prepare($query);
1064
1065     while (my ($nd_experiment_id, $image_id) = each %$image_hash) {
1066         $sth->execute($nd_experiment_id, $image_id);
1067     }
1068
1069     return undef;
1070 }
1071
1072 sub remove_associated_phenotypes {
1073
1074     my $self = shift;
1075
1076     # Find the information for creating our association row
1077     my $query = "DELETE from phenome.nd_experiment_md_images where image_id = ?";
1078
1079     my $sth = $self->get_dbh()->prepare($query);
1080     $sth->execute(
1081         $self->get_image_id,
1082     );
1083
1084 }
1085
1086 1;