File Coverage

blib/lib/File/Properties.pm

Criterion	Covered	Total	%
statement	7	9	77.7
branch			n/a
condition			n/a
subroutine	3	3	100.0
pod			n/a
total	10	12	83.3

# ----------------------------------------------------------------------------
#
# This module provides cached access to file SHA-2 digests and mime
# types. Additional information is available for bzip2 and gzip
# compressed files, and digital media files, particularly digital
# images.
#
# Copyright © 2010,2011 Brendt Wohlberg
# See distribution LICENSE file for license details.
#
# Most recent modification: 22 December 2011
#
# ----------------------------------------------------------------------------

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

use File::Properties::Cache;
use File::Properties::Media;
use File::Properties::Image;
use base qw(File::Properties::Media);

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


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

  $self->SUPER::_init($path, $fpcr);
  $self->_image(File::Properties::Image->new($self, $fpcr))
    if ($self->isimage);
}


# ----------------------------------------------------------------------------
# Get digest string of image file content
# ----------------------------------------------------------------------------
sub idigest {
  my $self = shift;

  return $self->isimage?$self->_image->idigest:undef;
}


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

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


# ----------------------------------------------------------------------------
# Determine whether file properties represent an image file
# ----------------------------------------------------------------------------
sub isimage {
  my $self = shift;

  return (defined $self->mediatype and $self->mediatype eq 'image');
}


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

  $levl = 0 if (!defined $levl);
  my $lpfx = ' ' x (2*$levl);
  my $s = $self->SUPER::string($levl);
  $s .=  $self->_image->string($levl) if ($self->isimage);
  return $s;
}

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

  my $mkey = (@_)?shift:undef;
  if (defined $mkey) {
    if ($mkey eq $File::Properties::Image::CacheTableName) {
      return $self->_image->_fromcache;
    } else {
      return $self->_fromcache($mkey);
    }
  } else {
    return (not $self->isimage or $self->_image->_fromcache) and
           (not $self->isreg or $self->_fromcache(
		       $File::Properties::Regular::CacheTableName)) and
	   (not $self->iscompressed or $self->_fromcache(
		       $File::Properties::Compressed::CacheTableName)) and
	   (not $self->ismedia or $self->_fromcache(
		       $File::Properties::Media::CacheTableName));
  }
}


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

  $self->SUPER::_cacheinit($fpcr, $opts);
  File::Properties::Image::_cacheinit($fpcr);
}


# ----------------------------------------------------------------------------
# Remove all cache data older (based on insertion date) than the
# specified number of days
# ----------------------------------------------------------------------------
sub _cacheexpire {
  my $self = shift;
  my $fpcr = shift; # File::Properties::Cache reference
  my $nday = shift; # Expiry age in number of days

  $fpcr->expire($File::Properties::Regular::CacheTableName, $nday);
  File::Properties::Compressed->_cacheclean($fpcr);
  File::Properties::Media->_cacheclean($fpcr);
  File::Properties::Image::->_cacheclean($fpcr);
}


# ----------------------------------------------------------------------------
# Remove all cache data for which the corresponding files can no
# longer be found on disk
# ----------------------------------------------------------------------------
sub _cacheclean {
  my $self = shift;
  my $fpcr = shift; # File::Properties::Cache reference

  if (File::Properties::Regular->_cacheclean($fpcr)) {
    File::Properties::Compressed->_cacheclean($fpcr);
    File::Properties::Media->_cacheclean($fpcr);
    File::Properties::Image::->_cacheclean($fpcr);
  }
}


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


1;
__END__