#!/usr/bin/perl
# ----------------------------------------------------------------------------
# This software is Copyright (C) 2007, All Rights Reserved
# ----------------------------------------------------------------------------
# This program is protected by local and international copyright laws. Any
# use of this program is subject to the the terms of the license agreement
# included as part of this distribution archive. Any other uses are strictly
# prohibited without the written permission of the Vendor and all
# other rights are reserved.
# -----------------------------------------------------------------------------
# Warning : Modifying this program violates your license agreement!
# -----------------------------------------------------------------------------

package IT::Image;

# load modules
use strict;

use IT::Globals;

# library globals
use vars qw($MINIMUM_GD_VERSION $MINIMUM_IMAGE_MAGICK_VERSION $GD_EVAL_ERROR $IM_EVAL_ERROR);
$MINIMUM_GD_VERSION           = 2.17;   # (tested with 2.19) copyResampled() does smooth resizing and was introduced in 2.0.
$MINIMUM_IMAGE_MAGICK_VERSION = 6.0.6;    # (tested with 6.0.6)



# ------------------------------------------------------------------------------
# Function    : getModuleVersions
# Description : return module versions or undef if module isn't available.
#               Note: Loading both modules takes up more memory, only call this
#               function where needed.
# Usage       : my($gdVersion, $imageMagickVersion) = &IT::Image::getModuleVersions();
# ------------------------------------------------------------------------------

sub getModuleVersions {

  # error checking
  unless (wantarray) { die "getModuleVersions can only be called in a list context!"; }

  ### load modules
  eval { require GD; };
  if ($@) { $GD_EVAL_ERROR = $@; }

  eval { require Image::Magick; };
  if ($@) { $IM_EVAL_ERROR = $@; }

  # return versions
  return ($GD::VERSION, $Image::Magick::VERSION);

}

# ------------------------------------------------------------------------------
# Function    : isImage
# Description : Checks the extension of the specified image and return 1 if it
#               ends in a known image file extension.  Either the filename alone
#               or the full filepath can be specified
# Usage       : my $isImage = &IT::Image::isImage($imagePathOrFileName);
# ------------------------------------------------------------------------------

sub isImage {
  my $imagePathOrFileName = shift;

  if ($imagePathOrFileName =~ m/\.(gif|jpg|jpeg|png)$/i) {
    return 1;
  }

  return 0;
}

# ------------------------------------------------------------------------------
# Function    : getImageHeightAndWidth
# Description : return the height and width of image
# Usage       : my($height, $width) = &IT::Image::getImageHeightAndWidth($fullPathToImage, $realFileName);
# ------------------------------------------------------------------------------

sub getImageHeightAndWidth {
  my $fullPathToImage = shift || die "no image filepath specified!";
  my $realFileName = shift || $fullPathToImage;   # use this if fullImagePath is a temp file without image extension (eg: temp1234.tmp)

  # error checking
  unless (wantarray)                               { die "getImageHeightAndWidth can only be called in a list context!"; }
  if (&IT::File::isRelativePath($fullPathToImage)) { die "specified image doesn't have an absolute path! '$fullPathToImage'"; }
  unless (-e $fullPathToImage)                     { die "specified image doesn't exist! '$fullPathToImage'"; }
  unless (-f $fullPathToImage)                     { die "specified image isn't a file! '$fullPathToImage'"; }
  unless (&isImage($realFileName))                 { die "specified file doesn't have a recognized image extension! '$fullPathToImage'"; }

  # get height and width
  my($height, $width);
  if    ($realFileName =~ /\.gif$/i)        { ($height, $width) = &_getImageHeightAndWidth_gif($fullPathToImage); }
  elsif ($realFileName =~ /\.(jpg|jpeg)$/i) { ($height, $width) = &_getImageHeightAndWidth_jpeg($fullPathToImage); }
  elsif ($realFileName =~ /\.png$/i)        { ($height, $width) = &_getImageHeightAndWidth_png($fullPathToImage); }
  else { die "unknown image extension on '$fullPathToImage'"; }

  # return values
  return($height, $width);
}

# ------------------------------------------------------------------------------
# Function    : _getImageHeightAndWidth_gif
# Description :
# Usage       :
# ------------------------------------------------------------------------------

