view release on metacpan or  search on metacpan

lib/Image/Hash.pm  view on Meta::CPAN

package Image::Hash;

use strict;
use warnings;

use List::Util qw(sum);
use Carp;

our $VERSION = '0.06';


=head1 NAME

Image::Hash - Perceptual image hashing [aHash, dHash, pHash].

=head1 SYNOPSIS

  use Image::Hash;
  use File::Slurp;
  
  # Read a image from the command line
  my $image = read_file( shift @ARGV, binmode => ':raw' ) ;

  my $ihash = Image::Hash->new($image);

  # Calculate the average hash
  my $a = $ihash->ahash();

  # Calculate the difference hash
  my $b = $ihash->dhash();

  # Calculate the perception hash
  my $p = $ihash->phash();

  print "$a\n$b\n$p\n";



=head1 DESCRIPTION

Image::Hash allows you to calculate the average hash, difference hash and perception hash an image.

Depending on what is available on your system Image::Hash will use GD, Image::Magick or Imager to interact with your image.



=head1 CONSTRUCTOR METHODS

  my $ihash = Image::Hash->new($image [, $module ]);
  
The first argument is a scalar with a binary representation of an image.

You may also optionally specify a second argument of "GD", "ImageMagick" or "Imager" to force Image::Hash to use the specific image module when it interacts with the image.
The different image modules may give direct hashes for the same image. Using GD normally hives the best results, and are is highly recommended.


=cut

sub new {
	my $class = shift;


	my $self = {};  
	bless( $self, $class );
	
	$self->{'image'} = shift;
	$self->{'module'} = shift;
	
	if ($self->{'module'}) {
		# Try to load the image handler the user asked for
		if ($self->{'module'} eq "GD") {
			require GD;
		}
		elsif ($self->{'module'} eq "ImageMagick" || $self->{'module'} eq "Image::Magick") {
			require Image::Magick;
			$self->{'module'} = 'ImageMagick';
		}
		elsif ($self->{'module'} eq "Imager") {
			require Imager;
		}
		else {
			croak("Unknown mudule: '" . $self->{'module'} . "'. Please use either GD, ImageMagick or Imager as module.");
		}
	}
	else {
		# Try to load GD, ImageMagic or Imager
		if (eval 'require GD') {
			$self->{'module'} = "GD";
		}
		elsif (eval 'require Image::Magick') {
			$self->{'module'} = "ImageMagick";
		}
		elsif (eval 'require Imager') {
			$self->{'module'} = "Imager";
		}
		else {
			croak("No image maudule avalibal. Can't load  GD, ImageMagic or Imager.");
		}
	}
	
	

	
	if ($self->{'module'} eq 'GD') {
		$self->{'im'} = GD::Image->new( $self->{'image'} );
		if (not defined $self->{'im'}) {
			carp("Can't make image from this value");
			return undef;
		}
		$self->{'reduse'} = \&reduse_GD;
		$self->{'pixels'} = \&pixels_GD;
		$self->{'blob'}   = \&blob_GD;
	}
	elsif ($self->{'module'} eq 'ImageMagick') {
		$self->{'im'} = Image::Magick->new();
		my $ret = $self->{'im'}->BlobToImage( $self->{'image'} );
		if ($ret == 0) {
			carp("Can't make image from this value");
			return undef;
		}
		$self->{'reduse'} = \&reduse_ImageMagick;
		$self->{'pixels'} = \&pixels_ImageMagick;
		$self->{'blob'}   = \&blob_ImageMagick;

	}
	elsif ($self->{'module'} eq 'Imager') {
		$self->{'im'} = Imager->new(data=>$self->{'image'});
		if (not defined $self->{'im'}) {
			carp("Can't make image from this value: " . Imager->errstr());
			return undef;
		}
		$self->{'reduse'} = \&reduse_Imager;
		$self->{'pixels'} = \&pixels_Imager;
		$self->{'blob'}   = \&blob_Imager;
	}
	


	return $self;
}


