File Coverage

blib/lib/File/Properties/Image.pm

Criterion	Covered	Total	%
statement	16	18	88.8
branch			n/a
condition			n/a
subroutine	6	6	100.0
pod			n/a
total	22	24	91.6

# ----------------------------------------------------------------------------
#
# This module supports computing and caching of image file properties.
#
# Copyright © 2010,2011 Brendt Wohlberg
# See distribution LICENSE file for license details.
#
# Most recent modification: 18 December 2011
#
# ----------------------------------------------------------------------------

package File::Properties::Image;
our $VERSION = 0.02;

use File::Properties::Error;
use File::Properties::Media;

require 5.005;
use strict;
use warnings;
use Error qw(:try);
use Image::Magick;


our $DCRawBin = 'dcraw'; # DCRaw utility binary
our $RawBufferSize = 1048576; # Buffer size for use in raw image handling
our $CacheTableName = 'ImageFileCache';
our $CacheTableCols = ['ContentDigest TEXT','ImageDigest TEXT'];


# ----------------------------------------------------------------------------
# Constructor
# ----------------------------------------------------------------------------
sub new {
  my $clss = shift;

  my $self = {};
  bless $self, $clss;
  $self->_init(@_);
  return $self;
}


# ----------------------------------------------------------------------------
# Initialiser
# ----------------------------------------------------------------------------
sub _init {
  my $self = shift;
  my $fpmr = shift; # File::Properties::Media reference
  my $fpcr = shift; # File::Properties::Cache reference

  # Ensure that a File::Properties::Media reference is specified
  throw File::Properties::Error("Init value is not defined")
    if not defined $fpmr;
  ## If File::Properties::Cache reference specified and the cache
  ## contains an entry with a matching digest value, set the image
  ## digest from the cache entry; otherwise the image digest must be
  ## computed.
  if (defined $fpcr and
      my $cent = $fpcr->cretrieve($CacheTableName,
				  {'ContentDigest' => $fpmr->cdigest})) {
    $self->idigest($cent->{'ImageDigest'});
    # Set flag indicating that this entry was obtained from the cache
    $self->_fromcache(1);
  } else {
    # Get a file handle to the file, or to uncompressed content if it
    # is compressed
    my $fcfh = $fpmr->cfilehandle; ## NB: requires attention
    # Image digest computation is handled differently for raw images
    my $idgs = ($fpmr->mmimetype eq 'image/x-raw')?
      _rawimagedigest($fcfh):_imagedigest($fcfh);
    # Record the computed image digest
    $self->idigest($idgs);
    # Set flag indicating that this entry was not obtained from the cache
    $self->_fromcache(0);
    ## If a File::Properties::Cache reference is specified, record the
    ## image digest entry in the cache
    if (defined $fpcr) {
      my $row = {'ContentDigest' => $fpmr->cdigest, 'ImageDigest' => $idgs};
      $fpcr->cinsert($CacheTableName, $row);
    }
  }
}


# ----------------------------------------------------------------------------
# Get (or set) image digest
# ----------------------------------------------------------------------------
sub idigest {
  my $self = shift;

  $self->{'idgs'} = shift if (@_);
  return $self->{'idgs'};
}


# ----------------------------------------------------------------------------
# Construct string representing properties hash
# ----------------------------------------------------------------------------
sub string {
  my $self = shift;
  my $levl = shift;

  $levl = 0 if (!defined $levl);
  my $lpfx = ' ' x (2*$levl);
  return  $lpfx . "   Image Digest: ".substr($self->idigest,0,40)."...\n";
}


# ----------------------------------------------------------------------------
# Initialise cache table for File::Properties::Image data
# ----------------------------------------------------------------------------
sub _cacheinit {
  my $fpcr = shift; # File::Properties::Cache reference

  $fpcr->define($CacheTableName, $CacheTableCols,
	       {'TableVersion' => [__PACKAGE__.'::Version', $VERSION]});
}


