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
  53 use CatalystX::GlobalContext '$c';
  54
  55 use base qw| CXGN::Image |;
  56
  57 =head2 new
  58
  59  Usage:        my $image = SGN::Image->new($dbh)
  60  Desc:         constructor
  61  Ret:
  62  Args:         a database handle, optional identifier
  63  Side Effects: an empty object is returned.
  64                a database connection is established.
  65  Example:
  66
  67 =cut
  68
  69 sub new {
  70     my ( $class, $dbh, $image_id, $context ) = @_;
  71     $context ||= $c;
  72
  73     my $self = $class->SUPER::new(
  74         dbh       => $dbh || $context->dbc->dbh,
  75         image_id  => $image_id,
  76         image_dir => $context->get_conf('static_datasets_path')."/".$context->get_conf('image_dir'),
  77       );
  78
  79     $self->config( $context );
  80
  81     return $self;
  82 }
  83
  84
  85
  86 =head2 get_image_url
  87
  88  Usage: $self->get_image_url($size)
  89  Desc:  get the url for the image with a given size
  90  Ret:   a url for the image
  91  Args:  size (large, medium, small, thumbnail,  original)
  92  Side Effects: none
  93  Example:
  94
  95 =cut
  96
  97 sub get_image_url {
  98     my $self = shift;
  99     my $size = shift;
 100
 101     if( $self->config->test_mode && ! -e $self->get_filename($size) ) {
 102         # for performance, only try to stat the file if running in
 103         # test mode. doing lots of file stats over NFS can actually be
 104         # quite expensive.
 105         return '/img/image_temporarily_unavailable.png';
 106     }
 107
 108     my $url = join '/', (
 109          '',
 110          $self->config()->get_conf('static_datasets_url'),
 111          $self->config()->get_conf('image_dir'),
 112          $self->get_filename($size, 'partial'),
 113      );
 114     $url =~ s!//!/!g;
 115     return $url;
 116 }
 117
 118 =head2 process_image
 119
 120  Usage:        $image->process_image($filename, "stock", 234);
 121  Desc:         creates the image and associates it to the type and type_id
 122  Ret:
 123  Args:         filename, type (experiment, stock, fish, locus, organism) , type_id
 124  Side Effects: Calls the relevant $image->associate_$type function
 125  Example:
 126
 127 =cut
 128
 129 sub process_image {
 130     my $self = shift;
 131     my ($filename, $type, $type_id) = @_;
 132
 133     $self->SUPER::process_image($filename);
 134
 135     if ( $type eq "experiment" ) {
 136         #print STDERR "Associating experiment $type_id...\n";
 137         $self->associate_experiment($type_id);
 138     }
 139     elsif ( $type eq "stock" ) {
 140         #print STDERR "Associating stock $type_id...\n";
 141         $self->associate_stock($type_id);
 142     }
 143     elsif ( $type eq "fish" ) {
 144         #print STDERR "Associating to fish experiment $type_id\n";
 145         $self->associate_fish_result($type_id);
 146     }
 147     elsif ( $type eq "locus" ) {
 148         #print STDERR "Associating to locus $type_id\n";
 149         $self->associate_locus($type_id);
 150     }
 151     elsif ( $type eq "organism" ) {
 152         $self->associate_organism($type_id);
 153     }
 154     elsif ( $type eq "cvterm" ) {
 155         $self->associate_cvterm($type_id);
 156     }
 157
 158     elsif ( $type eq "test") {
 159         # need to return something to make this function happy
 160         return 1;
 161
 162     }
 163     else {
 164         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";
 165     }
 166
 167 }
 168
 169 =head2 config, context, _app
 170
 171 Get the Catalyst context object we are running with.
 172
 173 =cut
 174
 175 sub config {
 176     my ($self,$obj) = @_;
 177
 178     $self->{configuration_object} = $obj if $obj;
 179
 180     return $self->{configuration_object};
 181 }
 182 *context = \&config;
 183 *_app    = \&config;
 184
 185 =head2 get_img_src_tag
 186
 187  Usage:
 188  Desc:
 189  Ret:
 190  Args:         "large" | "medium" | "small" | "thumbnail" | "original" | "tiny"
 191                default is medium
 192  Side Effects:
 193  Example:
 194
 195 =cut
 196
 197 sub get_img_src_tag {
 198     my $self = shift;
 199     my $size = shift;
 200     my $url  = $self->get_image_url($size);
 201     my $name = $self->get_name();
 202     if ( $size && $size eq "original" ) {
 203
 204         my $static = $self->config()->get_conf("static_datasets_url");
 205
 206         return
 207             "<a href=\""
 208           . ($url)
 209           . "\"><img src=\"$static/images/download_icon.png\" border=\"0\" alt=\""
 210           . $name
 211           . "\" /></a>";
 212     }
 213     elsif ( $size && $size eq "tiny" ) {
 214         return
 215             "<img src=\""
 216           . ($url)
 217           . "\" width=\"20\" height=\"15\" border=\"0\" alt=\""
 218           . $name
 219           . "\" />\n";
 220     }
 221     else {
 222         return
 223             "<img src=\""
 224           . ($url)
 225           . "\" border=\"0\" alt=\""
 226           . $name
 227           . "\" />\n";
 228     }
 229 }
 230
 231 =head2 get_temp_filename
 232
 233  Usage:
 234  Desc:
 235  Ret:
 236  Args:
 237  Side Effects:
 238  Example:
 239
 240 =cut
 241
 242 sub get_temp_filename {
 243     my $self = shift;
 244     return $self->{temp_filename};
 245
 246 }
 247
 248 =head2 set_temp_filename
 249
 250  Usage:
 251  Desc:
 252  Ret:
 253  Args:
 254  Side Effects:
 255  Example:
 256
 257 =cut
 258
 259 sub set_temp_filename {
 260     my $self = shift;
 261     $self->{temp_filename} = shift;
 262 }
 263
 264 =head2 apache_upload_image
 265
 266  DEPRECATED.
 267
 268  Usage:        my $temp_file_name = $image->apache_upload_image($apache_upload_object);
 269  Desc:
 270  Ret:          the name of the intermediate tempfile that can be
 271                used to access down the road.
 272  Args:         an apache upload object
 273  Side Effects: generates an intermediate temp file from an apache request
 274                that can be handled more easily. Adds the remote IP addr to the
 275                filename so that different uploaders don\'t clobber but
 276                allows only one upload per remote addr at a time.
 277  Errors:       change 11/30/07 - removes temp file if already exists
 278                # returns -1 if the intermediate temp file already exists.
 279                # this probably means that the submission button was hit twice
 280                # and that an upload is already in progress.
 281  Example:
 282
 283 =cut
 284
 285 sub apache_upload_image {
 286     my $self   = shift;
 287     my $upload = shift;
 288     ###  deanx jan 03 2007
 289 # Adjust File name if using Windows IE - it sends whole paht; drive letter, path, and filename
 290     my $upload_filename;
 291     if ( $ENV{HTTP_USER_AGENT} =~ /msie/i ) {
 292         my ( $directory, $filename ) = $upload->filename =~ m/(.*\\)(.*)$/;
 293         $upload_filename = $filename;
 294     }
 295     else {
 296         $upload_filename = $upload->filename;
 297     }
 298
 299     my $upload_fh = $upload->fh;
 300
 301     my $temp_file =
 302         $self->config()->get_conf("basepath") . "/"
 303       . $self->config()->get_conf("tempfiles_subdir")
 304       . "/temp_images/"
 305       . $ENV{REMOTE_ADDR} . "-"
 306       . $upload_filename;
 307
 308     my $ret_temp_file = $self->upload_image($temp_file, $upload_fh);
 309     return $ret_temp_file;
 310
 311 }
 312
 313 sub upload_fieldbook_zipfile {
 314     my $self = shift;
 315     my $image_zip = shift;
 316     my $user_id = shift;
 317     my $c = $self->config();
 318     my $schema = $c->dbic_schema("Bio::Chado::Schema");
 319     my $metadata_schema = $c->dbic_schema("CXGN::Metadata::Schema");
 320     my $dbh = $schema->storage->dbh;
 321     my $archived_zip = CXGN::ZipFile->new(archived_zipfile_path=>$image_zip);
 322     my $file_members = $archived_zip->file_members();
 323     my $plot_cvterm_id = SGN::Model::Cvterm->get_cvterm_row($schema, 'plot', 'stock_type')->cvterm_id();
 324     my $plant_cvterm_id = SGN::Model::Cvterm->get_cvterm_row($schema, 'plant', 'stock_type')->cvterm_id();
 325     my $error_status;
 326
 327     foreach (@$file_members) {
 328         my $image = SGN::Image->new( $dbh, undef, $c );
 329         #print STDERR Dumper $_;
 330         my $img_name = substr($_->fileName(), 0, -24);
 331         $img_name =~ s/^.*photos\///;
 332         my $stock = $schema->resultset("Stock::Stock")->find( { uniquename => $img_name, 'me.type_id' => [$plot_cvterm_id, $plant_cvterm_id] } );
 333         my $stock_id = $stock->stock_id;
 334
 335         my $temp_file = $image->upload_zipfile_images($_);
 336
 337         #Check if image already stored in database
 338         my $md5checksum = $image->calculate_md5sum($temp_file);
 339         #print STDERR "MD5: $md5checksum\n";
 340         my $md_image = $metadata_schema->resultset("MdImage")->search({md5sum=>$md5checksum})->count();
 341         #print STDERR "Count: $md_image\n";
 342         if ($md_image > 0) {
 343             $error_status .= "Image $temp_file has already been added to the database and will not be added again.<br/><br/>";
 344         } else {
 345             $image->set_sp_person_id($user_id);
 346             my $ret = $image->process_image($temp_file, 'stock', $stock_id);
 347             if (!$ret ) {
 348                 $error_status .= "Image processing for $temp_file did not work. Image not associated to stock_id $stock_id.<br/><br/>";
 349             }
 350         }
 351     }
 352     return $error_status;
 353 }
 354
 355 sub upload_zipfile_images {
 356     my $self   = shift;
 357     my $file_member = shift;
 358
 359     my $filename = $file_member->fileName();
 360
 361     my $zipfile_image_temp_path = $self->config()->get_conf("basepath") . $self->config()->get_conf("tempfiles_subdir") . "/temp_images/photos";
 362     make_path($zipfile_image_temp_path);
 363     my $temp_file =
 364         $self->config()->get_conf("basepath")
 365       . $self->config()->get_conf("tempfiles_subdir")
 366       . "/temp_images/"
 367       . $filename;
 368     system("chmod 775 $zipfile_image_temp_path");
 369     $file_member->extractToFileNamed($temp_file);
 370     print STDERR "Temp Image: ".$temp_file."\n";
 371     return $temp_file;
 372 }
 373
 374
 375 sub upload_image {
 376     my $self = shift;
 377     my $temp_file = shift;
 378     my $upload_fh = shift;
 379
 380     ### 11/30/07 - change this so it removes existing file
 381     #     -deanx
 382     # # only copy file if it doesn't already exist
 383     # #
 384     if ( -e $temp_file ) {
 385         unlink $temp_file;
 386     }
 387
 388     open UPLOADFILE, '>', $temp_file or die "Could not write to $temp_file: $!\n";
 389
 390     binmode UPLOADFILE;
 391     while (<$upload_fh>) {
 392
 393         #warn "Read another chunk...\n";
 394         print UPLOADFILE;
 395     }
 396     close UPLOADFILE;
 397     warn "Done uploading.\n";
 398
 399     return $temp_file;
 400 }
 401
 402 =head2 associate_stock
 403
 404  Usage: $image->associate_stock($stock_id);
 405  Desc:  associate a Bio::Chado::Schema::Result::Stock::Stock object with this image
 406  Ret:   a database id (stock_image_id)
 407  Args:  stock_id
 408  Side Effects:
 409  Example:
 410
 411 =cut
 412
 413 sub associate_stock  {
 414     my $self = shift;
 415     my $stock_id = shift;
 416     if ($stock_id) {
 417         my $username = $self->config->can('user_exists') ? $self->config->user->get_object->get_username : $self->config->username;
 418         if ($username) {
 419             my $metadata_schema = $self->config->dbic_schema('CXGN::Metadata::Schema');
 420             my $metadata = CXGN::Metadata::Metadbdata->new($metadata_schema, $username);
 421             my $metadata_id = $metadata->store()->get_metadata_id();
 422
 423             my $q = "INSERT INTO phenome.stock_image (stock_id, image_id, metadata_id) VALUES (?,?,?) RETURNING stock_image_id";
 424             my $sth = $self->get_dbh->prepare($q);
 425             $sth->execute($stock_id, $self->get_image_id, $metadata_id);
 426             my ($stock_image_id) = $sth->fetchrow_array;
 427             return $stock_image_id;
 428         }
 429     }
 430     return undef;
 431 }
 432
 433 =head2 get_stocks
 434
 435  Usage: $image->get_stocks
 436  Desc:  find all stock objects linked with this image
 437  Ret:   a list of Bio::Chado::Schema::Result::Stock::Stock
 438  Args:  none
 439
 440 =cut
 441
 442 sub get_stocks {
 443     my $self = shift;
 444     my $schema = $self->config->dbic_schema('Bio::Chado::Schema' , 'sgn_chado');
 445     my @stocks;
 446     my $q = "SELECT stock_id FROM phenome.stock_image WHERE image_id = ? ";
 447     my $sth = $self->get_dbh->prepare($q);
 448     $sth->execute($self->get_image_id);
 449     while (my ($stock_id) = $sth->fetchrow_array) {
 450         my $stock = $schema->resultset("Stock::Stock")->find( { stock_id => $stock_id } ) ;
 451         push @stocks, $stock;
 452     }
 453     return @stocks;
 454 }
 455 =head2 associate_individual
 456
 457  Usage:        DEPRECATED, Individual table is not used any more . Please use stock instead
 458                $image->associate_individual($individual_id)
 459  Desc:         associate a CXGN::Phenome::Individual with this image
 460  Ret:          a database id (individual_image)
 461  Args:         individual_id
 462  Side Effects:
 463  Example:
 464
 465 =cut
 466
 467 sub associate_individual {
 468     my $self = shift;
 469     my $individual_id = shift;
 470     warn "DEPRECATED. Individual table is not used any more . Please use stock instead";
 471     my $query = "INSERT INTO phenome.individual_image
 472                    (individual_id, image_id) VALUES (?, ?)";
 473     my $sth = $self->get_dbh()->prepare($query);
 474     $sth->execute($individual_id, $self->get_image_id());
 475
 476     my $id= $self->get_currval("phenome.individual_image_individual_image_id_seq");
 477     return $id;
 478 }
 479
 480
 481 =head2 get_individuals
 482
 483  Usage:  DEPRECATED. Use the stock table .
 484         $self->get_individuals()
 485  Desc:  find associated individuals with the image
 486  Ret:   list of 'Individual' objects
 487  Args:  none
 488  Side Effects: none
 489  Example:
 490
 491 =cut
 492
 493 sub get_individuals {
 494     my $self = shift;
 495     warn "DEPRECATED. Individual table is not used any more . Please use stock instead";
 496     my $query = "SELECT individual_id FROM phenome.individual_image WHERE individual_image.image_id=?";
 497     my $sth = $self->get_dbh()->prepare($query);
 498     $sth->execute($self->get_image_id());
 499     my @individuals;
 500     while (my ($individual_id) = $sth->fetchrow_array()) {
 501         my $i = CXGN::Phenome::Individual->new($self->get_dbh(), $individual_id);
 502         if ( $i->get_individual_id() ) { push @individuals, $i; } #obsolete individuals should be ignored!
 503     }
 504     return @individuals;
 505 }
 506
 507
 508 =head2 associate_experiment
 509
 510  Usage: $image->associate_experiment($experiment_id);
 511  Desc:  associate and image with and insitu experiment
 512  Ret:   a database id
 513  Args:  experiment_id
 514  Side Effects:
 515  Example:
 516
 517 =cut
 518
 519 sub associate_experiment {
 520     my $self = shift;
 521     my $experiment_id = shift;
 522     my $query = "INSERT INTO insitu.experiment_image
 523                  (image_id, experiment_id)
 524                  VALUES (?, ?)";
 525     my $sth = $self->get_dbh()->prepare($query);
 526     $sth->execute($self->get_image_id(), $experiment_id);
 527     my $id= $self->get_currval("insitu.experiment_image_experiment_image_id_seq");
 528     return $id;
 529
 530 }
 531
 532 =head2 get_experiments
 533
 534  Usage:
 535  Desc:
 536  Ret:          a list of CXGN::Insitu::Experiment objects associated
 537                with this image
 538  Args:
 539  Side Effects:
 540  Example:
 541
 542 =cut
 543
 544 sub get_experiments {
 545     my $self = shift;
 546     my $query = "SELECT experiment_id FROM insitu.experiment_image
 547                  WHERE image_id=?";
 548     my $sth = $self->get_dbh()->prepare($query);
 549     $sth->execute($self->get_image_id());
 550     my @experiments = ();
 551     while (my ($experiment_id) = $sth->fetchrow_array()) {
 552         push @experiments, CXGN::Insitu::Experiment->new($self->get_dbh(), $experiment_id);
 553     }
 554     return @experiments;
 555 }
 556
 557 =head2 associate_fish_result
 558
 559  Usage:        $image->associate_fish_result($fish_result_id)
 560  Desc:         associate a CXGN::Phenome::Individual with this image
 561  Ret:          database_id
 562  Args:         fish_result_id
 563  Side Effects:
 564  Example:
 565
 566 =cut
 567
 568 sub associate_fish_result {
 569     my $self = shift;
 570     my $fish_result_id = shift;
 571     my $query = "INSERT INTO sgn.fish_result_image
 572                    (fish_result_id, image_id) VALUES (?, ?)";
 573     my $sth = $self->get_dbh()->prepare($query);
 574     $sth->execute($fish_result_id, $self->get_image_id());
 575     my $id= $self->get_currval("sgn.fish_result_image_fish_result_image_id_seq");
 576     return $id;
 577 }
 578
 579 =head2 get_fish_result_clone_ids
 580
 581  Usage:        my @clone_ids = $image->get_fish_result_clones();
 582  Desc:         because fish results are associated with genomic
 583                clones, this function returns the genomic clone ids
 584                that are associated through the fish results to
 585                this image. The clone ids can be used to construct
 586                links to the BAC detail page.
 587  Ret:          A list of clone_ids
 588  Args:
 589  Side Effects:
 590  Example:
 591
 592 =cut
 593
 594 sub get_fish_result_clone_ids {
 595     my $self = shift;
 596     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=?";
 597     my $sth = $self->get_dbh()->prepare($query);
 598     $sth->execute($self->get_image_id());
 599     my @fish_result_clone_ids = ();
 600     while (my ($fish_result_clone_id) = $sth->fetchrow_array()) {
 601         push @fish_result_clone_ids, $fish_result_clone_id;
 602     }
 603     return @fish_result_clone_ids;
 604 }
 605
 606 =head2 get_associated_objects
 607
 608   Synopsis:
 609   Arguments:
 610   Returns:
 611   Side effects:
 612   Description:
 613
 614 =cut
 615
 616 sub get_associated_objects {
 617     my $self = shift;
 618     my @associations = ();
 619     my @stocks=$self->get_stocks();
 620     foreach my $stock (@stocks) {
 621         my $stock_id = $stock->stock_id();
 622         my $stock_name = $stock->name();
 623         push @associations, [ "stock", $stock_id, $stock_name ];
 624     }
 625
 626     foreach my $exp ($self->get_experiments()) {
 627         my $experiment_id = $exp->get_experiment_id();
 628         my $experiment_name = $exp->get_name();
 629
 630         push @associations, [ "experiment", $experiment_id, $experiment_name ];
 631
 632         #print "<a href=\"/insitu/detail/experiment.pl?experiment_id=$experiment_id&amp;action=view\">".($exp->get_name())."</a>";
 633     }
 634
 635     foreach my $fish_result_clone_id ($self->get_fish_result_clone_ids()) {
 636         push @associations, [ "fished_clone", $fish_result_clone_id ];
 637     }
 638     foreach my $locus ($self->get_loci() ) {
 639         push @associations, ["locus", $locus->get_locus_id(), $locus->get_locus_name];
 640     }
 641     foreach my $o ($self->get_organisms ) {
 642         push @associations, ["organism", $o->organism_id, $o->species];
 643     }
 644
 645     foreach my $cvterm ( $self->get_cvterms ) {
 646         push @associations, ["cvterm" , $cvterm->cvterm_id, $cvterm->name];
 647     }
 648     return @associations;
 649 }
 650
 651 =head2 associate_locus
 652
 653  Usage:        $image->associate_locus($locus_id)
 654  Desc:         associate a locus with this image
 655  Ret:          database_id
 656  Args:         locus_id
 657  Side Effects:
 658  Example:
 659
 660 =cut
 661
 662 sub associate_locus {
 663     my $self = shift;
 664     my $locus_id = shift;
 665     my $sp_person_id= $self->get_sp_person_id();
 666     my $query = "INSERT INTO phenome.locus_image
 667                    (locus_id,
 668                    sp_person_id,
 669                    image_id)
 670                  VALUES (?, ?, ?)";
 671     my $sth = $self->get_dbh()->prepare($query);
 672     $sth->execute(
 673                 $locus_id,
 674                 $sp_person_id,
 675                 $self->get_image_id()
 676                 );
 677
 678     my $locus_image_id= $self->get_currval("phenome.locus_image_locus_image_id_seq");
 679     return $locus_image_id;
 680 }
 681
 682
 683 =head2 get_loci
 684
 685  Usage:   $self->get_loci
 686  Desc:    find the locus objects asociated with this image
 687  Ret:     a list of locus objects
 688  Args:    none
 689  Side Effects: none
 690  Example:
 691
 692 =cut
 693
 694 sub get_loci {
 695     my $self = shift;
 696     my $query = "SELECT locus_id FROM phenome.locus_image WHERE locus_image.obsolete = 'f' and locus_image.image_id=?";
 697     my $sth = $self->get_dbh()->prepare($query);
 698     $sth->execute($self->get_image_id());
 699     my $locus;
 700     my @loci = ();
 701     while (my ($locus_id) = $sth->fetchrow_array()) {
 702        $locus = CXGN::Phenome::Locus->new($self->get_dbh(), $locus_id);
 703         push @loci, $locus;
 704     }
 705     return @loci;
 706 }
 707
 708
 709 =head2 associate_organism
 710
 711  Usage:        $image->associate_organism($organism_id)
 712  Desc:
 713  Ret:
 714  Args:
 715  Side Effects:
 716  Example:
 717
 718 =cut
 719
 720 sub associate_organism {
 721     my $self = shift;
 722     my $organism_id = shift;
 723     my $sp_person_id= $self->get_sp_person_id();
 724     my $query = "INSERT INTO metadata.md_image_organism
 725                    (image_id,
 726                    sp_person_id,
 727                    organism_id)
 728                  VALUES (?, ?, ?) RETURNING md_image_organism_id";
 729     my $sth = $self->get_dbh()->prepare($query);
 730     $sth->execute(
 731         $self->get_image_id,
 732         $sp_person_id,
 733         $organism_id,
 734         );
 735     my ($image_organism_id) = $sth->fetchrow_array;
 736     return $image_organism_id;
 737 }
 738
 739 =head2 get_organisms
 740
 741  Usage:   $self->get_organisms
 742  Desc:    find the organism objects asociated with this image
 743  Ret:     a list of BCS Organism objects
 744  Args:    none
 745  Side Effects: none
 746  Example:
 747
 748 =cut
 749
 750 sub get_organisms {
 751     my $self = shift;
 752     my $schema = $self->config->dbic_schema('Bio::Chado::Schema' , 'sgn_chado');
 753     my $query = "SELECT organism_id FROM metadata.md_image_organism WHERE md_image_organism.obsolete != 't' and md_image_organism.image_id=?";
 754     my $sth = $self->get_dbh()->prepare($query);
 755     $sth->execute($self->get_image_id());
 756     my @organisms = ();
 757     while (my ($o_id) = $sth->fetchrow_array ) {
 758         push @organisms, $schema->resultset("Organism::Organism")->find(
 759             { organism_id => $o_id } );
 760     }
 761     return @organisms;
 762 }
 763
 764
 765 =head2 get_associated_object_links
 766
 767   Synopsis:
 768   Arguments:
 769   Returns:      a string
 770   Side effects:
 771   Description:  gets the associated objects as links in tabular format
 772
 773 =cut
 774
 775 sub get_associated_object_links {
 776     my $self = shift;
 777     my $s = "";
 778     foreach my $assoc ($self->get_associated_objects()) {
 779
 780         if ($assoc->[0] eq "stock") {
 781             $s .= "<a href=\"/stock/$assoc->[1]/view\">Stock name: $assoc->[2].</a>";
 782         }
 783
 784         if ($assoc->[0] eq "experiment") {
 785             $s .= "<a href=\"/insitu/detail/experiment.pl?experiment_id=$assoc->[1]&amp;action=view\">insitu experiment $assoc->[2]</a>";
 786         }
 787
 788         if ($assoc->[0] eq "fished_clone") {
 789             $s .= qq { <a href="/maps/physical/clone_info.pl?id=$assoc->[1]">FISHed clone id:$assoc->[1]</a> };
 790         }
 791         if ($assoc->[0] eq "locus" ) {
 792             $s .= qq { <a href="/phenome/locus_display.pl?locus_id=$assoc->[1]">Locus name:$assoc->[2]</a> };
 793         }
 794         if ($assoc->[0] eq "organism" ) {
 795             $s .= qq { <a href="/organism/$assoc->[1]/view/">Organism name:$assoc->[2]</a> };
 796         }
 797         if ($assoc->[0] eq "cvterm" ) {
 798             $s .= qq { <a href="/cvterm/$assoc->[1]/view/">Cvterm: $assoc->[2]</a> };
 799         }
 800     }
 801     return $s;
 802 }
 803
 804
 805 =head2 associate_cvterm
 806
 807  Usage: $image->associate_cvterm($cvterm_id)
 808  Desc:  link uploaded image with a cvterm
 809  Ret:   database ID md_image_cvterm_id
 810  Args:  $cvterm_id
 811  Side Effects: Insert database row
 812  Example:
 813
 814 =cut
 815
 816 sub associate_cvterm {
 817     my $self = shift;
 818     my $cvterm_id = shift;
 819     my $sp_person_id= $self->get_sp_person_id();
 820     my $query = "INSERT INTO metadata.md_image_cvterm
 821                    (image_id,
 822                    sp_person_id,
 823                    cvterm_id)
 824                  VALUES (?, ?, ?) RETURNING md_image_cvterm_id";
 825     my $sth = $self->get_dbh()->prepare($query);
 826     $sth->execute(
 827         $self->get_image_id,
 828         $sp_person_id,
 829         $cvterm_id,
 830         );
 831     my ($image_cvterm_id) = $sth->fetchrow_array;
 832     return $image_cvterm_id;
 833 }
 834
 835 =head2 get_cvterms
 836
 837  Usage:   $self->get_cvterms
 838  Desc:    find the cvterm objects asociated with this image
 839  Ret:     a list of BCS Cvterm objects
 840  Args:    none
 841  Side Effects: none
 842  Example:
 843
 844 =cut
 845
 846 sub get_cvterms {
 847     my $self = shift;
 848     my $schema = $self->config->dbic_schema('Bio::Chado::Schema' , 'sgn_chado');
 849     my $query = "SELECT cvterm_id FROM metadata.md_image_cvterm WHERE md_image_cvterm.obsolete != 't' and md_image_cvterm.image_id=?";
 850     my $sth = $self->get_dbh()->prepare($query);
 851     $sth->execute( $self->get_image_id() );
 852     my @cvterms = ();
 853     while (my ($cvterm_id) = $sth->fetchrow_array ) {
 854         push @cvterms, $schema->resultset("Cv::Cvterm")->find(
 855             { cvterm_id => $cvterm_id } );
 856     }
 857     return @cvterms;
 858 }
 859
 860
 861
 862 1;