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, "individual", 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 "individual" ) {
 131         #print STDERR "Associating individual $type_id...\n";
 132         $self->associate_individual($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
 328 =head2 associate_individual
 329
 330  Usage:        $image->associate_individual($individual_id)
 331  Desc:         associate a CXGN::Phenome::Individual with this image
 332  Ret:          a database id (individual_image)
 333  Args:         individual_id
 334  Side Effects:
 335  Example:
 336
 337 =cut
 338
 339 sub associate_individual {
 340     my $self = shift;
 341     my $individual_id = shift;
 342     my $query = "INSERT INTO phenome.individual_image
 343                    (individual_id, image_id) VALUES (?, ?)";
 344     my $sth = $self->get_dbh()->prepare($query);
 345     $sth->execute($individual_id, $self->get_image_id());
 346
 347     my $id= $self->get_currval("phenome.individual_image_individual_image_id_seq");
 348     return $id;
 349 }
 350
 351 =head2 get_individuals
 352
 353  Usage: $self->get_individuals()
 354  Desc:  find associated individuals with the image
 355  Ret:   list of 'Individual' objects
 356  Args:  none
 357  Side Effects: none
 358  Example:
 359
 360 =cut
 361
 362 sub get_individuals {
 363     my $self = shift;
 364     my $query = "SELECT individual_id FROM phenome.individual_image WHERE individual_image.image_id=?";
 365     my $sth = $self->get_dbh()->prepare($query);
 366     $sth->execute($self->get_image_id());
 367     my @individuals;
 368     while (my ($individual_id) = $sth->fetchrow_array()) {
 369         my $i = CXGN::Phenome::Individual->new($self->get_dbh(), $individual_id);
 370         if ( $i->get_individual_id() ) { push @individuals, $i; } #obsolete individuals should be ignored!
 371     }
 372     return @individuals;
 373 }
 374
 375
 376 =head2 associate_experiment
 377
 378  Usage: $image->associate_experiment($experiment_id);
 379  Desc:  associate and image with and insitu experiment
 380  Ret:   a database id
 381  Args:  experiment_id
 382  Side Effects:
 383  Example:
 384
 385 =cut
 386
 387 sub associate_experiment {
 388     my $self = shift;
 389     my $experiment_id = shift;
 390     my $query = "INSERT INTO insitu.experiment_image
 391                  (image_id, experiment_id)
 392                  VALUES (?, ?)";
 393     my $sth = $self->get_dbh()->prepare($query);
 394     $sth->execute($self->get_image_id(), $experiment_id);
 395     my $id= $self->get_currval("insitu.experiment_image_experiment_image_id_seq");
 396     return $id;
 397
 398 }
 399
 400 =head2 get_experiments
 401
 402  Usage:
 403  Desc:
 404  Ret:          a list of CXGN::Insitu::Experiment objects associated
 405                with this image
 406  Args:
 407  Side Effects:
 408  Example:
 409
 410 =cut
 411
 412 sub get_experiments {
 413     my $self = shift;
 414     my $query = "SELECT experiment_id FROM insitu.experiment_image
 415                  WHERE image_id=?";
 416     my $sth = $self->get_dbh()->prepare($query);
 417     $sth->execute($self->get_image_id());
 418     my @experiments = ();
 419     while (my ($experiment_id) = $sth->fetchrow_array()) {
 420         push @experiments, CXGN::Insitu::Experiment->new($self->get_dbh(), $experiment_id);
 421     }
 422     return @experiments;
 423 }
 424
 425 =head2 associate_fish_result
 426
 427  Usage:        $image->associate_fish_result($fish_result_id)
 428  Desc:         associate a CXGN::Phenome::Individual with this image
 429  Ret:          database_id
 430  Args:         fish_result_id
 431  Side Effects:
 432  Example:
 433
 434 =cut
 435
 436 sub associate_fish_result {
 437     my $self = shift;
 438     my $fish_result_id = shift;
 439     my $query = "INSERT INTO sgn.fish_result_image
 440                    (fish_result_id, image_id) VALUES (?, ?)";
 441     my $sth = $self->get_dbh()->prepare($query);
 442     $sth->execute($fish_result_id, $self->get_image_id());
 443     my $id= $self->get_currval("sgn.fish_result_image_fish_result_image_id_seq");
 444     return $id;
 445 }
 446
 447 =head2 get_fish_result_clone_ids
 448
 449  Usage:        my @clone_ids = $image->get_fish_result_clones();
 450  Desc:         because fish results are associated with genomic
 451                clones, this function returns the genomic clone ids
 452                that are associated through the fish results to
 453                this image. The clone ids can be used to construct
 454                links to the BAC detail page.
 455  Ret:          A list of clone_ids
 456  Args:
 457  Side Effects:
 458  Example:
 459
 460 =cut
 461
 462 sub get_fish_result_clone_ids {
 463     my $self = shift;
 464     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=?";
 465     my $sth = $self->get_dbh()->prepare($query);
 466     $sth->execute($self->get_image_id());
 467     my @fish_result_clone_ids = ();
 468     while (my ($fish_result_clone_id) = $sth->fetchrow_array()) {
 469         push @fish_result_clone_ids, $fish_result_clone_id;
 470     }
 471     return @fish_result_clone_ids;
 472 }
 473
 474 =head2 function get_associated_objects
 475
 476   Synopsis:
 477   Arguments:
 478   Returns:
 479   Side effects:
 480   Description:
 481
 482 =cut
 483
 484 sub get_associated_objects {
 485     my $self = shift;
 486     my @associations = ();
 487     my @individuals=$self->get_individuals();
 488     foreach my $ind (@individuals) {
 489         print STDERR  "found individual '$ind' !!\n";
 490         my $individual_id = $ind->get_individual_id();
 491         my $individual_name = $ind->get_name();
 492         push @associations, [ "individual", $individual_id, $individual_name ];
 493
 494 #       print "<a href=\"/phenome/individual.pl?individual_id=$individual_id\">".($ind->get_name())."</a>";
 495     }
 496
 497     foreach my $exp ($self->get_experiments()) {
 498         my $experiment_id = $exp->get_experiment_id();
 499         my $experiment_name = $exp->get_name();
 500
 501         push @associations, [ "experiment", $experiment_id, $experiment_name ];
 502
 503         #print "<a href=\"/insitu/detail/experiment.pl?experiment_id=$experiment_id&amp;action=view\">".($exp->get_name())."</a>";
 504     }
 505
 506     foreach my $fish_result_clone_id ($self->get_fish_result_clone_ids()) {
 507         push @associations, [ "fished_clone", $fish_result_clone_id ];
 508     }
 509     foreach my $locus ($self->get_loci() ) {
 510         push @associations, ["locus", $locus->get_locus_id(), $locus->get_locus_name];
 511     }
 512     return @associations;
 513 }
 514
 515
 516
 517 ### deanx additions - Nov 13, 2007
 518
 519 =head2 associate_locus
 520
 521  Usage:        $image->associate_locus($locus_id)
 522  Desc:         associate a locus with this image
 523  Ret:          database_id
 524  Args:         locus_id
 525  Side Effects:
 526  Example:
 527
 528 =cut
 529
 530 sub associate_locus {
 531     my $self = shift;
 532     my $locus_id = shift;
 533     my $sp_person_id= $self->get_sp_person_id();
 534     my $query = "INSERT INTO phenome.locus_image
 535                    (locus_id,
 536                    sp_person_id,
 537                    image_id)
 538                  VALUES (?, ?, ?)";
 539     my $sth = $self->get_dbh()->prepare($query);
 540     $sth->execute(
 541                 $locus_id,
 542                 $sp_person_id,
 543                 $self->get_image_id()
 544                 );
 545
 546     my $locus_image_id= $self->get_currval("phenome.locus_image_locus_image_id_seq");
 547     return $locus_image_id;
 548 }
 549
 550
 551 =head2 get_loci
 552
 553  Usage:   $self->get_loci
 554  Desc:    find the locus objects asociated with this image
 555  Ret:     a list of locus objects
 556  Args:    none
 557  Side Effects: none
 558  Example:
 559
 560 =cut
 561
 562 sub get_loci {
 563     my $self = shift;
 564     my $query = "SELECT locus_id FROM phenome.locus_image WHERE locus_image.obsolete = 'f' and locus_image.image_id=?";
 565     my $sth = $self->get_dbh()->prepare($query);
 566     $sth->execute($self->get_image_id());
 567     my $locus;
 568     my @loci = ();
 569     while (my ($locus_id) = $sth->fetchrow_array()) {
 570        $locus = CXGN::Phenome::Locus->new($self->get_dbh(), $locus_id);
 571         push @loci, $locus;
 572     }
 573     return @loci;
 574 }
 575
 576
 577
 578
 579 =head2 function get_associated_object_links
 580
 581   Synopsis:
 582   Arguments:
 583   Returns:      a string
 584   Side effects:
 585   Description:  gets the associated objects as links in tabular format
 586
 587 =cut
 588
 589 sub get_associated_object_links {
 590     my $self = shift;
 591     my $s = "";
 592     foreach my $assoc ($self->get_associated_objects()) {
 593
 594         if ($assoc->[0] eq "individual") {
 595             $s .= "<a href=\"/phenome/individual.pl?individual_id=$assoc->[1]\">Individual name: $assoc->[2].</a>";
 596         }
 597
 598         if ($assoc->[0] eq "experiment") {
 599             $s .= "<a href=\"/insitu/detail/experiment.pl?experiment_id=$assoc->[1]&amp;action=view\">insitu experiment $assoc->[2]</a>";
 600         }
 601
 602         if ($assoc->[0] eq "fished_clone") {
 603             $s .= qq { <a href="/maps/physical/clone_info.pl?id=$assoc->[1]">FISHed clone id:$assoc->[1]</a> };
 604
 605         }
 606       if ($assoc->[0] eq "locus" ) {
 607           $s .= qq { <a href="/phenome/locus_display.pl?locus_id=$assoc->[1]">Locus name:$assoc->[2]</a> };
 608       }
 609
 610     }
 611     return $s;
 612 }
 613
 614
 615
 616
 617 1;