sub _getImageHeightAndWidth_gif {
  my ($fullPathToImage) = @_;
  my ($buf, $type, $cmapsize, $mapdata, $x, $w, $y, $h);

  open(GIF, $fullPathToImage) || return(undef, undef, "GIF - Couldn't Open $fullPathToImage");
  binmode(GIF);
  read(GIF, $type, 6);
  read(GIF, $buf, 7);
  if (length($buf) != 7) { close GIF; return(undef, undef, "GIF - Corrupted Header"); }
  ($x) = unpack("x4 C", $buf);
  if ($x & 0x80) {  # found a colour map
    $cmapsize = 3 * (2**(($x & 0x07) + 1));
    read(GIF, $mapdata, $cmapsize);
    if (!$mapdata) { close GIF; return(undef, undef, "GIF - Corrupted Colour Map"); }
  }
  while (1) {  # now walk through the gif
    if (eof(GIF)) { close GIF; return(undef, undef, "GIF - EOF at BlockStart"); }
    read(GIF, $buf, 1);
    ($x) = unpack("C", $buf);
    if ($x == 0x2c) {  # we struck gold!
      read(GIF, $buf, 8);
      if (length($buf) != 8) { close GIF; return(undef, undef, "GIF - Missing Image Header"); }
      ($x, $w, $y, $h) = unpack("x4 C4", $buf);
      close(GIF);
      return($y + $h * 256, $x + $w * 256);
    }
    if ($x == 0x21) {
      read(GIF, $buf, 1);
      ($x) = unpack("C", $buf);
      if      ($x == 0xF9) { read(GIF, $buf, 6); }
        elsif ($x == 0xFE) { &_getImageHeightAndWidth_gif_skipBlock(\*GIF, 0) || return(undef, undef, "GIF - Bad Block - skip=0"); }
        elsif ($x == 0x01) { &_getImageHeightAndWidth_gif_skipBlock(\*GIF, 13) || return(undef, undef, "GIF - Bad Block - skip=13"); }
        elsif ($x == 0xFF) { &_getImageHeightAndWidth_gif_skipBlock(\*GIF, 12) || return(undef, undef, "GIF - Bad Block - skip=12"); }
        else { close GIF; return(undef, undef, "GIF - Unknown Block Extension"); }
    } else { close GIF; return(undef, undef, "GIF - Unknown Block Type"); }
  }
}

# ------------------------------------------------------------------------------
# Function    :
# Description :
# Usage       :
# ------------------------------------------------------------------------------

sub _getImageHeightAndWidth_gif_skipBlock {
  my ($fh, $skip) = @_;
  my ($lbuf);

  read($fh, $lbuf, $skip);
  while (1) {
    if (eof($fh)) { close GIF; return(undef); }
    read($fh, $lbuf, 1);          # get blocksize
    last if ord($lbuf) == 0;      # block terminator
    read($fh, $lbuf, ord($lbuf)); # skip real data
  }
  1;
}

# ------------------------------------------------------------------------------
# Function    :
# Description :
# Usage       :
# ------------------------------------------------------------------------------

sub _getImageHeightAndWidth_jpeg {
  my ($fullPathToImage) = @_;
  my ($buf, $segheader, $marker, $code, $len);

  open(JPEG, $fullPathToImage) || return(undef, undef, "JPEG - Couldn't Open $fullPathToImage");
  binmode(JPEG);
  read(JPEG, $buf, 2);  # skip header
  while (1) {
    read(JPEG, $segheader, 4);
    ($marker, $code, $len) = unpack("a a n", $segheader);
    if ($marker ne "\xFF") { close JPEG; return(undef, undef, "JPEG - Marker not Found"); }
    if ((ord($code) >= 0xC0) && (ord($code) <= 0xC3)) {   # bingo!
      read(JPEG, $buf, 5);
      close(JPEG);
      my($y, $x) = unpack("xnn", $buf);
      return ($y, $x);
    } else {
      read(JPEG, $buf, $len - 2);
    }
  }
}

# ------------------------------------------------------------------------------
# Function    :
# Description :
# Usage       :
# ------------------------------------------------------------------------------

sub _getImageHeightAndWidth_png {
  my ($fullPathToImage) = @_;
  my ($buf);

  open(PNG, $fullPathToImage) || return(undef, undef, "PNG - Couldn't Open $fullPathToImage");
  binmode(PNG);
  seek(PNG, 12, 0);
  read(PNG, $buf, 4);
  if ($buf ne "IHDR") { close PNG; return(undef, undef, "PNG - Missing Image Header - $buf"); }
  read(PNG, $buf, 8);
  close PNG;
  my($width, $height) = unpack("NN", $buf);
  return($height, $width);
}

# ------------------------------------------------------------------------------
# Function    : isResizeImageAvailable
# Description : Check to see if the required modules are available to resize images
# Usage       : &IT::Image::isResizeImageAvailable();
# ------------------------------------------------------------------------------