# ----------------------------------------------------------------------------
# Clear invalid entries in cache table for File::Properties::Image data
# ----------------------------------------------------------------------------
sub _cacheclean {
  my $self = shift;
  my $fpcr = shift; # File::Properties::Cache reference

  my $itbl = $CacheTableName;
  my $mtbl = $File::Properties::Media::CacheTableName;
  # Remove any entries in the File::Properties::Image cache table
  # for which there is not a corresponding entry with the same content
  # digest in the File::Properties::Media cache table
  $fpcr->remove($itbl, {'Where' => "NOT EXISTS (SELECT * FROM $mtbl " .
		               "WHERE ContentDigest = $itbl.ContentDigest)"});
}


# ----------------------------------------------------------------------------
# Get or set flag indicating whether data was retrieved from the cache
# ----------------------------------------------------------------------------
sub _fromcache {
  my $self = shift;

  $self->{'rfcf'} = shift if (@_);
  return $self->{'rfcf'};
}


# ----------------------------------------------------------------------------
# Compute digest of image file image data
# ----------------------------------------------------------------------------
sub _imagedigest {
  my $fhnd = shift; # File handle

  # Ensure that $fhnd is an IO::Handle object
  throw File::Properties::Error("Argument is not an IO::Handle",$fhnd)
    if (not defined $fhnd or not $fhnd->isa('IO::Handle'));
  # Ensure that file handle position is at the start of the file
  _seek0($fhnd) or
    throw File::Properties::Error("Seek on file handle failed",$fhnd);
  ## Initialise Image::Magick object, read in image pointed to by
  ## $fhnd, and check for errors
  my $imgk = Image::Magick->new;
  my $err = $imgk->Read(file=>$fhnd);
  throw File::Properties::Error("ImageMagick error: $err") if 0+$err < 1;
  ## Construct temporary file and write image data to it
  my $tmp = File::Temp->new;
  $err = $imgk->Write(file=>$tmp,filename=>"rgb:");
  # Return file handle position to start of file
  _seek0($tmp) or
    throw File::Properties::Error("Seek on file handle failed",$tmp);
  ## Compute SHA-512 digest on file containing image data
  my $sha = Digest::SHA->new(512);
  $sha->addfile($tmp, 'b');
  return $sha->hexdigest;
}


# ----------------------------------------------------------------------------
# Compute digest of raw image file image data
# ----------------------------------------------------------------------------
sub _rawimagedigest {
  my $fhnd = shift; # File handle

  # Ensure that $fhnd is an IO::Handle object
  throw File::Properties::Error("Argument is not an IO::Handle",$fhnd)
    if (not defined $fhnd or not $fhnd->isa('IO::Handle'));
  # Ensure that file handle position is at the start of the file
  _seek0($fhnd) or
    throw File::Properties::Error("Seek on file handle failed",$fhnd);
  ## Construct a temporary file and write the content of the file
  ## pointed to by $fhnd into it (the name of the file associated with
  ## the file handle is not necessarily known, but the DCRaw interface
  ## requires a filename).
  my $tmp = File::Temp->new;
  my ($rsz,$buf);
  while ($rsz = $fhnd->read($buf, $RawBufferSize)) {
    $tmp->write($buf, $rsz);
  }
  ## Apply DCRaw to the temporary file and receive the output via a pipe
  my $cmd = "$DCRawBin -D -c " . $tmp->filename . "  |";
  my $pipe = IO::File->new($cmd);
  throw File::Properties::Error("Failed to open pipe from dcraw",
				{'cmd' => $cmd})
    if not defined $pipe;
  # Compute the image digest for the pipe file handle
  return _imagedigest($pipe);
}


# ----------------------------------------------------------------------------
# Ensure file handle position is at start of file
# ----------------------------------------------------------------------------
sub _seek0 {
  my $fhnd = shift; # IO::Handle reference

  return ($fhnd->tell > 0)?$fhnd->seek(0,0):1;
}


# ----------------------------------------------------------------------------
# End of method definitions
# ----------------------------------------------------------------------------


1;
__END__