File Coverage

blib/lib/Image/Compare/Comparator.pm

Criterion	Covered	Total	%
statement	70	85	82.3
branch	12	18	66.6
condition	9	27	33.3
subroutine	15	19	78.9
pod	9	9	100.0
total	115	158	72.7

package Image::Compare::Comparator;

use warnings;
use strict;

sub new {
	my $proto = shift;
	my $class = ref($proto) || $proto;
	my $self = {};
	$self->{args} = shift;
	$self->{mask} = shift;
	bless($self, $class);
	return $self;
}

# This will do initial setup and throw an exception if there is something
# wrong.  We have some common behavior in here.  Subclasses may override this,
# or add to it.
sub setup {
	my $self = shift;
	my ($img1, $img2, $mask) = @_;
	unless (
		($img1->getwidth()  == $img2->getwidth() ) &&
		($img1->getheight() == $img2->getheight())
	) {
		die "Images must be the same size!";
	}
	if ($mask) {
		unless(ref($mask) && $mask->isa('Imager')) {
			die "Match mask must be an Imager image object!";
		}
		unless (
			($mask->getchannels() == 1) &&
			($mask->bits()     == 8)
		) {
			die "Match mask image must have one channel and 8 bits per channel!";
		}
		unless (
			($mask->getwidth()  == $img1->getwidth() ) &&
			($mask->getheight() == $img1->getheight())
		) {
			die "Match mask must be the same size as the test images!";
		}
	}
}

sub get_args {
	my $self = shift;
	return $self->{args};
}

# By default, just return the class name and the arguments.
sub get_representation {
	my $self = shift;
	return (
		method => $Image::Compare::reverse_class_map{ref($self)},
		args => $self->{args},
	);
}

sub compare_images {
	my $self = shift;
	my ($img1, $img2, $mask) = @_;
	# This will die if there's a problem.
	$self->setup($img1, $img2, $mask);
	# We spin over each pixel in img1.
	my $wid = $img1->getwidth();
	my $hig = $img1->getheight();
	OUTER: for my $x (0 .. $wid - 1) {
		for my $y (0 .. $hig - 1) {
			# If we've been given a match mask, then we skip any pixel whose
			# corresponding pixel in that mask is pure black.
			# This is the entirety of the comparison logic surrounding masks.  It is
			# all so simple, I should have done it long ago.
			if ($mask && (($mask->getpixel(x => $x, y => $y)->rgba())[0] == 255)) {
				next;
			}
			my @pix1 = $img1->getpixel(x => $x, y => $y)->rgba();
			my @pix2 = $self->get_second_pixel($img2, $x, $y)->rgba();
			# If this returns undef, then we keep going.  Otherwise, we stop.
			# It will die if there's an error.
			# This mechanism allows the subclass to short-circuit image examination
			# if it feels the need to do so.
			last OUTER if defined $self->accumulate(\@pix1, \@pix2, $x, $y);
		}
	}
	# And finally, the subclass will return the thing it wants to return.
	return $self->get_result();
}

# By default, this is pretty boring.
# Subclasses may want to override it though.
# On second thought, I can't think of a reason why they would want to.
# I guess I will leave this in anyways.
sub get_second_pixel {
	my $self = shift;
	my ($img2, $x, $y) = @_;
	return $img2->getpixel(x => $x, y => $y);
}

# Some day we might have multiple ways to do this.
sub color_distance {
	my $self = shift;
	my ($pix1, $pix2) = @_;
	# The sum of the squaws of the other two hides...
	return sqrt(
		( ($pix1->[0] - $pix2->[0]) ** 2 ) +
		( ($pix1->[1] - $pix2->[1]) ** 2 ) +
		( ($pix1->[2] - $pix2->[2]) ** 2 )
	);
}

sub accumulate {
	my $self = shift;
	my $class = ref($self) || $self;
	die "Subclass '$class' must implement accumulate()!";
}

sub get_result {
	my $self = shift;
	my $class = ref($self) || $self;
	die "Subclass '$class' must implement get_result()!";
}

sub import {
	my $cmp_pkg = shift;
	my %args = @_;
	unless (UNIVERSAL::isa($cmp_pkg, __PACKAGE__)) {
		die "Comparaters must subclass __PACKAGE__!";
	}
	my $name = $cmp_pkg;
	unless (
		($name =~ s/^Image::Compare:://) ||
		($name = $args{name})
	) {
		die (
			"Comparator must either be in the Image::Compare namespace, " .
			"or you must provide a method name to import."
		);
	}
	{
		no strict qw/refs/;
		# We are essentially "exporting" this for backwards compatibility.  We
		# don't really want to use constants like this any more, but we have
		# to.  Shucks.
		my $name_const = $name;
		*{"Image::Compare::$name"} = sub () { $name_const };
		$Image::Compare::class_map{$name} = $cmp_pkg;
		$Image::Compare::reverse_class_map{$cmp_pkg} = $name;
	}
}

# We will read in the list of packages to load from the documentation.
while () {
	if (/^=item \* L<([^>]+)>/) {
		eval "use $1";
		die "Failed loading module '$1': $@" if $@;
	}
}

close Image::Compare::Comparator::DATA;

1;

__DATA__