sub isResizeImageAvailable {
  if    (&IT::Image::isGdAvailable())          { return 1; }
  elsif (&IT::Image::isImageMagickAvailable()) { return 1; }
  return 0;

}

# ------------------------------------------------------------------------------
# Function    : resizeImage
# Description : target image will be overwritten if it already exists
# Usage       : &IT::Image::resizeImage($sourceFilepath, $targetFilePath, $maxTargetHeight, $maxTargetWidth);
# ------------------------------------------------------------------------------

sub resizeImage {
  my($sourceFilepath, $targetFilePath, $maxTargetHeight, $maxTargetWidth) = @_;

  # error checking
  if (!$sourceFilepath)                           { die "source image not specified!"; }
  if (&IT::File::isRelativePath($sourceFilepath)) { die "source image doesn't have an absolute path! '$sourceFilepath'"; }
  unless (-e $sourceFilepath)                     { die "source image doesn't exist! '$sourceFilepath'"; }
  unless (-f $sourceFilepath)                     { die "source image isn't a file! '$sourceFilepath'"; }
  unless (&isImage($sourceFilepath))              { die "source file doesn't have a recognized image extension! '$sourceFilepath'"; }
  if (!$targetFilePath)                           { die "target image not specified!"; }
  if (&IT::File::isRelativePath($targetFilePath)) { die "target image doesn't have an absolute path! '$targetFilePath'"; }
#  if (-e $targetFilePath)                         { die "target image already exists! '$targetFilePath'"; }
  if (-e $targetFilePath)                         { unlink $targetFilePath; }
  unless (&isImage($targetFilePath))              { die "target file doesn't have a recognized image extension! '$targetFilePath'"; }
  if (!$maxTargetHeight && $maxTargetWidth)       { die "Either maxTargetWidth or maxTargetHeight or both must be specified!"; }
  if ($maxTargetHeight ne int $maxTargetHeight)   { die "maxTargetHeight '$maxTargetHeight' isn't an integer!"; }
  if ($maxTargetWidth ne int $maxTargetWidth)     { die "maxTargetWidth '$maxTargetWidth' isn't an integer!"; }

  # get source image height and width
  my($sourceHeight, $sourceWidth) = &getImageHeightAndWidth($sourceFilepath);
  if (!$sourceHeight || !$sourceWidth) { die "source image has a height or width of zero or height and width couldn't be determined! ($sourceHeight, $sourceWidth)"; }

  # calculate new height and width (scaling to fit within target height and width)
  my($targetHeight, $targetWidth) = &calculateThumbnailSize($maxTargetHeight, $maxTargetWidth, $sourceHeight, $sourceWidth);

  # call appropriate function
  # NOTE: ImageMagick uses 4 megs more memory in tests, only use it if GD isn't available
  if    (&isGdAvailable())          { &_resizeImage_gd($sourceFilepath, $targetFilePath, $targetHeight, $targetWidth); }
  elsif (&isImageMagickAvailable()) { &_resizeImage_imageMagick($sourceFilepath, $targetFilePath, $targetHeight, $targetWidth); }
  else { die "Couldn't find a supported version of GD or ImageMagick!"; }

}

# ------------------------------------------------------------------------------
# Function    : isGdAvailable
# Description :
# Usage       : my $isAvailable              = &IT::Image::isGdAvailable()
# ------------------------------------------------------------------------------

sub isGdAvailable {

  # load module
  eval { require GD; }; # require only loads modules once
  if ($@) { $GD_EVAL_ERROR = $@; }

  # return current and previous errors
  if ($GD_EVAL_ERROR) { return 0; }

  # check version
  if (sprintf("%f", $GD::VERSION) < $MINIMUM_GD_VERSION) {
    return 0;
  }

  return 1;

}

# ------------------------------------------------------------------------------
# Function    : isImageMagickAvailable
# Description :
# Usage       : my $isAvailable              = &IT::Image::isImageMagickAvailable()
# ------------------------------------------------------------------------------

sub isImageMagickAvailable {

  # load module
  eval { require Image::Magick; };  # require only loads modules once
  if ($@) { $IM_EVAL_ERROR = $@; }

  # return current and  previous errors
  if ($IM_EVAL_ERROR) { return 0; }

  # check version
  if (sprintf("%f", $Image::Magick::VERSION) < $MINIMUM_IMAGE_MAGICK_VERSION) {
    return 0;
  }

  return 1;

}