# Helper function:
# Convert from binary to hexadecimal
#
# Borrowed from http://www.perlmonks.org/index.pl?node_id=644225
sub b2h {
    my $num   = shift;
    my $WIDTH = 4;
    my $index = length($num) - $WIDTH;
    my $hex = '';
    do {
        my $width = $WIDTH;
        if ($index < 0) {
            $width += $index;
            $index = 0;
        }
        my $cut_string = substr($num, $index, $width);
        $hex = sprintf('%X', oct("0b$cut_string")) . $hex;
        $index -= $WIDTH;
    } while ($index > (-1 * $WIDTH));
    return $hex;
}

# Reduse the size of an image using GD
sub reduse_GD {
	my ($self, %opt) = @_;
	$self->{ $opt{'im'} } = $self->{'im'};

	my ($xs, $ys) = split(/x/, $opt{'geometry'});

	my $dest = GD::Image->new($xs, $ys);

	$dest->copyResampled($self->{ $opt{'im'} },
		0, 0, 		# (destX, destY)
		0, 0, 		# (srcX,  srxY )
		$xs, $ys, 	# (destX, destY)
		$self->{ $opt{'im'} }->width, $self->{ $opt{'im'} }->height
	);
	$self->{ $opt{'im'} } = $dest;
}

# Reduse the size of an image using Image::Magick
sub reduse_ImageMagick {
	my ($self, %opt) = @_;
	$self->{ $opt{'im'} } = $self->{'im'};

    $self->{ $opt{'im'} }->Set(antialias=>'True');
    $self->{ $opt{'im'} }->Resize($opt{'geometry'});
}

# Reduse the size of an image using Imager
sub reduse_Imager {
	my ($self, %opt) = @_;
	my ($xs, $ys) = split(/x/, $opt{'geometry'});

	$self->{ $opt{'im'} } = $self->{ 'im' }->scale(xpixels => $xs, ypixels => $ys, type => "nonprop");
}


# Return the image as a blob using GD
sub blob_GD {
        my ($self, %opt) = @_;

	return $self->{ $opt{'im'} }->png;
}

# Return the image as a blob using Image::Magick
sub blob_ImageMagick {
        my ($self, %opt) = @_;

	my $blobs = $self->{ $opt{'im'} }->ImageToBlob(magick => 'png');

	return $blobs;
}

# Return the image as a blob using Imager
sub blob_Imager {
        my ($self, %opt) = @_;
	
	my $data;
	$self->{ $opt{'im'} }->write(data => \$data, type => 'png') or carp $self->{ $opt{'im'} }->errstr;

	return $data;
}

# Return the pixel values for an image when using GD
sub pixels_GD {
	my ($self, %opt) = @_;
	
	my ($xs, $ys) = split(/x/, $opt{'geometry'});
	
	my @pixels;
	for(my $y=0; $y<$ys;$y++) {
			for(my $x=0; $x<$xs;$x++) {

					my $color = $self->{ $opt{'im'} }->getPixel($x, $y);
					my ($red, $green, $blue) = $self->{ $opt{'im'} }->rgb($color);
					my $grey = $red*0.3 + $green*0.59 + $blue*0.11;
					push(@pixels, $grey);
			}
	}
	
	return @pixels;
}

# Return the pixel values for an image when using Image::Magick
sub pixels_ImageMagick {
	my ($self, %opt) = @_;
	my ($xs, $ys) = split(/x/, $opt{'geometry'});
	
	my @pixels;
	for(my $y=0; $y<$ys;$y++) {
			for(my $x=0; $x<$xs;$x++) {
					my @pixel = $self->{ $opt{'im'} }->GetPixel(x=>$x,y=>$y,normalize => 0);
					my $grey = $pixel[0]*0.3 + $pixel[1]*0.59 + $pixel[2]*0.11;
					push(@pixels, $grey);
			}
	}
	
	
	for (my $i = 0; $i <= $#pixels; $i++) {
		$pixels[$i] = $pixels[$i] / 256;
	}
	
	return @pixels;
}

