lib/CXGN/Image.pm

   1
   2 =head1 NAME
   3
   4 CXGN::Image - a class for accessing the md_metadata.image table.
   5
   6
   7 =head1 DESCRIPTION
   8
   9 This class provides database access and store functions
  10 and functions to associate tags with the image.
  11
  12 Image uploads are handled by the SGN::Image subclass.
  13
  14 The implementation how images are stored has been changed. Whereas the
  15 images were stored in the image root dir keyed to the image_id, it is
  16 now keyed to the md5sum of the original image, with the md5sum stemmed
  17 into two byte directories. The constructor now takes a hash instead of
  18 positional arguments.
  19
  20 =head1 AUTHOR(S)
  21
  22 Lukas Mueller (lam87@cornell.edu)
  23 Naama Menda (nm249@cornell.edu)
  24
  25 =head1 VERSION
  26
  27 0.02, Dec 15, 2009.
  28
  29 =head1 MEMBER FUNCTIONS
  30
  31 The following functions are provided in this class:
  32
  33 =cut
  34
  35
  36 use strict;
  37
  38 package CXGN::Image;
  39
  40 use Carp qw/ cluck carp confess /;
  41
  42 use Digest::MD5;
  43 use File::Path 'make_path';
  44 use File::Spec;
  45 use File::Basename qw| basename dirname |;
  46 use File::Temp 'tempdir';
  47 use File::Copy qw| copy move |;
  48 use CXGN::Tag;
  49 use Data::Dumper;
  50 use Image::Size;
  51
  52 use base qw | CXGN::DB::ModifiableI |;
  53
  54
  55 # some pseudo constant definitions
  56 #
  57 our $LARGE_IMAGE_SIZE     = 800;
  58 our $MEDIUM_IMAGE_SIZE    = 400;
  59 our $SMALL_IMAGE_SIZE     = 200;
  60 our $THUMBNAIL_IMAGE_SIZE = 100;
  61
  62
  63 =head2 new
  64
  65  Usage:        my $image = CXGN::Image->new(dbh=>$dbh, image_id=>23423
  66                image_dir => $image_dir)
  67  Desc:         constructor
  68  Ret:
  69  Args:         a hash of a database handle, optional identifier, and the
  70                path to the root image_dir, with keys dbh, image_id and image_dir.
  71  Side Effects: if an identifier is specified, the image object
  72                will be populated from the database, otherwise
  73                an empty object is returned.
  74                Either way, a database connection is established.
  75  Example:
  76
  77 =cut
  78
  79 sub new {
  80     my $class = shift;
  81     my %args = @_;
  82
  83     my $self = $class->SUPER::new($args{dbh}, $args{image_id});
  84
  85     unless( exists $args{dbh} && exists $args{image_dir} ) {
  86         die "Required arguments: dbh, image_dir";
  87     }
  88     $self->set_image_dir($args{image_dir});
  89     $self->set_dbh($args{dbh});
  90
  91     if( exists $args{image_id} ) {
  92         $self->set_image_id($args{image_id});
  93         $self->_fetch_image() if $args{image_id};
  94     }
  95     return $self;
  96 }
  97
  98 sub _fetch_image {
  99     my $self = shift;
 100     my $query = "SELECT image_id,
 101                         name,
 102                         description,
 103                         original_filename,
 104                         file_ext,
 105                         sp_person_id,
 106                         modified_date,
 107                         create_date,
 108                         md5sum
 109                  FROM   metadata.md_image
 110                  WHERE  image_id=?
 111                         and obsolete != 't' ";
 112
 113     my $sth = $self->get_dbh()->prepare($query);
 114     $sth->execute($self->get_image_id()) ;
 115
 116     my ( $image_id, $name, $description, $original_filename, $file_ext, $sp_person_id, $modified_date, $create_date, $md5sum) =
 117         $sth->fetchrow_array();
 118
 119
 120     $self->set_name($name);
 121     $self->set_description($description);
 122     $self->set_original_filename($original_filename);
 123     $self->set_file_ext($file_ext);
 124     $self->set_sp_person_id($sp_person_id);
 125     $self->set_create_date($create_date);
 126     $self->set_modification_date($modified_date);
 127     $self->set_image_id($image_id);
 128     $self->set_md5sum($md5sum);# we do this that if is an image that has been deleted,
 129                                     # the object will get the NULL from the database and not
 130                                     # the image_id that was fed into the object.
 131
 132     #print STDERR  "Loaded image $image_id, $md5sum, $name, $original_filename, $file_ext\n";
 133
 134 }
 135
 136 =head2 store
 137
 138  Usage:        $image->store()
 139  Desc:         will store the data in the image object to the database
 140                if the image has an associated image_id, an update will
 141                occur. if the image does not have an associated image_id,
 142                an insert into the database will occur.
 143  Ret:          the image_id of the updated or inserted object.
 144  Args:
 145  Side Effects: database update or insert. Note that the image itself is
 146                stored on the file system and that it is not affected by
 147                this operation, unless the filename property is changed.
 148  Example:
 149
 150 =cut
 151
 152 sub store {
 153     my $self = shift;
 154     if ($self->get_image_id()) {
 155
 156         # it's an update
 157         #
 158         my $query = "UPDATE metadata.md_image SET
 159                             name=?,
 160                             description=?,
 161                             original_filename=?,
 162                             file_ext=?,
 163                             sp_person_id =?,
 164                             modified_date = now(),
 165                             md5sum =?
 166                       WHERE md_image.image_id=?";
 167
 168         my $sth = $self->get_dbh()->prepare($query);
 169
 170         $sth->execute(
 171             $self->get_name(),
 172             $self->get_description(),
 173             $self->get_original_filename(),
 174             $self->get_file_ext(),
 175             $self->get_sp_person_id(),
 176             $self->get_md5sum(),
 177             $self->get_image_id(),
 178
 179             );
 180         return $self->get_image_id();
 181     }
 182     else {
 183
 184         # it is an insert
 185         #
 186         my $query = "INSERT INTO metadata.md_image
 187                             (name,
 188                             description,
 189                             original_filename,
 190                             file_ext,
 191                             sp_person_id,
 192                             obsolete,
 193                             modified_date,
 194                             md5sum)
 195                      VALUES (?, ?, ?, ?, ?, ?, now(), ?)";
 196         my $sth = $self->get_dbh()->prepare($query);
 197         $sth->execute(
 198                        $self->get_name(),
 199                        $self->get_description(),
 200                        $self->get_original_filename(),
 201                        $self->get_file_ext(),
 202                        $self->get_sp_person_id(),
 203                        $self->get_obsolete(),
 204                        $self->get_md5sum(),
 205                        );
 206         my $image_id= $self->get_currval("metadata.md_image_image_id_seq");
 207         $self->set_image_id($image_id);
 208         return $self->get_image_id();
 209     }
 210 }
 211
 212 =head2 delete
 213
 214  Usage:  $self->delete()
 215  Desc:   set the image status to obsolete='t'
 216  Ret:    true on success, false on failure
 217  Args:  none
 218  Side Effects: set to obsolete='t' in individual_image, and locus_image
 219  Example:
 220
 221 =cut
 222
 223 sub delete {
 224     my $self = shift;
 225     if ($self->get_image_id()) {
 226         my $query = "UPDATE metadata.md_image set obsolete='t' WHERE image_id=?";
 227         my $sth = $self->get_dbh()->prepare($query);
 228         $sth->execute($self->get_image_id());
 229         $self->set_obsolete(1);
 230         #delete image-individual associations
 231         my $query2 = "UPDATE phenome.individual_image set obsolete = 't' WHERE image_id = ?";
 232         my $sth2 = $self->get_dbh()->prepare($query2);
 233         $sth2->execute($self->get_image_id() );
 234         #deanx - nov.14 2007 remove from locus_image too
 235         my $query3 = "UPDATE phenome.locus_image set obsolete = 't', modified_date = now() WHERE image_id = ?";
 236         my $sth3 = $self->get_dbh()->prepare($query3);
 237         $sth3->execute($self->get_image_id() );
 238         return 1;
 239     }
 240     else {
 241         warn("Image.pm: Trying to delete an image from the db that has not yet been stored.");
 242         return 0;
 243     }
 244
 245 }
 246
 247 =head2 get_image_id, set_image_id
 248
 249  Usage:        accessor for the image_id property.
 250  Desc:
 251  Ret:
 252  Args:
 253  Side Effects: if the image_id is not set, the store() function
 254                will insert a new row and set the image_id to
 255                the inserted row. Otherwise, store() performs
 256                an update.
 257  Example:
 258
 259 =cut
 260
 261 sub get_image_id {
 262     my $self=shift;
 263     return $self->{image_id};
 264
 265 }
 266
 267 sub set_image_id {
 268     my $self=shift;
 269     my $id = $self->{image_id} = shift;
 270
 271     !defined $id || $id =~ /^\d+$/
 272         or confess "invalid image_id '$id'";
 273
 274 }
 275
 276
 277 =head2 get_name, set_name
 278
 279  Usage:
 280  Desc:         gets/sets the name of the image
 281  Ret:
 282  Args:
 283  Side Effects: will be stored in db
 284  Example:
 285
 286 =cut
 287
 288 sub get_name {
 289     my $self=shift;
 290     return $self->{name};
 291
 292 }
 293
 294 sub set_name {
 295     my $self=shift;
 296     $self->{name}=shift;
 297 }
 298
 299 =head2 get_description, set_description
 300
 301  Usage:
 302  Desc:         accessor for the description property
 303  Ret:
 304  Args:
 305  Side Effects:
 306  Example:
 307
 308 =cut
 309
 310 sub get_description {
 311     my $self=shift;
 312     return $self->{description};
 313
 314 }
 315
 316 sub set_description {
 317     my $self=shift;
 318     $self->{description}=shift;
 319 }
 320
 321
 322 =head2 get_original_filename, set_original_filename
 323
 324  Usage:
 325  Desc:         accessor for the original_filename property
 326  Ret:
 327  Args:
 328  Side Effects:
 329  Example:
 330
 331 =cut
 332
 333 sub get_original_filename {
 334     my $self=shift;
 335     return $self->{original_filename};
 336 }
 337
 338 sub set_original_filename {
 339     my $self=shift;
 340     $self->{original_filename}=shift;
 341 }
 342
 343 =head2 get_file_ext, set_file_ext
 344
 345  Usage:
 346  Desc:         accessor for the file_ext property
 347  Ret:
 348  Args:
 349  Side Effects:
 350  Example:
 351
 352 =cut
 353
 354 sub get_file_ext {
 355   my $self=shift;
 356   return $self->{file_ext};
 357
 358 }
 359
 360 sub set_file_ext {
 361     my $self=shift;
 362     $self->{file_ext}=shift;
 363 }
 364
 365 =head2 accessors get_image_dir(), set_image_dir()
 366
 367  Usage:        returns the image dir
 368  Desc:
 369  Ret:
 370  Args:
 371  Side Effects:
 372  Example:
 373
 374 =cut
 375
 376 sub get_image_dir {
 377     my $self  = shift;
 378     return $self->{image_dir};
 379 }
 380
 381 sub set_image_dir {
 382     my $self = shift;
 383     $self->{image_dir} = shift;
 384 }
 385
 386 =head2 accessors get_locus_page_display_order(), set_locus_page_display_order()
 387
 388  Usage:
 389  Desc:
 390  Property
 391  Side Effects: Will modify the db asap (no store() required)
 392                image object needs to have an image_id
 393                setter will return error on failure
 394  Example:
 395
 396 =cut
 397
 398 sub get_locus_page_display_order {
 399     my $self = shift;
 400     my $locus_id = shift;
 401
 402     my @results = $self->get_locus_page_display_order_info($locus_id);
 403
 404     if (@results) {
 405         return $results[0]->[3];
 406     }
 407     return undef;
 408
 409 }
 410
 411 sub get_locus_page_display_order_info {
 412     my $self = shift;
 413     my $locus_id = shift;
 414
 415     my $q = "SELECT image_id, locus_image_id, locus_id, display_order FROM phenome.locus_image WHERE image_id = ? and locus_id=?";
 416     my $h = $self->get_dbh()->prepare($q);
 417     $h->execute($self->get_image_id(), $locus_id);
 418
 419     my @results;
 420     while (my ($image_id, $locus_id, $locus_image_id, $display_order) = $h->fetchrow_array()) {
 421         push @results, [ $image_id, $locus_id, $locus_image_id, $display_order ];
 422     }
 423
 424     if (@results > 1) {
 425         print STDERR "Multiple associations of image found ".Dumper(\@results)."\n";
 426     }
 427
 428      return @results;
 429 }
 430
 431 sub set_locus_page_display_order {
 432     my $self = shift;
 433     my $locus_id = shift;
 434     my $display_order = shift;
 435
 436     if (!$self->get_image_id()) {
 437         print STDERR "Please store object first before making connections.\n";
 438         return;
 439     }
 440     # check if there is a display_order property for the image
 441     #
 442     my @results = $self->get_locus_page_display_order_info($locus_id);
 443
 444     my $locus_image_id;
 445     if (@results > 1) {
 446         print STDERR "Multiple image locus association were found. Modifying only the first one.\n";
 447         $locus_image_id = $results[0]->[2];
 448     }
 449
 450     elsif (@results == 1) {
 451         $locus_image_id = $results[0]->[2];
 452     }
 453
 454     eval {
 455         if ($locus_image_id) {
 456             my $q = "UPDATE phenome.locus_image SET display_order=? WHERE locus_image_id=?";
 457             my $h = $self->get_dbh()->prepare($q);
 458             $h->execute($display_order, $locus_image_id);
 459         }
 460
 461         else {
 462             my $q = "INSERT INTO phenome.locus_image (image_id, sp_person_id, locus_id, display_order) VALUES (?, ?, ?, ?)";
 463             my $h = $self->get_dbh()->prepare($q);
 464             $h->execute($self->get_image_id(), $self->get_sp_person_id(), $locus_id, $display_order);
 465         }
 466
 467     };
 468     if ($@) {
 469         return "ERROR: $@\n";
 470     }
 471 }
 472
 473 =head2 accessors get_stock_page_display_order(), set_stock_page_display_order()
 474
 475  Usage:
 476  Desc:
 477  Property
 478  Side Effects: Will modify the db asap (no store() required)
 479                image object needs to have an image_id
 480                setter will return error on failure
 481  Example:
 482
 483 =cut
 484
 485 sub get_stock_page_display_order {
 486     my $self = shift;
 487     my $stock_id = shift;
 488
 489     my @results = $self->get_stock_page_display_order_info($stock_id);
 490
 491     print STDERR Dumper(\@results);
 492     if (@results) {
 493         return $results[0]->[3];
 494     }
 495     return undef;
 496
 497 }
 498
 499 sub get_stock_page_display_order_info {
 500     my $self = shift;
 501     my $stock_id = shift;
 502
 503     my $q = "SELECT stock_image_id, image_id, stock_id, display_order FROM phenome.stock_image WHERE image_id = ? and stock_id=?";
 504     my $h = $self->get_dbh()->prepare($q);
 505     $h->execute($self->get_image_id(), $stock_id);
 506
 507     my @results;
 508     while (my ($stock_image_id, $image_id, $stock_id, $display_order) = $h->fetchrow_array()) {
 509         push @results, [ $stock_image_id, $image_id, $stock_id, $display_order ];
 510     }
 511
 512     if (@results > 1) {
 513         print STDERR "Multiple associations of image found ".Dumper(\@results)."\n";
 514     }
 515     print STDERR Dumper(\@results);
 516
 517      return @results;
 518 }
 519
 520 sub set_stock_page_display_order {
 521     my $self = shift;
 522     my $stock_id = shift;
 523     my $display_order = shift;
 524
 525     if (!$self->get_image_id()) {
 526         print STDERR "Please store object first before making connections.\n";
 527         return;
 528     }
 529     # check if there is a display_order property for the image
 530     #
 531     my @results = $self->get_stock_page_display_order_info($stock_id);
 532
 533     my $stock_image_id;
 534     if (@results > 1) {
 535         print STDERR "Multiple image locus association were found. Modifying only the first one.\n";
 536         $stock_image_id = $results[0]->[0];
 537     }
 538
 539     elsif (@results == 1) {
 540         $stock_image_id = $results[0]->[0];
 541     }
 542
 543     eval {
 544         if ($stock_image_id) {
 545             print STDERR "Updating stock_image... (row $stock_image_id)\n";
 546             my $q = "UPDATE phenome.stock_image SET display_order=? WHERE stock_image_id=?";
 547             my $h = $self->get_dbh()->prepare($q);
 548             $h->execute($display_order, $stock_image_id);
 549         }
 550
 551         else {
 552             print STDERR "Inserting into stock_image...\n";
 553             my $q = "INSERT INTO phenome.stock_image (image_id, stock_id, display_order) VALUES (?, ?, ?)";
 554             my $h = $self->get_dbh()->prepare($q);
 555             $h->execute($self->get_image_id(), $stock_id, $display_order);
 556         }
 557
 558     };
 559     if ($@) {
 560         return "ERROR: $@\n";
 561     }
 562 }
 563
 564
 565 sub get_display_order_info {
 566     my $self = shift;
 567
 568     my $q = "SELECT stock_image_id, image_id, stock_id, display_order, uniquename FROM phenome.stock_image join stock using(stock_id) WHERE image_id = ?";
 569     my $h = $self->get_dbh()->prepare($q);
 570     $h->execute($self->get_image_id());
 571
 572     my @info = ();
 573     while (my ($stock_image_id, $image_id, $stock_id, $display_order, $name) = $h->fetchrow_array()) {
 574         push @info, { image_id => $image_id, type => "stock", id => $stock_id, display_order => $display_order, name => $name };
 575     }
 576
 577     my $q = "SELECT locus_image_id, image_id, locus_id, display_order, locus_name FROM phenome.locus_image join locus using(locus_id) WHERE image_id = ?";
 578     my $h = $self->get_dbh()->prepare($q);
 579     $h->execute($self->get_image_id());
 580     while (my ($stock_image_id, $image_id, $locus_id, $display_order, $name) = $h->fetchrow_array()) {
 581         push @info, { image_id => $image_id, type => "locus", id => $locus_id, display_order => $display_order, name => $name };
 582     }
 583     print STDERR Dumper(\@info);
 584     return @info;
 585 }
 586
 587 =head2 process_image
 588
 589  Usage:        $return_code = $image -> process_image($filename);
 590  Desc:         processes the image that has been uploaded with the upload command.
 591  Ret:          the image id of the image in the database as a positive number,
 592                error conditions as negative numbers.
 593  Args:         the filename of the file (complete path)
 594  Side Effects: generates a new subdirectory in the image_dir for the image files,
 595                copies the image file to a temp dir directory where it is processed
 596                (resized thumnbnails and other views for the image). After that
 597                is done, the image object is stored in the database, and the
 598                image files are moved to the final location in the filesystem.
 599  Example:
 600
 601 =cut
 602
 603
 604
 605 sub process_image {
 606     my $self      = shift;
 607     my $file_name = shift;
 608     my $type      = shift;
 609     my $type_id   = shift;
 610
 611     if ( my $id = $self->get_image_id() ) {
 612         warn "process_image: The image object ($id) should already have an associated image. The old image will be overwritten with the new image provided!\n";
 613     }
 614
 615     make_path( $self->get_image_dir );
 616     my ($processing_dir) =
 617       File::Temp::tempdir( "process_XXXXXX",
 618         DIR => $self->get_image_dir() );
 619     system("chmod 775 $processing_dir");
 620     $self->set_processing_dir($processing_dir);
 621
 622     # process image
 623     #
 624     $processing_dir = $self->get_processing_dir();
 625
 626     # copy unmodified image to be fullsize image
 627     #
 628     #my ($basename, $directories, $file_ext) = File::Basename::fileparse($file_name, qr/\.(?!\.)(.*)$/); #filename may contain one additional dot
 629     my $full_basename = basename($file_name);
 630     my $directories = dirname($file_name);
 631     my $file_ext;
 632     my $basename; # without file_ext;
 633     if ($full_basename =~ m/(.*)(\.(?!\.).*)$/) {  # extension is what follows last .
 634         $basename = $1;
 635         $file_ext = $2;
 636     }
 637
 638
 639     #print STDERR "BASENAME: $basename, DIRECTORIES: $directories FILE_EXT $file_ext\n";
 640     my $original_filename = $basename;
 641     my $original_file_ext = $file_ext;
 642
 643     my $dest_name = $self->get_processing_dir() . "/" . $basename.$file_ext;
 644
 645     #print STDERR "Destination: ".$dest_name."\n";
 646     File::Copy::copy( $file_name, $dest_name )
 647       || die "Can't copy file $file_name to $dest_name";
 648     my $chmod = "chmod 664 '$dest_name'";
 649
 650     ### Multi Page Document Support
 651     #    deanx - nov. 16 2007
 652     #   PDF, PS, EPS documents are now supported by ImageMagick/Ghostscript
 653     #   A primary impact is these types can multipage.  'mogrify' produces
 654     #   one image per page, labelled filename-0.jpg, filename-1.jpg ...
 655     #   This code detects multipage documents and copies the first page for
 656     #   thumbnail processing
 657
 658     my @image_pages = `/usr/bin/identify "$dest_name"`;
 659
 660     if ( $#image_pages > 0 ) {    # multipage, pdf, ps or eps
 661
 662
 663         # note mogrify used since 'convert' will not correctly
 664         # reformat (convert makes blank images) Convert and mogrify
 665         # both dislike the format of our filenames intensely if
 666         # ghostscript is envoked ... change filename to something
 667         # beign like temp.<ext>
 668
 669         my $newname;
 670         if ( $file_ext ) {
 671             # note; mogrify will create files named basename-0.jpg, basename-1.jpg
 672             my $mogrified_first_image = $processing_dir . "/temp-0.jpg";
 673             my $tempname = $processing_dir . "/temp" . $file_ext;
 674             $newname = $basename . ".jpg";
 675             my $new_dest = $processing_dir . "/" . $newname;
 676
 677             # use temp name for mogrify/ghostscript
 678             File::Copy::copy( $dest_name, $tempname )
 679               || die "Can't copy file $basename to $tempname";
 680
 681             if ( `mogrify -format jpg '$tempname'` ) {
 682                 die "Sorry, can't convert image $basename";
 683             }
 684
 685             File::Copy::copy( $mogrified_first_image, $new_dest )
 686               || die "Can't copy file $mogrified_first_image to $newname";
 687
 688         }
 689         $basename = $newname;
 690
 691     }
 692     else { # appears to be a regular simple image
 693
 694         my $newname = "";
 695
 696         if ( ! `mogrify -format jpg '$dest_name'` ) {
 697             # has no jpg extension
 698             if ($file_ext !~ /jpg|jpeg/i) {
 699                 $newname = $original_filename . ".JPG";    # convert it to extention .JPG
 700             }
 701             # has no extension at all
 702             elsif (!$file_ext) {
 703                 $newname = $original_filename . ".JPG";         # add an extension .JPG
 704             }
 705             else {
 706                 $newname = $original_filename.".JPG"; # add standard JPG file extension.
 707             }
 708
 709             system( "convert", "$processing_dir/$basename$file_ext", "$processing_dir/$newname" );
 710             $? and die "Sorry, can't convert image $basename$file_ext to $newname";
 711
 712             $original_filename = $newname;
 713             $basename          = $newname;
 714         }
 715     }
 716
 717     # create large image
 718     $self->copy_image_resize(
 719         "$processing_dir/$basename",
 720         $self->get_processing_dir() . "/large.jpg",
 721         $self->get_image_size("large")
 722     );
 723
 724     # create midsize images
 725     $self->copy_image_resize(
 726         "$processing_dir/$basename",
 727         $self->get_processing_dir() . "/medium.jpg",
 728         $self->get_image_size("medium")
 729     );
 730
 731     # create small image
 732     $self->copy_image_resize(
 733         "$processing_dir/$basename",
 734         $self->get_processing_dir() . "/small.jpg",
 735         $self->get_image_size("small")
 736     );
 737
 738     # create thumbnail
 739     $self->copy_image_resize(
 740         "$processing_dir/$basename",
 741         $self->get_processing_dir() . "/thumbnail.jpg",
 742         $self->get_image_size("thumbnail")
 743     );
 744
 745     # enter preliminary image data into database
 746     my $ext = "";
 747     if ( $original_filename =~ /(.*)(\.\S{1,4})$/ ) {
 748         $original_filename = $1;
 749         $ext               = $2;
 750     }
 751
 752     $self->set_original_filename($original_filename);
 753     $self->set_file_ext($file_ext); # this is the original file
 754
 755     # start transaction, store the image object, and associate it to
 756     # the given type and type_id.
 757
 758     # move the image into the md5sum subdirectory
 759     #
 760     my $original_file_path = $self->get_processing_dir()."/".$self->get_original_filename().$self->get_file_ext();
 761
 762     my $md5sum = $self->calculate_md5sum($original_file_path);
 763     print STDERR "MD5SUM NOW: $md5sum\n";
 764
 765     # check if the image already exists in the database.
 766     # For an image to exist, the md5checksum must exist in the metadata.md_image
 767     # table, and the file must exist on disk.
 768     #
 769     # check if this md5sum already exists in the database
 770     #
 771     my $image_id = CXGN::Image->is_duplicate($self->get_dbh(), $original_file_path);
 772
 773     my $message = "";
 774
 775     if ($image_id) {
 776         print STDERR  "An image with an identical md5sum ($md5sum) has already been uploaded with the image id $image_id\n";
 777         $message = "Duplicate image $image_id\n";
 778         $self->set_image_id($image_id);
 779     }
 780     else {
 781         $message = "ok";
 782     }
 783
 784     $self->set_md5sum($md5sum);
 785     $self->make_dirs();
 786     $self->finalize_location($processing_dir);
 787
 788     $image_id = $self->store();
 789
 790     if (wantarray) {
 791         return ($image_id, $message);
 792     }
 793     else {
 794         return $image_id;
 795     }
 796 }
 797
 798 =head2 make_dirs
 799
 800  Usage:
 801  Desc:         creates the directory structure for image from
 802                image_dir onwards (a split md5sum)
 803  Ret:
 804  Args:
 805  Side Effects:
 806  Example:
 807
 808 =cut
 809
 810 sub make_dirs {
 811     my $self = shift;
 812     my $image_sub_path = $self->image_subpath();
 813
 814     my $path = File::Spec->catdir( $self->get_image_dir(), $image_sub_path );
 815     if (my $dirs = make_path($path) ) {
 816         #print STDERR  "Created $dirs Dirs (should be 4)\n";
 817     }
 818 }
 819
 820
 821 =head2 finalize_location
 822
 823  Usage:
 824  Desc:
 825  Ret:
 826  Args:          the source location as a path to a dir
 827  Side Effects:
 828  Example:
 829
 830 =cut
 831
 832 sub finalize_location {
 833     my $self = shift;
 834     my $processing_dir = shift;
 835
 836     my $image_dir = File::Spec->catdir( $self->get_image_dir, $self->image_subpath );
 837     foreach my $f (glob($processing_dir."/*")) {
 838
 839         File::Copy::move( $f, $image_dir )
 840             || die "Couldn't move temp dir to image dir ($f, $image_dir)";
 841         #print STDERR "Moved image file $f to final location $image_dir...\n";
 842
 843     }
 844
 845     rmdir $processing_dir;
 846
 847 }
 848
 849 # used for migration
 850
 851 sub copy_location {
 852     my $self = shift;
 853     my $source_dir = shift;
 854
 855     my $image_dir = $self->get_image_dir() ."/".$self->image_subpath();
 856     foreach my $f (glob($source_dir."/*")) {
 857         if (! -e $f) {
 858             print STDERR "$f does not exist... moving on...\n";
 859             return;
 860         }
 861         File::Copy::copy( "$f", "$image_dir/" )
 862             || die "Couldn't move temp dir to image dir ($f, $image_dir). $!";
 863         #print STDERR "Moved image file $f to final location $image_dir...\n";
 864
 865     }
 866
 867 }
 868
 869
 870 =head2 image_subpath
 871
 872  Usage: $image->image_subpath
 873  Desc: returns the image subpath, which is a md5sum on an image file,
 874        divided into 16 directory levels at 2 bytes length each.
 875  Ret:  path part in which to store the various sizes of this image
 876        under the image root dir, something like 'ab/cd/ef/01/ab1fab1fab1fab1fab1fab1f'
 877  Args: none
 878  Side Effects: none
 879
 880 =cut
 881
 882 sub image_subpath {
 883     my $self = shift;
 884
 885     my $md5sum = $self->get_md5sum;
 886     unless( $md5sum ) {
 887         # if the image has no md5sum, either from the database or for
 888         # some other reason, warn copiously about it but don't die
 889         cluck 'cannot calculate image_subpath, no md5sum set for image_id '.$self->get_image_id;
 890         $md5sum = 'X'x32;
 891     }
 892
 893     return join '/', $md5sum =~ /^(..)(..)(..)(..)(.+)$/;
 894 }
 895
 896 =head2 calculate_md5sum
 897
 898  Usage:
 899  Desc:
 900  Ret:
 901  Args:
 902  Side Effects:
 903  Example:
 904
 905 =cut
 906
 907 sub calculate_md5sum {
 908     my $self = shift;
 909     my $file = shift;
 910
 911     open (my $F, "<", $file) || confess "Can't open $file ";
 912     binmode($F);
 913     my $md5 = Digest::MD5->new();
 914     $md5->addfile($F);
 915     close($F);
 916
 917     my $md5sum = $md5->hexdigest();
 918     $md5->reset();
 919
 920     return $md5sum;
 921 }
 922
 923 sub copy_image_resize {
 924     my $self = shift;
 925     my ( $original_image, $new_image, $width ) = @_;
 926
 927     #print STDERR "Resizing: Destination: $new_image\n";
 928     File::Copy::copy( $original_image, $new_image );
 929     my $chmod = "chmod 664 '$new_image'";
 930
 931     # now resize the new file, and ensure it is a jpeg
 932     my $resize = `mogrify -format jpg -geometry $width '$new_image'`;
 933 }
 934
 935
 936 =head2 get_image_size_hash
 937
 938  Usage:
 939  Desc:
 940  Ret:
 941  Args:
 942  Side Effects:
 943  Example:
 944
 945 =cut
 946
 947 sub get_image_size_hash {
 948     my $self = shift;
 949     return (
 950         large     => $LARGE_IMAGE_SIZE,
 951         medium    => $MEDIUM_IMAGE_SIZE,
 952         small     => $SMALL_IMAGE_SIZE,
 953         thumbnail => $THUMBNAIL_IMAGE_SIZE,
 954     );
 955 }
 956
 957 =head2 get_image_size
 958
 959  Usage:
 960  Desc:
 961  Ret:
 962  Args:         "large" | "medium" | "small" | "thumbnail"
 963                default is medium
 964  Side Effects:
 965  Example:
 966
 967 =cut
 968
 969 sub get_image_size {
 970     my $self = shift;
 971     my $size = shift;
 972     my %hash = $self->get_image_size_hash();
 973     if ( exists( $hash{$size} ) ) {
 974         return $hash{$size};
 975     }
 976
 977     # default
 978     #
 979     return $MEDIUM_IMAGE_SIZE;
 980 }
 981
 982
 983 =head2 get_filename
 984
 985  Usage:
 986  Desc:
 987  Ret:
 988  Args:
 989  Side Effects:
 990  Example:
 991
 992 =cut
 993
 994 sub get_filename {
 995     my $self = shift;
 996     my $size = shift;
 997     my $type = shift || ''; # full or partial
 998
 999     my $image_dir =
1000         $type eq 'partial'
1001             ? $self->image_subpath
1002             : File::Spec->catdir( $self->get_image_dir, $self->image_subpath );
1003
1004     if ($size eq "thumbnail") {
1005         return File::Spec->catfile($image_dir, 'thumbnail.jpg');
1006     }
1007     if ($size eq "small") {
1008         return File::Spec->catfile($image_dir, 'small.jpg');
1009     }
1010     if ($size eq "large") {
1011         return File::Spec->catfile($image_dir, 'large.jpg');
1012     }
1013     if ($size eq "original") {
1014         return File::Spec->catfile($image_dir, $self->get_original_filename().$self->get_file_ext());
1015     }
1016     if ($size eq "original_converted") {
1017         return File::Spec->catfile($image_dir, $self->get_original_filename().".JPG");
1018     }
1019     return File::Spec->catfile($image_dir, 'medium.jpg');
1020 }
1021
1022
1023 =head2 get_processing_dir
1024
1025  Usage:
1026  Desc:
1027  Ret:
1028  Args:
1029  Side Effects:
1030  Example:
1031
1032 =cut
1033
1034 sub get_processing_dir {
1035     my $self = shift;
1036     return $self->{processing_dir};
1037
1038 }
1039
1040 sub set_processing_dir {
1041     my $self = shift;
1042     $self->{processing_dir} = shift;
1043 }
1044
1045
1046 =head2 function get_copyright, set_copyright
1047
1048   Synopsis:     $copyright = $image->get_copyright();
1049                 $image->set_copyright("Copyright (c) 2001 by Picasso");
1050   Arguments:    getter: the copyright information string
1051   Returns:      setter: the copyright information string
1052   Side effects: will be stored in the database in the copyright column.
1053   Description:
1054
1055 =cut
1056
1057 sub get_copyright {
1058     my $self = shift;
1059     return $self->{copyright};
1060 }
1061
1062 sub set_copyright {
1063     my $self = shift;
1064     $self->{copyright} = shift;
1065 }
1066
1067 =head2 accessors get_md5sum, set_md5sum
1068
1069  Usage:
1070  Desc:
1071  Property
1072  Side Effects:
1073  Example:
1074
1075 =cut
1076
1077 sub get_md5sum {
1078   my $self = shift;
1079   return $self->{md5sum};
1080 }
1081
1082 sub set_md5sum {
1083   my $self = shift;
1084   $self->{md5sum} = shift;
1085 }
1086
1087
1088 =head2 iconify_file
1089
1090 Usage:   Iconify_file ($filename)
1091 Desc:    This is used only for PDF, PS and EPS files during Upload processing to produce a thumbnail image
1092          for these filetypes for the CONFIRM screen.  Results end up on disk but are not used other than to t
1093          produce the thumbnail
1094 Ret:
1095 Args:    Full Filename of PDF file
1096 Side Effects:
1097 Example:
1098
1099 =cut
1100
1101 sub iconify_file {
1102     my $file_name = shift;
1103
1104     my $basename = File::Basename::basename($file_name);
1105
1106     my $self = SGN::Context->new()
1107       ;    # merely used to retrieve correct temp dir on this host
1108     my $temp_dir =
1109         $self->get_conf("basepath") . "/"
1110       . $self->get_conf("tempfiles_subdir")
1111       . "/temp_images";
1112
1113     my @image_pages = `/usr/bin/identify $file_name`;
1114
1115     my $mogrified_image;
1116     my $newname;
1117     if ( $basename =~ /(.*)\.(.{1,4})$/ )
1118     {      #note; mogrify will create files name
1119             # basename-0.jpg, basename-1.jpg
1120         if ( $#image_pages > 0 ) {    # multipage, pdf, ps or eps
1121             $mogrified_image = $temp_dir . "/temp-0.jpg";
1122         }
1123         else {
1124             $mogrified_image = $temp_dir . "/temp.jpg";
1125         }
1126         my $tempname = $temp_dir . "/temp." . $2;    # retrieve file extension
1127         $newname = $basename . ".jpg";               #
1128         my $new_dest = $temp_dir . "/" . $newname;
1129
1130         # use temp name for mogrify/ghostscript
1131         File::Copy::copy( $file_name, $tempname )
1132           || die "Can't copy file $basename to $tempname";
1133
1134         if ( (`mogrify -format jpg '$tempname'`) ) {
1135             die "Sorry, can't convert image $basename";
1136         }
1137
1138         File::Copy::copy( $mogrified_image, $new_dest )
1139           || die "Can't copy file $mogrified_image to $newname";
1140
1141     }
1142     return;
1143 }
1144
1145
1146 =head2 hard_delete
1147
1148  Usage:        $image->hard_delete()
1149  Desc:         "hard" deletes the image.
1150                NEVER USE THIS FUNCTION!
1151  Ret:          nothing
1152  Args:         none
1153  Side Effects: completely removes all the traces of this image.
1154  Example:      to be used in testing scripts only. Deletion should be
1155                implemented using the 'obsolete' flag.
1156
1157 =cut
1158
1159 sub hard_delete {
1160     my $self = shift;
1161     my $test_mode = shift;
1162
1163     if ( $self->get_original_filename && $self->pointer_count() < 2) {
1164         foreach my $size ('original', 'thumbnail', 'small', 'medium', 'large') {
1165             my $filename = $self->get_filename($size);
1166
1167             if ($test_mode) {
1168                 print STDERR  "Test Mode: Would delete $filename.\n";
1169             }
1170             else {
1171                 print STDERR "Deleting $filename...\n";
1172                 unlink $filename;
1173             }
1174         }
1175     }
1176
1177     $self->get_dbh->do('delete from phenome.stock_image where image_id= ?', undef, $self->get_image_id());
1178     $self->get_dbh->do('delete from metadata.md_tag_image where image_id= ?', undef, $self->get_image_id());
1179     $self->get_dbh->do('delete from phenome.locus_image where image_id= ?', undef, $self->get_image_id());
1180     $self->get_dbh->do('delete from md_image where image_id = ?', undef, $self->get_image_id );
1181 }
1182
1183 =head2 pointer_count
1184
1185  Usage: print $image->pointer_count." db rows reference this image"
1186  Desc: get a count of how many rows in the db refer to the same image file
1187  Ret: integer number
1188  Args: none
1189  Side Effects: queries the db
1190
1191 =cut
1192
1193 sub pointer_count {
1194     my ($self) = @_;
1195
1196     return $self->get_dbh->selectrow_array( <<'', undef, $self->get_md5sum );
1197 SELECT count( distinct( image_id ) ) from md_image WHERE md5sum=?
1198
1199 }
1200
1201
1202 =head2 add_tag
1203
1204  Usage:        $self->add_tag($tag)
1205  Desc:         adds a tag to the image
1206  Ret:          database id
1207  Args:         a tag object (CXGN::Tag).
1208  Side Effects: the tag is immediately store in the database.
1209                there is no need to call store() on the image object.
1210  Example:
1211
1212 =cut
1213
1214 sub add_tag {
1215     my $self = shift;
1216     my $tag = shift;
1217
1218     my $query = "INSERT INTO metadata.md_tag_image (tag_id, image_id) values (?, ?)";
1219
1220     my $sth = $self->get_dbh()->prepare($query);
1221     $sth->execute($tag->get_tag_id(), $self->get_image_id());
1222     my $id= $self->get_currval("metadata.md_tag_image_tag_image_id_seq");
1223     return $id;
1224 }
1225
1226 =head2 get_tags
1227
1228  Usage:        my @tags = $image->get_tags();
1229  Desc:         gets all the tags associated with this image object
1230  Ret:
1231  Args:
1232  Side Effects: the tags are being fetched from the database. The image
1233                object does not 'buffer' tag associations (see also add_tag()).
1234  Example:
1235
1236 =cut
1237
1238 sub get_tags {
1239     my $self  = shift;
1240
1241     my $query = "SELECT tag_id FROM metadata.md_tag_image WHERE image_id=?";
1242     my $sth = $self->get_dbh()->prepare($query);
1243     $sth->execute($self->get_image_id());
1244     my @tags;
1245     while (my ($tag_id) = $sth->fetchrow_array()) {
1246         push @tags, CXGN::Tag->new($self->get_dbh(), $tag_id);
1247     }
1248     return @tags;
1249 }
1250
1251 =head2 remove_tag
1252
1253  Usage:        $self->remove_tag($tag)
1254  Desc:         Delete a tag_image association
1255  Ret:          nothing
1256  Args:         a tag object.
1257  Side Effects: the association to the tag object will be removed
1258                directly accessing the database backstore. There is no
1259                need to call store() after remove_tag(). The tag itself
1260                is not affected.
1261  Example:
1262
1263 =cut
1264
1265 sub remove_tag {
1266     my $self = shift;
1267     my $tag = shift;
1268     my $query = "DELETE FROM metadata.md_tag_image WHERE tag_id=? and image_id=?";
1269     my $sth = $self->get_dbh()->prepare($query);
1270     $sth->execute($tag->get_tag_id(), $self->get_image_id());
1271 }
1272
1273
1274 =head2 exists_tag_image_named
1275
1276  Usage: CXGN::Image::exists_tag_image_named($dbh, $tag_id, $image_id)
1277  Desc:  Check if a tag is already associated with an image
1278  Ret:   a database id or undef
1279  Args:  dbh, tag_id, image_id
1280  Side Effects: none
1281  Example:
1282
1283 =cut
1284
1285 sub exists_tag_image_named {
1286     my $dbh = shift;
1287     my $tag_id = shift;
1288     my $image_id=shift;
1289     my $query = "SELECT tag_image_id
1290                    FROM metadata.md_tag_image
1291                   WHERE tag_id= ? AND image_id= ?";
1292     my $sth = $dbh->prepare($query);
1293     $sth->execute($tag_id, $image_id);
1294     if (my ($id)=$sth->fetchrow_array()) {
1295         return $id;
1296     }
1297     else {
1298         return 0;
1299     }
1300 }
1301
1302 =head2 is_duplicate($dbh, $image_file_path)
1303
1304 checks if the image in the file $image_file_path is already in the database, checked by matching md5sums.
1305
1306 class function. Call as CXGN::Image->is_duplicate($dbh, $image_file_path);
1307 =cut
1308
1309 sub is_duplicate {
1310     my $class = shift;
1311     my $dbh = shift;
1312     my $image_file_path = shift;
1313
1314     my $md5sum = $class->calculate_md5sum($image_file_path);
1315
1316     my $image_id = $class->find_image_with_md5sum($dbh, $md5sum);
1317     print STDERR "Retrieved image_id $image_id\n";
1318
1319     if (!$image_id) {
1320         # maybe the provided image needs to be converted the same way as the final
1321         # image for the md5sums to match the database
1322         print STDERR "raw image did not match, trying conversion...\n";
1323         copy($image_file_path, $image_file_path.".mogrified");
1324         system( "convert", $image_file_path.".mogrified", $image_file_path.".mogrified.JPG" );
1325         `mogrify -format jpg '$image_file_path.mogrified.JPG'`;
1326         $md5sum = $class->calculate_md5sum($image_file_path.".mogrified.JPG");
1327         $image_id = $class->find_image_with_md5sum($dbh, $md5sum);
1328         print STDERR "Retrieved image_id $image_id (second try)\n";
1329     }
1330
1331
1332     if ($image_id) {
1333         print STDERR  "An image with an identical md5sum ($md5sum) has already been uploaded with the image id <a href=\"/ajax/image/$image_id/view\">$image_id</a>\n";
1334         return $image_id;
1335     }
1336     print STDERR "The image $md5sum is not yet in the database!\n";
1337     return 0;
1338 }
1339
1340
1341 sub find_image_with_md5sum {
1342     my $class = shift;
1343     my $dbh = shift;
1344     my $md5sum = shift;
1345
1346     print STDERR "checking existence of image with md5sum $md5sum\n";
1347     my $q = "SELECT image_id from metadata.md_image where md5sum=?";
1348     my $h = $dbh->prepare($q);
1349     $h->execute($md5sum);
1350     my ($image_id) = $h->fetchrow_array();
1351     return $image_id;
1352 }
1353
1354 =head2 create_schema
1355
1356  Usage:
1357  Desc:
1358  Ret:
1359  Args:
1360  Side Effects:
1361  Example:
1362
1363 =cut
1364
1365
1366
1367 sub create_schema {
1368     my $self = shift;
1369
1370     $self->get_dbh()->do(
1371                      "CREATE table metadata.md_image (
1372                                                 image_id serial primary key,
1373                                                 name varchar(100),
1374                                                 description text,
1375                                                 original_filename varchar(100),
1376                                                 file_ext varchar(20),
1377                                                 sp_person_id bigint REFERENCES sgn_people.sp_person,
1378                                                 modified_date timestamp with time zone,
1379                                                 create_date timestamp with time zone,
1380                                                 md5sum text,
1381                                                 obsolete boolean default false
1382                                                 )");
1383
1384     $self->get_dbh()->do("GRANT SELECT, UPDATE, INSERT, DELETE ON metadata.md_image TO web_usr");
1385     $self->get_dbh()->do("GRANT select, update ON metadata.md_image_image_id_seq TO web_usr");
1386
1387     $self->get_dbh()->do(
1388                      "CREATE table phenome.individual_image (
1389                                                 individual_image_id serial primary key,
1390                                                 image_id bigint references metadata.md_image,
1391                                                 individual_id bigint references phenome.individual,
1392                                                 obsolete boolean DEFAULT 'false',
1393                                                 sp_person_id integer REFERENCES sgn_people.sp_person(sp_person_id),
1394                                                 create_date timestamp with time zone DEFAULT now(),
1395                                                 modified_date timestamp with time zone
1396                    )");
1397
1398     $self->get_dbh()->do("GRANT SELECT, UPDATE, INSERT ON phenome.individual_image TO web_usr");
1399     $self->get_dbh()->do("GRANT select, update ON phenome.individual_image_individual_image_id_seq TO web_usr");
1400
1401     $self->get_dbh()->do(
1402         "CREATE table phenome.locus_image (
1403                                                 locus_image_id serial primary key,
1404                                                 image_id bigint references metadata.md_image,
1405                                                 locus_id bigint references phenome.locus,
1406                                                 obsolete boolean DEFAULT 'false',
1407                                                 sp_person_id integer REFERENCES sgn_people.sp_person(sp_person_id),
1408                                                 create_date timestamp with time zone DEFAULT now(),
1409                                                 modified_date timestamp with time zone
1410                    )");
1411
1412     $self->get_dbh()->do("GRANT SELECT, UPDATE, INSERT ON phenome.locus_image TO web_usr");
1413     $self->get_dbh()->do("GRANT select, update ON phenome.locus_image_locus_image_id_seq TO web_usr");
1414
1415
1416     $self->get_dbh()->do(
1417                      "CREATE table insitu.experiment_image (
1418                                                  experiment_image_id serial primary key,
1419                                                  image_id bigint references metadata.md_image,
1420                                                  experiment_id bigint references insitu.experiment,
1421                                                   obsolete boolean DEFAULT 'false',
1422                                                 sp_person_id integer REFERENCES sgn_people.sp_person(sp_person_id),
1423                                                 create_date timestamp with time zone DEFAULT now(),
1424                                                 modified_date timestamp with time zone
1425                   )");
1426
1427     $self->get_dbh()->do ("GRANT SELECT, UPDATE, INSERT ON insitu.experiment_image TO web_usr");
1428     $self->get_dbh()->do ("GRANT select, update ON insitu.experiment_image_experiment_image_id_seq TO web_usr");
1429
1430     $self->get_dbh()->do ("CREATE table sgn.fish_result_image (
1431                                                   fish_result_image_id serial primary key,
1432                                                   image_id bigint references metadata.md_image,
1433                                                   fish_result_id bigint references sgn.fish_result
1434                     )");
1435     $self->get_dbh()->do ("GRANT SELECT ON sgn.fish_result_image TO web_usr");
1436     $self->get_dbh()->do ("GRANT select ON sgn.fish_result_image_fish_result_image_id_seq TO web_usr");
1437     # we don't grant access to webusr for image_fish_result because as of now users cannot submit
1438     # these image directly themselves.
1439
1440     print STDERR "Schemas created.\n";
1441 }
1442
1443 ###########
1444 1;#########
1445 ###########