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 "test") {
 152         # need to return something to make this function happy
 153         return 1;
 154
 155     }
 156     else {
 157         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";
 158     }
 159
 160 }
 161
 162 =head2 config, context, _app
 163
 164 Get the Catalyst context object we are running with.
 165
 166 =cut
 167
 168 sub config {
 169     my ($self,$obj) = @_;
 170
 171     $self->{configuration_object} = $obj if $obj;
 172
 173     return $self->{configuration_object};
 174 }
 175 *context = \&config;
 176 *_app    = \&config;
 177
 178 =head2 get_img_src_tag
 179
 180  Usage:
 181  Desc:
 182  Ret:
 183  Args:         "large" | "medium" | "small" | "thumbnail" | "original" | "tiny"
 184                default is medium
 185  Side Effects:
 186  Example:
 187
 188 =cut
 189
 190 sub get_img_src_tag {
 191     my $self = shift;
 192     my $size = shift;
 193     my $url  = $self->get_image_url($size);
 194     my $name = $self->get_name();
 195     if ( $size && $size eq "original" ) {
 196
 197         my $static = $self->config()->get_conf("static_datasets_url");
 198
 199         return
 200             "<a href=\""
 201           . ($url)
 202           . "\"><img src=\"$static/images/download_icon.png\" border=\"0\" alt=\""
 203           . $name
 204           . "\" /></a>";
 205     }
 206     elsif ( $size && $size eq "tiny" ) {
 207         return
 208             "<img src=\""
 209           . ($url)
 210           . "\" width=\"20\" height=\"15\" border=\"0\" alt=\""
 211           . $name
 212           . "\" />\n";
 213     }
 214     else {
 215         return
 216             "<img src=\""
 217           . ($url)
 218           . "\" border=\"0\" alt=\""
 219           . $name
 220           . "\" />\n";
 221     }
 222 }
 223
 224 =head2 get_temp_filename
 225
 226  Usage:
 227  Desc:
 228  Ret:
 229  Args:
 230  Side Effects:
 231  Example:
 232
 233 =cut
 234
 235 sub get_temp_filename {
 236     my $self = shift;
 237     return $self->{temp_filename};
 238
 239 }
 240
 241 =head2 set_temp_filename
 242
 243  Usage:
 244  Desc:
 245  Ret:
 246  Args:
 247  Side Effects:
 248  Example:
 249
 250 =cut
 251
 252 sub set_temp_filename {
 253     my $self = shift;
 254     $self->{temp_filename} = shift;
 255 }
 256
 257 =head2 apache_upload_image
 258
 259  DEPRECATED.
 260
 261  Usage:        my $temp_file_name = $image->apache_upload_image($apache_upload_object);
 262  Desc:
 263  Ret:          the name of the intermediate tempfile that can be
 264                used to access down the road.
 265  Args:         an apache upload object
 266  Side Effects: generates an intermediate temp file from an apache request
 267                that can be handled more easily. Adds the remote IP addr to the
 268                filename so that different uploaders don\'t clobber but
 269                allows only one upload per remote addr at a time.
 270  Errors:       change 11/30/07 - removes temp file if already exists
 271                # returns -1 if the intermediate temp file already exists.
 272                # this probably means that the submission button was hit twice
 273                # and that an upload is already in progress.
 274  Example:
 275
 276 =cut
 277
 278 sub apache_upload_image {
 279     my $self   = shift;
 280     my $upload = shift;
 281     ###  deanx jan 03 2007
 282 # Adjust File name if using Windows IE - it sends whole paht; drive letter, path, and filename
 283     my $upload_filename;
 284     if ( $ENV{HTTP_USER_AGENT} =~ /msie/i ) {
 285         my ( $directory, $filename ) = $upload->filename =~ m/(.*\\)(.*)$/;
 286         $upload_filename = $filename;
 287     }
 288     else {
 289         $upload_filename = $upload->filename;
 290     }
 291
 292     my $temp_file =
 293         $self->config()->get_conf("basepath") . "/"
 294       . $self->config()->get_conf("tempfiles_subdir")
 295       . "/temp_images/"
 296       . $ENV{REMOTE_ADDR} . "-"
 297       . $upload_filename;
 298
 299     my $upload_fh = $upload->fh;
 300
 301     ### 11/30/07 - change this so it removes existing file
 302     #     -deanx
 303     # # only copy file if it doesn't already exist
 304     # #
 305     if ( -e $temp_file ) {
 306         unlink $temp_file;
 307     }
 308
 309     open UPLOADFILE, '>', $temp_file or die "Could not write to $temp_file: $!\n";
 310
 311     binmode UPLOADFILE;
 312     while (<$upload_fh>) {
 313
 314         #warn "Read another chunk...\n";
 315         print UPLOADFILE;
 316     }
 317     close UPLOADFILE;
 318     warn "Done uploading.\n";
 319
 320     return $temp_file;
 321
 322 }
 323
 324 =head2 associate_stock
 325
 326  Usage: $image->associate_stock($stock_id);
 327  Desc:  associate a Bio::Chado::Schema::Result::Stock::Stock object with this image
 328  Ret:   a database id (stock_image_id)
 329  Args:  stock_id
 330  Side Effects:
 331  Example:
 332
 333 =cut
 334
 335 sub associate_stock  {
 336     my $self = shift;
 337     my $stock_id = shift;
 338     if ($stock_id) {
 339         my $user = $self->config->user_exists;
 340         if ($user) {
 341             my $metadata_schema = $self->config->dbic_schema('CXGN::Metadata::Schema');
 342             my $metadata = CXGN::Metadata::Metadbdata->new($metadata_schema, $self->config->user->get_object->get_username);
 343             my $metadata_id = $metadata->store()->get_metadata_id();
 344
 345             my $q = "INSERT INTO phenome.stock_image (stock_id, image_id, metadata_id) VALUES (?,?,?) RETURNING stock_image_id";
 346             my $sth = $self->get_dbh->prepare($q);
 347             $sth->execute($stock_id, $self->get_image_id, $metadata_id);
 348             my ($stock_image_id) = $sth->fetchrow_array;
 349             return $stock_image_id;
 350         }
 351     }
 352     return undef;
 353 }
 354
 355 =head2 get_stocks
 356
 357  Usage: $image->get_stocks
 358  Desc:  find all stock objects linked with this image
 359  Ret:   a list of Bio::Chado::Schema::Result::Stock::Stock
 360  Args:  none
 361
 362 =cut
 363
 364 sub get_stocks {
 365     my $self = shift;
 366     my $schema = $self->config->dbic_schema('Bio::Chado::Schema' , 'sgn_chado');
 367     my @stocks;
 368     my $q = "SELECT stock_id FROM phenome.stock_image WHERE image_id = ? ";
 369     my $sth = $self->get_dbh->prepare($q);
 370     $sth->execute($self->get_image_id);
 371     while (my ($stock_id) = $sth->fetchrow_array) {
 372         my $stock = $schema->resultset("Stock::Stock")->find( { stock_id => $stock_id } ) ;
 373         push @stocks, $stock;
 374     }
 375     return @stocks;
 376 }
 377 =head2 associate_individual
 378
 379  Usage:        DEPRECATED, Individual table is not used any more . Please use stock instead
 380                $image->associate_individual($individual_id)
 381  Desc:         associate a CXGN::Phenome::Individual with this image
 382  Ret:          a database id (individual_image)
 383  Args:         individual_id
 384  Side Effects:
 385  Example:
 386
 387 =cut
 388
 389 sub associate_individual {
 390     my $self = shift;
 391     my $individual_id = shift;
 392     warn "DEPRECATED. Individual table is not used any more . Please use stock instead";
 393     my $query = "INSERT INTO phenome.individual_image
 394                    (individual_id, image_id) VALUES (?, ?)";
 395     my $sth = $self->get_dbh()->prepare($query);
 396     $sth->execute($individual_id, $self->get_image_id());
 397
 398     my $id= $self->get_currval("phenome.individual_image_individual_image_id_seq");
 399     return $id;
 400 }
 401
 402
 403 =head2 get_individuals
 404
 405  Usage:  DEPRECATED. Use the stock table .
 406         $self->get_individuals()
 407  Desc:  find associated individuals with the image
 408  Ret:   list of 'Individual' objects
 409  Args:  none
 410  Side Effects: none
 411  Example:
 412
 413 =cut
 414
 415 sub get_individuals {
 416     my $self = shift;
 417     warn "DEPRECATED. Individual table is not used any more . Please use stock instead";
 418     my $query = "SELECT individual_id FROM phenome.individual_image WHERE individual_image.image_id=?";
 419     my $sth = $self->get_dbh()->prepare($query);
 420     $sth->execute($self->get_image_id());
 421     my @individuals;
 422     while (my ($individual_id) = $sth->fetchrow_array()) {
 423         my $i = CXGN::Phenome::Individual->new($self->get_dbh(), $individual_id);
 424         if ( $i->get_individual_id() ) { push @individuals, $i; } #obsolete individuals should be ignored!
 425     }
 426     return @individuals;
 427 }
 428
 429
 430 =head2 associate_experiment
 431
 432  Usage: $image->associate_experiment($experiment_id);
 433  Desc:  associate and image with and insitu experiment
 434  Ret:   a database id
 435  Args:  experiment_id
 436  Side Effects:
 437  Example:
 438
 439 =cut
 440
 441 sub associate_experiment {
 442     my $self = shift;
 443     my $experiment_id = shift;
 444     my $query = "INSERT INTO insitu.experiment_image
 445                  (image_id, experiment_id)
 446                  VALUES (?, ?)";
 447     my $sth = $self->get_dbh()->prepare($query);
 448     $sth->execute($self->get_image_id(), $experiment_id);
 449     my $id= $self->get_currval("insitu.experiment_image_experiment_image_id_seq");
 450     return $id;
 451
 452 }
 453
 454 =head2 get_experiments
 455
 456  Usage:
 457  Desc:
 458  Ret:          a list of CXGN::Insitu::Experiment objects associated
 459                with this image
 460  Args:
 461  Side Effects:
 462  Example:
 463
 464 =cut
 465
 466 sub get_experiments {
 467     my $self = shift;
 468     my $query = "SELECT experiment_id FROM insitu.experiment_image
 469                  WHERE image_id=?";
 470     my $sth = $self->get_dbh()->prepare($query);
 471     $sth->execute($self->get_image_id());
 472     my @experiments = ();
 473     while (my ($experiment_id) = $sth->fetchrow_array()) {
 474         push @experiments, CXGN::Insitu::Experiment->new($self->get_dbh(), $experiment_id);
 475     }
 476     return @experiments;
 477 }
 478
 479 =head2 associate_fish_result
 480
 481  Usage:        $image->associate_fish_result($fish_result_id)
 482  Desc:         associate a CXGN::Phenome::Individual with this image
 483  Ret:          database_id
 484  Args:         fish_result_id
 485  Side Effects:
 486  Example:
 487
 488 =cut
 489
 490 sub associate_fish_result {
 491     my $self = shift;
 492     my $fish_result_id = shift;
 493     my $query = "INSERT INTO sgn.fish_result_image
 494                    (fish_result_id, image_id) VALUES (?, ?)";
 495     my $sth = $self->get_dbh()->prepare($query);
 496     $sth->execute($fish_result_id, $self->get_image_id());
 497     my $id= $self->get_currval("sgn.fish_result_image_fish_result_image_id_seq");
 498     return $id;
 499 }
 500
 501 =head2 get_fish_result_clone_ids
 502
 503  Usage:        my @clone_ids = $image->get_fish_result_clones();
 504  Desc:         because fish results are associated with genomic
 505                clones, this function returns the genomic clone ids
 506                that are associated through the fish results to
 507                this image. The clone ids can be used to construct
 508                links to the BAC detail page.
 509  Ret:          A list of clone_ids
 510  Args:
 511  Side Effects:
 512  Example:
 513
 514 =cut
 515
 516 sub get_fish_result_clone_ids {
 517     my $self = shift;
 518     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=?";
 519     my $sth = $self->get_dbh()->prepare($query);
 520     $sth->execute($self->get_image_id());
 521     my @fish_result_clone_ids = ();
 522     while (my ($fish_result_clone_id) = $sth->fetchrow_array()) {
 523         push @fish_result_clone_ids, $fish_result_clone_id;
 524     }
 525     return @fish_result_clone_ids;
 526 }
 527
 528 =head2 get_associated_objects
 529
 530   Synopsis:
 531   Arguments:
 532   Returns:
 533   Side effects:
 534   Description:
 535
 536 =cut
 537
 538 sub get_associated_objects {
 539     my $self = shift;
 540     my @associations = ();
 541     my @stocks=$self->get_stocks();
 542     foreach my $stock (@stocks) {
 543         my $stock_id = $stock->stock_id();
 544         my $stock_name = $stock->name();
 545         push @associations, [ "stock", $stock_id, $stock_name ];
 546     }
 547
 548     foreach my $exp ($self->get_experiments()) {
 549         my $experiment_id = $exp->get_experiment_id();
 550         my $experiment_name = $exp->get_name();
 551
 552         push @associations, [ "experiment", $experiment_id, $experiment_name ];
 553
 554         #print "<a href=\"/insitu/detail/experiment.pl?experiment_id=$experiment_id&amp;action=view\">".($exp->get_name())."</a>";
 555     }
 556
 557     foreach my $fish_result_clone_id ($self->get_fish_result_clone_ids()) {
 558         push @associations, [ "fished_clone", $fish_result_clone_id ];
 559     }
 560     foreach my $locus ($self->get_loci() ) {
 561         push @associations, ["locus", $locus->get_locus_id(), $locus->get_locus_name];
 562     }
 563     foreach my $o ($self->get_organisms ) {
 564         push @associations, ["organism", $o->organism_id, $o->species];
 565     }
 566     return @associations;
 567 }
 568
 569 =head2 associate_locus
 570
 571  Usage:        $image->associate_locus($locus_id)
 572  Desc:         associate a locus with this image
 573  Ret:          database_id
 574  Args:         locus_id
 575  Side Effects:
 576  Example:
 577
 578 =cut
 579
 580 sub associate_locus {
 581     my $self = shift;
 582     my $locus_id = shift;
 583     my $sp_person_id= $self->get_sp_person_id();
 584     my $query = "INSERT INTO phenome.locus_image
 585                    (locus_id,
 586                    sp_person_id,
 587                    image_id)
 588                  VALUES (?, ?, ?)";
 589     my $sth = $self->get_dbh()->prepare($query);
 590     $sth->execute(
 591                 $locus_id,
 592                 $sp_person_id,
 593                 $self->get_image_id()
 594                 );
 595
 596     my $locus_image_id= $self->get_currval("phenome.locus_image_locus_image_id_seq");
 597     return $locus_image_id;
 598 }
 599
 600
 601 =head2 get_loci
 602
 603  Usage:   $self->get_loci
 604  Desc:    find the locus objects asociated with this image
 605  Ret:     a list of locus objects
 606  Args:    none
 607  Side Effects: none
 608  Example:
 609
 610 =cut
 611
 612 sub get_loci {
 613     my $self = shift;
 614     my $query = "SELECT locus_id FROM phenome.locus_image WHERE locus_image.obsolete = 'f' and locus_image.image_id=?";
 615     my $sth = $self->get_dbh()->prepare($query);
 616     $sth->execute($self->get_image_id());
 617     my $locus;
 618     my @loci = ();
 619     while (my ($locus_id) = $sth->fetchrow_array()) {
 620        $locus = CXGN::Phenome::Locus->new($self->get_dbh(), $locus_id);
 621         push @loci, $locus;
 622     }
 623     return @loci;
 624 }
 625
 626
 627 =head2 associate_organism
 628
 629  Usage:        $image->associate_organism($organism_id)
 630  Desc:
 631  Ret:
 632  Args:
 633  Side Effects:
 634  Example:
 635
 636 =cut
 637
 638 sub associate_organism {
 639     my $self = shift;
 640     my $organism_id = shift;
 641     my $sp_person_id= $self->get_sp_person_id();
 642     my $query = "INSERT INTO metadata.md_image_organism
 643                    (image_id,
 644                    sp_person_id,
 645                    organism_id)
 646                  VALUES (?, ?, ?) RETURNING md_image_organism_id";
 647     my $sth = $self->get_dbh()->prepare($query);
 648     $sth->execute(
 649         $self->get_image_id,
 650         $sp_person_id,
 651         $organism_id,
 652         );
 653     my ($image_organism_id) = $sth->fetchrow_array;
 654     return $image_organism_id;
 655 }
 656
 657 =head2 get_organisms
 658
 659  Usage:   $self->get_organisms
 660  Desc:    find the organism objects asociated with this image
 661  Ret:     a list of BCS Organism objects
 662  Args:    none
 663  Side Effects: none
 664  Example:
 665
 666 =cut
 667
 668 sub get_organisms {
 669     my $self = shift;
 670     my $schema = $self->config->dbic_schema('Bio::Chado::Schema' , 'sgn_chado');
 671     my $query = "SELECT organism_id FROM metadata.md_image_organism WHERE md_image_organism.obsolete != 't' and md_image_organism.image_id=?";
 672     my $sth = $self->get_dbh()->prepare($query);
 673     $sth->execute($self->get_image_id());
 674     my @organisms = ();
 675     while (my ($o_id) = $sth->fetchrow_array ) {
 676         push @organisms, $schema->resultset("Organism::Organism")->find(
 677             { organism_id => $o_id } );
 678     }
 679     return @organisms;
 680 }
 681
 682
 683 =head2 get_associated_object_links
 684
 685   Synopsis:
 686   Arguments:
 687   Returns:      a string
 688   Side effects:
 689   Description:  gets the associated objects as links in tabular format
 690
 691 =cut
 692
 693 sub get_associated_object_links {
 694     my $self = shift;
 695     my $s = "";
 696     foreach my $assoc ($self->get_associated_objects()) {
 697
 698         if ($assoc->[0] eq "stock") {
 699             $s .= "<a href=\"/stock/$assoc->[1]/view\">Stock name: $assoc->[2].</a>";
 700         }
 701
 702         if ($assoc->[0] eq "experiment") {
 703             $s .= "<a href=\"/insitu/detail/experiment.pl?experiment_id=$assoc->[1]&amp;action=view\">insitu experiment $assoc->[2]</a>";
 704         }
 705
 706         if ($assoc->[0] eq "fished_clone") {
 707             $s .= qq { <a href="/maps/physical/clone_info.pl?id=$assoc->[1]">FISHed clone id:$assoc->[1]</a> };
 708         }
 709         if ($assoc->[0] eq "locus" ) {
 710             $s .= qq { <a href="/phenome/locus_display.pl?locus_id=$assoc->[1]">Locus name:$assoc->[2]</a> };
 711         }
 712         if ($assoc->[0] eq "organism" ) {
 713             $s .= qq { <a href="/organism/$assoc->[1]/view/">Organism name:$assoc->[2]</a> };
 714         }
 715     }
 716     return $s;
 717 }
 718
 719 1;