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