lib/SGN/Image.pm

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