# ------------------------------------------------------------------------------
# Function    : calculateNewImageSize
# Description :
# Usage       : my($newHeight, $newWidth) = &IT::Image::calculateThumbnailSize($maxHeight, $maxWidth, $height, $width);
# ------------------------------------------------------------------------------

sub calculateThumbnailSize {
  my $maxHeight    = shift;
  my $maxWidth     = shift;
  my $sourceHeight = shift;
  my $sourceWidth  = shift;

  my $widthScale   = $maxWidth / $sourceWidth;
  my $heightScale  = $maxHeight / $sourceHeight;
  my $scaleFactor  = &IT::Common::mathMin($widthScale, $heightScale, 1); # don't scale above 1:1
  my $targetHeight = int(($sourceHeight * $scaleFactor) + 0.5); # round up: int(x + 0.5)
  my $targetWidth  = int(($sourceWidth * $scaleFactor) + 0.5); # round up: int(x + 0.5)

  return($targetHeight, $targetWidth);
}

# ------------------------------------------------------------------------------
# Function    : _resizeImage_gd
# Description :
# Usage       : &_resizeImage_gd($sourceFilepath, $targetFilePath, $targetHeight, $targetWidth);
# ------------------------------------------------------------------------------

sub _resizeImage_gd {
  my($sourceFilepath, $targetFilePath, $targetHeight, $targetWidth) = @_;

  # load image modules
  eval { require GD; };

  # set truecolor (for jpgs)
  GD::Image->trueColor(1);

  # load file
  my $sourceImageObj;
  if    ($sourceFilepath =~ m/\.(jpg|jpeg)$/i) { $sourceImageObj = GD::Image->newFromJpeg($sourceFilepath); }
  elsif ($sourceFilepath =~ m/\.gif$/i)        { $sourceImageObj = GD::Image->newFromGif($sourceFilepath); }
  elsif ($sourceFilepath =~ m/\.png$/i)        { $sourceImageObj = GD::Image->newFromPng($sourceFilepath); }
  else { die "_resizeImage_gd: unknown image extension in '$sourceFilepath'"; }
  if (!$sourceImageObj) { die "_resizeImage_gd: can't read filename: $!"; }

  # resize image
  my($sourceWidth, $sourceHeight) = $sourceImageObj->getBounds();
  my($dstX, $dstY, $srcX, $srcY)  = (0,0,0,0);
  my $targetImageObject           = GD::Image->new($targetWidth, $targetHeight);
  $targetImageObject->copyResampled($sourceImageObj, $dstX, $dstY, $srcX, $srcY, $targetWidth, $targetHeight, $sourceWidth, $sourceHeight);

  # get image data
  my $imageData;
  if    ($targetFilePath =~ m/\.(jpg|jpeg)$/i) { $imageData = $targetImageObject->jpeg(80); } # attribute value is quality or compression level (0-100) 100 is best
  elsif ($targetFilePath =~ m/\.gif$/i)        { $imageData = $targetImageObject->gif(); }
  elsif ($targetFilePath =~ m/\.png$/i)        { $imageData = $targetImageObject->png(2); }   # attribute value is quality or compression level (0-9) 0 is best

  # save image
  &IT::FileLock::getLock('exclusive');
  &IT::File::writeFile($targetFilePath, $imageData) || die "Unable to write resized image file ($targetFilePath): $!";
  &IT::FileLock::releaseLock();
}

# ------------------------------------------------------------------------------
# Function    : _resizeImage_imageMagick
# Description :
# Usage       : &_resizeImage_imageMagick($sourceFilepath, $targetFilePath, $targetHeight, $targetWidth);
# ------------------------------------------------------------------------------

sub _resizeImage_imageMagick {
  my($sourceFilepath, $targetFilePath, $targetHeight, $targetWidth) = @_;

  # load image modules
  eval { require Image::Magick; };

  # load file
  my $sourceImageObj = Image::Magick->new;
  my $msg = $sourceImageObj->Read($sourceFilepath);
  if ($msg =~ /^Error/i) { die "can't read '$sourceFilepath': $msg"; }

  # resize image
  my($sourceWidth, $sourceHeight) = $sourceImageObj->Get('width','height');
  my $targetImageObj = $sourceImageObj;

  $msg = $targetImageObj->Resize( width => $targetWidth, height => $targetHeight );
  if ($msg) { die "can't resize image: $msg\n"; }

  # save image
  $msg = $targetImageObj->Write($targetFilePath);
  if ($msg) { die "can't write image: $msg\n"; }

}

# ----------------------------------------------------------------------------
# end of file
1;

