File Coverage

blib/lib/Image/Select.pm

Criterion	Covered	Total	%
statement	47	89	52.8
branch	7	30	23.3
condition	2	6	33.3
subroutine	11	14	78.5
pod	4	4	100.0
total	71	143	49.6

package Image::Select;

# Pragmas.
use strict;
use warnings;

# Modules.
use Class::Utils qw(set_params);
use Error::Pure qw(err);
use File::Basename qw(fileparse);
use File::Find::Rule qw(:MMagic);
use Imager;
use List::MoreUtils qw(none);

# Version.
our $VERSION = 0.04;

# Constructor.
sub new {
	my ($class, @params) = @_;

	# Create object.
	my $self = bless {}, $class;

	# Debug.
	$self->{'debug'} = 0;

	# Loop.
	$self->{'loop'} = 0;

	# Path to images.
	$self->{'path_to_images'} = undef;

	# Image type.
	$self->{'type'} = 'bmp';

	# Sizes.
	$self->{'height'} = 1080;
	$self->{'width'} = 1920;

	# Process params.
	set_params($self, @params);

	# Check type.
	if (defined $self->{'type'}) {
		$self->_check_type($self->{'type'});
	}

	# Check path to images.
	if (! defined $self->{'path_to_images'}
		|| ! -d $self->{'path_to_images'}) {

		err "Parameter 'path_to_images' is required.";
	}

	# Load images.
	$self->{'_images_to_select'} = [
		sort File::Find::Rule->file->magic(
			'image/bmp',
			'image/gif',
			'image/jpeg',
			'image/png',
			'image/tiff',
			'image/x-ms-bmp',
			'image/x-portable-pixmap',
			# XXX tga?
			# XXX raw?
			# XXX sgi?
		)->in($self->{'path_to_images'}),
	];
	if (! @{$self->{'_images_to_select'}}) {
		err 'No images.';
	}
	$self->{'_images_index'} = 0;

	# Object.
	return $self;
}

# Create image.
sub create {
	my ($self, $path) = @_;

	# Load next image.
	my $i = Imager->new;
	if ($self->{'_images_index'} > $#{$self->{'_images_to_select'}}) {
		if ($self->{'loop'}) {
			$self->{'_images_index'} = 0;
		} else {
			return;
		}
	}
	my $file = $self->{'_images_to_select'}->[$self->{'_images_index'}];
	if (! -r $file) {
		err "No file '$file'.";
	}
	my $ret = $i->read('file' => $file);
	if (! $ret) {
		err "Cannot read file '$file'.",
			'Error', Imager->errstr;
	}
	$self->{'_images_index'}++;

	# Get type.
	my $suffix;
	if (! defined $self->{'type'}) {

		# Get suffix.
		(my $name, undef, $suffix) = fileparse($path, qr/\.[^.]*/ms);
		$suffix =~ s/^\.//ms;

		# Jpeg.
		if ($suffix eq 'jpg') {
			$suffix = 'jpeg';
		}

		# Check type.
		$self->_check_type($suffix);
	} else {
		$suffix = $self->{'type'};
	}

	# Scale.
	my $new_i = $i->scale(
		'xpixels' => $self->{'width'},
		'ypixels' => $self->{'height'},
	);
	if (! $new_i) {
		err "Cannot resize image from file '$file'.",
			'Error', Imager->errstr;
	}

	# Save.
	if ($self->{'debug'}) {
		print "Path: $path\n";
	}
	$ret = $new_i->write(
		'file' => $path,
		'type' => $suffix,
	);
	if (! $ret) {
		err "Cannot write file to '$path'.",
			'Error', Imager->errstr;
	}

	return $suffix;
}

# Set/Get image sizes.
sub sizes {
	my ($self, $width, $height) = @_;
	if ($width && $height) {
		$self->{'width'} = $width;
		$self->{'height'} = $height;
	}
	return ($self->{'width'}, $self->{'height'});
}

# Set/Get image type.
sub type {
	my ($self, $type) = @_;
	if ($type) {
		$self->_check_type($type);
		$self->{'type'} = $type;
	}
	return $self->{'type'};
}

# Check supported image type.
sub _check_type {
	my ($self, $type) = @_;

	# Check type.
	if (none { $type eq $_ } ('bmp', 'gif', 'jpeg', 'png',
		'pnm', 'raw', 'sgi', 'tga', 'tiff')) {

		err "Image type '$type' doesn't supported.";
	}

	return;
}

1;

__END__