# Return the pixel values for an image when using Imager
sub pixels_Imager {
	my ($self, %opt) = @_;
	my ($xs, $ys) = split(/x/, $opt{'geometry'});
	my @pixels;
	for(my $y=0; $y<$ys;$y++) {
			for(my $x=0; $x<$xs;$x++) {
					my $c = $self->{ $opt{'im'} }->getpixel(x => $x, y => $y);
					my ($red, $green, $blue, $alpha) = $c->rgba();
					my $grey = $red*0.3 + $green*0.59 + $blue*0.11;
					push(@pixels, $grey);
			}
	}
	return @pixels;
}

=head1 HASHES

=head2 ahash

  $ihash->ahash();
  $ihash->ahash('geometry' => '8x8');

Calculate the Average Hash
	
Return an array of binary values in array context and a hex representative in scalar context.

=cut
sub ahash {
	my ($self, %opt) = @_;

	$opt{'geometry'} ||= '8x8';
	$opt{'im'} ||= 'im_' . $opt{'geometry'};

	if(!$self->{ $opt{'im'} }) {
		$self->{'reduse'}->($self, %opt );
	}

	my @pixels = $self->{'pixels'}->($self, %opt );

lib/Image/Hash.pm  view on Meta::CPAN

	if (scalar @{ $opt{'hash'} } != 64) {
		carp("'hash' must be a 64 element array.");
	}
	
	my ($xs, $ys) = split(/x/, $opt{'geometry'});

	print "array(\t[ ";
	for (my $i = 0; $i <= $#pixels; $i++) {
		if (($i % $xs) == 0 && $i != 0) {print " ],\n\t[ "} elsif($i != 0) { print ', '; }

		if ($opt{'hash'}) {
			printf("%3s (%1s)", int($pixels[$i]), shift @{ $opt{'hash'} });
		}
		else {
			printf("%3s", int($pixels[$i]));
		}
	}
	print " ])\n";

}

=head2 reducedimage

  use Image::Hash;
  use File::Slurp;

  my $file = shift @ARGV or die("Pleas spesyfi a file to read!");

  my $image = read_file( $file, binmode => ':raw' ) ;

  my $ihash = Image::Hash->new($image);

  binmode STDOUT;
  print STDOUT $ihash->reducedimage();
 
 Returns the reduced image that will be used by the hash functions.
 
=cut
sub reducedimage {
	my ($self, %opt) = @_;

		
	$opt{'geometry'} ||= '8x8';
	$opt{'im'} ||= 'im_' . $opt{'geometry'};


	if(!$self->{ $opt{'im'} }) {
		$self->{'reduse'}->($self, %opt );
	}

	$self->{'blob'}->($self, %opt );
}

=head1 EXAMPLES

Please see the C<eg/> directory for further examples.

=head1 BUGS

Image::Hash support different back ends (GD, Image::Magick or Imager), but because the different back ends work slightly different they will not produce the same hash for the same image. More info is available at https://github.com/runarbu/PerlImageH...

=head1 AUTHOR

    Runar Buvik
    CPAN ID: RUNARB
    runarb@gmail.com
    http://www.runarb.com

=head1 Git

https://github.com/runarbu/PerlImageHash

=head1 COPYRIGHT

This program is free software; you can redistribute
it and/or modify it under the same terms as Perl itself.

The full text of the license can be found in the
LICENSE file included with this module.


=head1 SEE ALSO

Articles L<Looks like it|http://www.hackerfactor.com/blog/index.php?/archives/432-Looks-Like-It.html> and L<Kind of like that|http://www.hackerfactor.com/blog/?/archives/529-Kind-of-Like-That.html> by Neal Krawetz that describes the theory behind aHa...

L<ImageHash|https://github.com/JohannesBuchner/imagehash> image hashing library written in Python that dos the same thing.

L<Class ImageHash|http://jax-work-archive.blogspot.no/2013/05/php-ahash-phash-dhash.html> a PHP class that do the same thing.

=cut

#################### main pod documentation end ###################


1;
# The preceding line will help the module return a true value