File Coverage

blib/lib/Image/Compare.pm

Criterion	Covered	Total	%
statement	65	98	66.3
branch	20	42	47.6
condition	1	6	16.6
subroutine	14	17	82.3
pod	10	10	100.0
total	110	173	63.5

# Image::Compare, a module based on the great Imager, used to determine if
# two images differ greatly from one another.

package Image::Compare;

use strict;
use warnings;

use Imager;

# This is the base class for all comparators, and will also do the work of
# loading all supplied implementations.
use Image::Compare::Comparator;

our %class_map;

my $loaded_lwp;

BEGIN {
	$loaded_lwp = 0;
	eval "require LWP;";
	unless ($@) { $loaded_lwp = 1; }
}

our $VERSION = "1.01";

# If people don't want to deal with OO, we export the main "work" method
# so they can call it in a simpler way.  We'll see below where we handle this.
use base qw/Exporter/;
our @EXPORT_OK = qw/compare/;

##   Public methods begin here

# The constructor method.
# Takes a hash of arguments:  (all are optional)
#   image1 =>
#     Data representing the first image, either as an Imager object, file
#     name or a URL.
#   type1  => Type of image provided.
#   image2 => Like image1.
#   type2  => Like type1.
#   method =>
#     Either the numeric constant representing the comparator, or an
#     instance of a comparator.
#   args  => Arguments to pass to the comparator.
# See the documentation on the relevant option setters for more details
sub new {
	my $proto = shift;
	my %args = @_;
	my $class = ref($proto) || $proto;  # Bite me, Randal.
	my $self = {};
	bless($self, $class);
	# These are default values
	if ($args{image1}) {
		$self->set_image1(
			img  => $args{image1},
			type => $args{type1}
		);
	}
	if ($args{image2}) {
		$self->set_image2(
			img  => $args{image2},
			type => $args{type2}
		);
	}
	if ($args{method}) {
		$self->set_method(
			method => $args{method},
			args => $args{args}
		);
	}
	if ($args{mask}) {
		$self->set_mask(mask => $args{mask});
	}
	return $self;
}

# The next two just use the input to fetch image data and store it as an
# Imager object.  Currently supported image types:
#   Imager object
#   File name
#   URL
sub set_image1 {
	my $self = shift;
	my %args = @_;
	$self->{_IMG1} = _get_image($args{img}, $args{type});
}

sub set_image2 {
	my $self = shift;
	my %args = @_;
	$self->{_IMG2} = _get_image($args{img}, $args{type});
}

# Get back the Imager objects created by the preceding two methods.
sub get_image1 {
	my $self = shift;
	return $self->{_IMG1};
}
sub get_image2 {
	my $self = shift;
	return $self->{_IMG2};
}

# How to set the matching mask parameter for this compaison instance.
sub set_mask {
	my $self = shift;
	my %args = @_;
	$self->{_MASK} = $args{mask};
}
sub get_mask {
	my $self = shift;
	return $self->{_MASK};
}

# Given input as defined above, returns an Imager object representing the
# image.
sub _get_image {
	my($img, $type) = @_;
	unless ($img) {
		die "Missing 'img' parameter";
	}

	# If we've been given an Imager object, we need only store it.
	if (ref($img)) {
		if ($img->isa('Imager')) {
			return $img;
		}
		# If it wasn't an Imager, but it's still some kind of reference, then
		# we have to give up.
		die "Unrecognized input type: '" . ref($img) . "'";
	}

	# Otherwse, we need to construct an Imager object, and to do that, we
	# need to build up an arguments hash for the Imager constructor.
	my %args;
	if ($type) {
		# Provide the type argument to image, if it was provided.
		$args{type} = $type;
	}
	# This is the base error message.
	my $errmsg = "Unable to read image data from ";
	# If $img looks like a URL, and if we were able to load LWP, then we might
	# be able to fetch an image via a URL.
	if ($loaded_lwp && ($img =~ /^https?:\/\//)) {
		$errmsg .= "URL '$img'";
		my $ua = LWP::UserAgent->new();
		$ua->agent("Image::Compare/v$VERSION ");
		my $res = $ua->request(HTTP::Request->new(GET => $img));
		$args{data} = $res->content();
		if (!$type) {
			$args{type} = $res->content_type();
			$args{type} =~ s!^image/!!;
		}
	}
	else {
		# Otherwise, we have to think it's a file path.
		$errmsg .= "file '$img'";
		$args{file} = $img;
	}
	my $newimg = Imager->new();
	$newimg->read(%args) || die($errmsg . ": '" . $newimg->{ERRSTR} . "'");
	return $newimg;
}

# Sets the comparison method.  Either takes the numeric constant that
# identifies the method and any arguments needed by the method, or an instance
# of the comparator.  See the documentation for Image::Compare::Comparator or
# it subclasses for more details.
sub set_method {
	my $self = shift;
	my %args = @_;
	unless ($args{method}) {
		die "Missing required argument 'method'";
	}
	if (ref($args{method})) {
		if ($args{method}->isa('Image::Compare::Comparator')) {
			$self->{_CMP} = $args{method};
		}
		else {
			die (
				"Unrecognized type for 'method' argument: '" .
				ref($args{method}) . "'"
			);
		}
	}
	else {
		unless ($class_map{$args{method}}) {
			die "Unrecognized method identifier: '$args{method}'";
		}
		$self->{_CMP} = $class_map{$args{method}}->new($args{args});
	}
}

# Returns information describing the comparison method set into this instance
# of an Image::Compare.
sub get_method {
	my $self = shift;
	unless ($self->{_CMP}) {
		return wantarray ? () : undef;
	}
	return $self->{_CMP}->get_representation();
}

# Compares two images and returns a result.
sub compare {
	my $self;
	# This can be called as an instance method
	if (ref($_[0]) eq 'Image::Compare') {
		$self = shift;
	}
	else {
		# Or, as a class method, if you swing that way...
		if ($_[0] eq 'Image::Compare') {
			shift;
		}
		# Or just as a plain method.  In either case, we just need to construct
		# a $self so we can get on with life.
		$self = Image::Compare->new(@_);
	}
	# Sanity checking
	for my $ref (
		['IMG1', 'Image 1'], ['IMG2', 'Image 2'], ['CMP', 'Comparison method'],
	) {
		die "$ref->[1] not specified" unless $self->{"_$ref->[0]"};
	}

	# Give the images to the comparator and let them compare them.
	# The comparator will raise an exception if anything's wrong.
	return $self->{_CMP}->compare_images(
		@{$self}{qw/_IMG1 _IMG2 _MASK/}
	);
}

1;

__END__