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
 314 sub upload_zipfile_images {
 315     my $self   = shift;
 316     my $file_member = shift;
 317
 318     my $filename = $file_member->fileName();
 319
 320     my $zipfile_image_temp_path = $self->config()->get_conf("basepath") . $self->config()->get_conf("tempfiles_subdir") . "/temp_images/photos";
 321     make_path($zipfile_image_temp_path);
 322     my $temp_file =
 323         $self->config()->get_conf("basepath")
 324       . $self->config()->get_conf("tempfiles_subdir")
 325       . "/temp_images/"
 326       . $filename;
 327     system("chmod 775 $zipfile_image_temp_path");
 328     $file_member->extractToFileNamed($temp_file);
 329     print STDERR "Temp Image: ".$temp_file."\n";
 330     return $temp_file;
 331 }
 332
 333
 334 sub upload_image {
 335     my $self = shift;
 336     my $temp_file = shift;
 337     my $upload_fh = shift;
 338
 339     ### 11/30/07 - change this so it removes existing file
 340     #     -deanx
 341     # # only copy file if it doesn't already exist
 342     # #
 343     if ( -e $temp_file ) {
 344         unlink $temp_file;
 345     }
 346
 347     open UPLOADFILE, '>', $temp_file or die "Could not write to $temp_file: $!\n";
 348
 349     binmode UPLOADFILE;
 350     while (<$upload_fh>) {
 351
 352         #warn "Read another chunk...\n";
 353         print UPLOADFILE;
 354     }
 355     close UPLOADFILE;
 356     warn "Done uploading.\n";
 357
 358     return $temp_file;
 359 }
 360
 361 =head2 associate_stock
 362
 363  Usage: $image->associate_stock($stock_id);
 364  Desc:  associate a Bio::Chado::Schema::Result::Stock::Stock object with this image
 365  Ret:   a database id (stock_image_id)
 366  Args:  stock_id
 367  Side Effects:
 368  Example:
 369
 370 =cut
 371
 372 sub associate_stock  {
 373     my $self = shift;
 374     my $stock_id = shift;
 375     if ($stock_id) {
 376         my $username = $self->config->can('user_exists') ? $self->config->user->get_object->get_username : $self->config->username;
 377         if ($username) {
 378             my $metadata_schema = $self->config->dbic_schema('CXGN::Metadata::Schema');
 379             my $metadata = CXGN::Metadata::Metadbdata->new($metadata_schema, $username);
 380             my $metadata_id = $metadata->store()->get_metadata_id();
 381
 382             my $q = "INSERT INTO phenome.stock_image (stock_id, image_id, metadata_id) VALUES (?,?,?) RETURNING stock_image_id";
 383             my $sth = $self->get_dbh->prepare($q);
 384             $sth->execute($stock_id, $self->get_image_id, $metadata_id);
 385             my ($stock_image_id) = $sth->fetchrow_array;
 386             return $stock_image_id;
 387         }
 388     }
 389     return undef;
 390 }
 391
 392 =head2 get_stocks
 393
 394  Usage: $image->get_stocks
 395  Desc:  find all stock objects linked with this image
 396  Ret:   a list of Bio::Chado::Schema::Result::Stock::Stock
 397  Args:  none
 398
 399 =cut
 400
 401 sub get_stocks {
 402     my $self = shift;
 403     my $schema = $self->config->dbic_schema('Bio::Chado::Schema' , 'sgn_chado');
 404     my @stocks;
 405     my $q = "SELECT stock_id FROM phenome.stock_image WHERE image_id = ? ";
 406     my $sth = $self->get_dbh->prepare($q);
 407     $sth->execute($self->get_image_id);
 408     while (my ($stock_id) = $sth->fetchrow_array) {
 409         my $stock = $schema->resultset("Stock::Stock")->find( { stock_id => $stock_id } ) ;
 410         push @stocks, $stock;
 411     }
 412     return @stocks;
 413 }
 414 =head2 associate_individual
 415
 416  Usage:        DEPRECATED, Individual table is not used any more . Please use stock instead
 417                $image->associate_individual($individual_id)
 418  Desc:         associate a CXGN::Phenome::Individual with this image
 419  Ret:          a database id (individual_image)
 420  Args:         individual_id
 421  Side Effects:
 422  Example:
 423
 424 =cut
 425
 426 sub associate_individual {
 427     my $self = shift;
 428     my $individual_id = shift;
 429     warn "DEPRECATED. Individual table is not used any more . Please use stock instead";
 430     my $query = "INSERT INTO phenome.individual_image
 431                    (individual_id, image_id) VALUES (?, ?)";
 432     my $sth = $self->get_dbh()->prepare($query);
 433     $sth->execute($individual_id, $self->get_image_id());
 434
 435     my $id= $self->get_currval("phenome.individual_image_individual_image_id_seq");
 436     return $id;
 437 }
 438
 439
 440 =head2 get_individuals
 441
 442  Usage:  DEPRECATED. Use the stock table .
 443         $self->get_individuals()
 444  Desc:  find associated individuals with the image
 445  Ret:   list of 'Individual' objects
 446  Args:  none
 447  Side Effects: none
 448  Example:
 449
 450 =cut
 451
 452 sub get_individuals {
 453     my $self = shift;
 454     warn "DEPRECATED. Individual table is not used any more . Please use stock instead";
 455     my $query = "SELECT individual_id FROM phenome.individual_image WHERE individual_image.image_id=?";
 456     my $sth = $self->get_dbh()->prepare($query);
 457     $sth->execute($self->get_image_id());
 458     my @individuals;
 459     while (my ($individual_id) = $sth->fetchrow_array()) {
 460         my $i = CXGN::Phenome::Individual->new($self->get_dbh(), $individual_id);
 461         if ( $i->get_individual_id() ) { push @individuals, $i; } #obsolete individuals should be ignored!
 462     }
 463     return @individuals;
 464 }
 465
 466
 467 =head2 associate_experiment
 468
 469  Usage: $image->associate_experiment($experiment_id);
 470  Desc:  associate and image with and insitu experiment
 471  Ret:   a database id
 472  Args:  experiment_id
 473  Side Effects:
 474  Example:
 475
 476 =cut
 477
 478 sub associate_experiment {
 479     my $self = shift;
 480     my $experiment_id = shift;
 481     my $query = "INSERT INTO insitu.experiment_image
 482                  (image_id, experiment_id)
 483                  VALUES (?, ?)";
 484     my $sth = $self->get_dbh()->prepare($query);
 485     $sth->execute($self->get_image_id(), $experiment_id);
 486     my $id= $self->get_currval("insitu.experiment_image_experiment_image_id_seq");
 487     return $id;
 488
 489 }
 490
 491 =head2 get_experiments
 492
 493  Usage:
 494  Desc:
 495  Ret:          a list of CXGN::Insitu::Experiment objects associated
 496                with this image
 497  Args:
 498  Side Effects:
 499  Example:
 500
 501 =cut
 502
 503 sub get_experiments {
 504     my $self = shift;
 505     my $query = "SELECT experiment_id FROM insitu.experiment_image
 506                  WHERE image_id=?";
 507     my $sth = $self->get_dbh()->prepare($query);
 508     $sth->execute($self->get_image_id());
 509     my @experiments = ();
 510     while (my ($experiment_id) = $sth->fetchrow_array()) {
 511         push @experiments, CXGN::Insitu::Experiment->new($self->get_dbh(), $experiment_id);
 512     }
 513     return @experiments;
 514 }
 515
 516 =head2 associate_fish_result
 517
 518  Usage:        $image->associate_fish_result($fish_result_id)
 519  Desc:         associate a CXGN::Phenome::Individual with this image
 520  Ret:          database_id
 521  Args:         fish_result_id
 522  Side Effects:
 523  Example:
 524
 525 =cut
 526
 527 sub associate_fish_result {
 528     my $self = shift;
 529     my $fish_result_id = shift;
 530     my $query = "INSERT INTO sgn.fish_result_image
 531                    (fish_result_id, image_id) VALUES (?, ?)";
 532     my $sth = $self->get_dbh()->prepare($query);
 533     $sth->execute($fish_result_id, $self->get_image_id());
 534     my $id= $self->get_currval("sgn.fish_result_image_fish_result_image_id_seq");
 535     return $id;
 536 }
 537
 538 =head2 get_fish_result_clone_ids
 539
 540  Usage:        my @clone_ids = $image->get_fish_result_clones();
 541  Desc:         because fish results are associated with genomic
 542                clones, this function returns the genomic clone ids
 543                that are associated through the fish results to
 544                this image. The clone ids can be used to construct
 545                links to the BAC detail page.
 546  Ret:          A list of clone_ids
 547  Args:
 548  Side Effects:
 549  Example:
 550
 551 =cut
 552
 553 sub get_fish_result_clone_ids {
 554     my $self = shift;
 555     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=?";
 556     my $sth = $self->get_dbh()->prepare($query);
 557     $sth->execute($self->get_image_id());
 558     my @fish_result_clone_ids = ();
 559     while (my ($fish_result_clone_id) = $sth->fetchrow_array()) {
 560         push @fish_result_clone_ids, $fish_result_clone_id;
 561     }
 562     return @fish_result_clone_ids;
 563 }
 564
 565 =head2 get_associated_objects
 566
 567   Synopsis:
 568   Arguments:
 569   Returns:
 570   Side effects:
 571   Description:
 572
 573 =cut
 574
 575 sub get_associated_objects {
 576     my $self = shift;
 577     my @associations = ();
 578     my @stocks=$self->get_stocks();
 579     foreach my $stock (@stocks) {
 580         my $stock_id = $stock->stock_id();
 581         my $stock_name = $stock->name();
 582         push @associations, [ "stock", $stock_id, $stock_name ];
 583     }
 584
 585     foreach my $exp ($self->get_experiments()) {
 586         my $experiment_id = $exp->get_experiment_id();
 587         my $experiment_name = $exp->get_name();
 588
 589         push @associations, [ "experiment", $experiment_id, $experiment_name ];
 590
 591         #print "<a href=\"/insitu/detail/experiment.pl?experiment_id=$experiment_id&amp;action=view\">".($exp->get_name())."</a>";
 592     }
 593
 594     foreach my $fish_result_clone_id ($self->get_fish_result_clone_ids()) {
 595         push @associations, [ "fished_clone", $fish_result_clone_id ];
 596     }
 597     foreach my $locus ($self->get_loci() ) {
 598         push @associations, ["locus", $locus->get_locus_id(), $locus->get_locus_name];
 599     }
 600     foreach my $o ($self->get_organisms ) {
 601         push @associations, ["organism", $o->organism_id, $o->species];
 602     }
 603
 604     foreach my $cvterm ( $self->get_cvterms ) {
 605         push @associations, ["cvterm" , $cvterm->cvterm_id, $cvterm->name];
 606     }
 607     return @associations;
 608 }
 609
 610 =head2 associate_locus
 611
 612  Usage:        $image->associate_locus($locus_id)
 613  Desc:         associate a locus with this image
 614  Ret:          database_id
 615  Args:         locus_id
 616  Side Effects:
 617  Example:
 618
 619 =cut
 620
 621 sub associate_locus {
 622     my $self = shift;
 623     my $locus_id = shift;
 624     my $sp_person_id= $self->get_sp_person_id();
 625     my $query = "INSERT INTO phenome.locus_image
 626                    (locus_id,
 627                    sp_person_id,
 628                    image_id)
 629                  VALUES (?, ?, ?)";
 630     my $sth = $self->get_dbh()->prepare($query);
 631     $sth->execute(
 632                 $locus_id,
 633                 $sp_person_id,
 634                 $self->get_image_id()
 635                 );
 636
 637     my $locus_image_id= $self->get_currval("phenome.locus_image_locus_image_id_seq");
 638     return $locus_image_id;
 639 }
 640
 641
 642 =head2 get_loci
 643
 644  Usage:   $self->get_loci
 645  Desc:    find the locus objects asociated with this image
 646  Ret:     a list of locus objects
 647  Args:    none
 648  Side Effects: none
 649  Example:
 650
 651 =cut
 652
 653 sub get_loci {
 654     my $self = shift;
 655     my $query = "SELECT locus_id FROM phenome.locus_image WHERE locus_image.obsolete = 'f' and locus_image.image_id=?";
 656     my $sth = $self->get_dbh()->prepare($query);
 657     $sth->execute($self->get_image_id());
 658     my $locus;
 659     my @loci = ();
 660     while (my ($locus_id) = $sth->fetchrow_array()) {
 661        $locus = CXGN::Phenome::Locus->new($self->get_dbh(), $locus_id);
 662         push @loci, $locus;
 663     }
 664     return @loci;
 665 }
 666
 667
 668 =head2 associate_organism
 669
 670  Usage:        $image->associate_organism($organism_id)
 671  Desc:
 672  Ret:
 673  Args:
 674  Side Effects:
 675  Example:
 676
 677 =cut
 678
 679 sub associate_organism {
 680     my $self = shift;
 681     my $organism_id = shift;
 682     my $sp_person_id= $self->get_sp_person_id();
 683     my $query = "INSERT INTO metadata.md_image_organism
 684                    (image_id,
 685                    sp_person_id,
 686                    organism_id)
 687                  VALUES (?, ?, ?) RETURNING md_image_organism_id";
 688     my $sth = $self->get_dbh()->prepare($query);
 689     $sth->execute(
 690         $self->get_image_id,
 691         $sp_person_id,
 692         $organism_id,
 693         );
 694     my ($image_organism_id) = $sth->fetchrow_array;
 695     return $image_organism_id;
 696 }
 697
 698 =head2 get_organisms
 699
 700  Usage:   $self->get_organisms
 701  Desc:    find the organism objects asociated with this image
 702  Ret:     a list of BCS Organism objects
 703  Args:    none
 704  Side Effects: none
 705  Example:
 706
 707 =cut
 708
 709 sub get_organisms {
 710     my $self = shift;
 711     my $schema = $self->config->dbic_schema('Bio::Chado::Schema' , 'sgn_chado');
 712     my $query = "SELECT organism_id FROM metadata.md_image_organism WHERE md_image_organism.obsolete != 't' and md_image_organism.image_id=?";
 713     my $sth = $self->get_dbh()->prepare($query);
 714     $sth->execute($self->get_image_id());
 715     my @organisms = ();
 716     while (my ($o_id) = $sth->fetchrow_array ) {
 717         push @organisms, $schema->resultset("Organism::Organism")->find(
 718             { organism_id => $o_id } );
 719     }
 720     return @organisms;
 721 }
 722
 723
 724 =head2 get_associated_object_links
 725
 726   Synopsis:
 727   Arguments:
 728   Returns:      a string
 729   Side effects:
 730   Description:  gets the associated objects as links in tabular format
 731
 732 =cut
 733
 734 sub get_associated_object_links {
 735     my $self = shift;
 736     my $s = "";
 737     foreach my $assoc ($self->get_associated_objects()) {
 738
 739         if ($assoc->[0] eq "stock") {
 740             $s .= "<a href=\"/stock/$assoc->[1]/view\">Stock name: $assoc->[2].</a>";
 741         }
 742
 743         if ($assoc->[0] eq "experiment") {
 744             $s .= "<a href=\"/insitu/detail/experiment.pl?experiment_id=$assoc->[1]&amp;action=view\">insitu experiment $assoc->[2]</a>";
 745         }
 746
 747         if ($assoc->[0] eq "fished_clone") {
 748             $s .= qq { <a href="/maps/physical/clone_info.pl?id=$assoc->[1]">FISHed clone id:$assoc->[1]</a> };
 749         }
 750         if ($assoc->[0] eq "locus" ) {
 751             $s .= qq { <a href="/phenome/locus_display.pl?locus_id=$assoc->[1]">Locus name:$assoc->[2]</a> };
 752         }
 753         if ($assoc->[0] eq "organism" ) {
 754             $s .= qq { <a href="/organism/$assoc->[1]/view/">Organism name:$assoc->[2]</a> };
 755         }
 756         if ($assoc->[0] eq "cvterm" ) {
 757             $s .= qq { <a href="/cvterm/$assoc->[1]/view/">Cvterm: $assoc->[2]</a> };
 758         }
 759     }
 760     return $s;
 761 }
 762
 763
 764 =head2 associate_cvterm
 765
 766  Usage: $image->associate_cvterm($cvterm_id)
 767  Desc:  link uploaded image with a cvterm
 768  Ret:   database ID md_image_cvterm_id
 769  Args:  $cvterm_id
 770  Side Effects: Insert database row
 771  Example:
 772
 773 =cut
 774
 775 sub associate_cvterm {
 776     my $self = shift;
 777     my $cvterm_id = shift;
 778     my $sp_person_id= $self->get_sp_person_id();
 779     my $query = "INSERT INTO metadata.md_image_cvterm
 780                    (image_id,
 781                    sp_person_id,
 782                    cvterm_id)
 783                  VALUES (?, ?, ?) RETURNING md_image_cvterm_id";
 784     my $sth = $self->get_dbh()->prepare($query);
 785     $sth->execute(
 786         $self->get_image_id,
 787         $sp_person_id,
 788         $cvterm_id,
 789         );
 790     my ($image_cvterm_id) = $sth->fetchrow_array;
 791     return $image_cvterm_id;
 792 }
 793
 794 =head2 get_cvterms
 795
 796  Usage:   $self->get_cvterms
 797  Desc:    find the cvterm objects asociated with this image
 798  Ret:     a list of BCS Cvterm objects
 799  Args:    none
 800  Side Effects: none
 801  Example:
 802
 803 =cut
 804
 805 sub get_cvterms {
 806     my $self = shift;
 807     my $schema = $self->config->dbic_schema('Bio::Chado::Schema' , 'sgn_chado');
 808     my $query = "SELECT cvterm_id FROM metadata.md_image_cvterm WHERE md_image_cvterm.obsolete != 't' and md_image_cvterm.image_id=?";
 809     my $sth = $self->get_dbh()->prepare($query);
 810     $sth->execute( $self->get_image_id() );
 811     my @cvterms = ();
 812     while (my ($cvterm_id) = $sth->fetchrow_array ) {
 813         push @cvterms, $schema->resultset("Cv::Cvterm")->find(
 814             { cvterm_id => $cvterm_id } );
 815     }
 816     return @cvterms;
 817 }
 818
 819
 820
 821 1;