Image-PHash
view release on metacpan or search on metacpan
"perl" : "5.008"
},
"suggests" : {
"Image::Imlib2" : "0"
}
},
"test" : {
"recommends" : {
"GD" : "0",
"Image::Imlib2" : "0",
"Image::Magick" : "0"
},
"requires" : {
"Imager" : "0",
"Test2::Tools::Exception" : "0",
"Test2::V0" : "0",
"Test::More" : "0"
}
}
},
"release_status" : "stable",
Makefile.PL view on Meta::CPAN
'Imager' => '0'
},
PREREQ_PM => {
'Math::DCT' => '0'
},
META_MERGE => {
"meta-spec" => { version => 2 },
prereqs => {
test => {
$extra_test => {
'Image::Magick' => '0',
'Image::Imlib2' => '0',
'GD' => '0'
}
},
runtime => {
suggests => {
'Image::Imlib2' => '0',
}
}
},
bench/benchmark.pl view on Meta::CPAN
# bench/benchmark.pl [image?]
# Without an argument, the 1024x680 images/M31.jpg is loaded
use Image::PHash;
use Time::HiRes;
my $file = $ARGV[0] || 'images/M31.jpg';
die "File $file not found" unless -f $file;
print "Benchmarking using $file\n";
my @libs = qw/Image::Imlib2 GD Image::Magick Imager/;
foreach my $lib (@libs) {
next unless eval "require $lib;";
print "$lib hash rate: ";
my $start = Time::HiRes::time();
my $cnt = 0;
while (Time::HiRes::time() - $start < 5) {
my $p = Image::PHash->new($file, $lib)->pHash();
$cnt++
}
lib/Image/PHash.pm view on Meta::CPAN
=head2 Performance
The hashing performance of the module is enough to make the actual pHash generation
from the final 32x32 mono image a trivial part of the process. For a general idea,
on a single core of a 2015 Macbook Pro, over 18000 hashes/sec can be processed thanks
in part to the fast L<Math::DCT> XS module (developed specifically for Image::PHash).
So, most of the processing time is spent on loading the image, resizing, extracting
pixel values, removing color, all of which depend on the specific image module. On an
Apple M1, hashing 800x600 jpg images was measured at 131 h/s with L<Image::Magick>,
208 h/s with L<Imager>, 241 h/s with L<GD>, 547 h/s with L<Image::Imlib2>.
Higher resolutions make the process slower as you could expect. Since all images will
be resized to 32x32 in the end, the fastest hashing performance would be if you loaded
32x32 thumbnails. In that case, the performance of the libraries in the same order for
the resized imageset were: 659 h/s, 664 h/s, 1883 h/s, 2296 h/s. It is clear that
L<Image::Imlib2> should be preferred when hashing performance is desired, as it offers
dramatically better performance (unless you are hashing 32x32 images in which case L<GD>
also fast). It should be noted that the resulting hashes don't have exactly the same
behaviour/metrics, due to the different resizing algorithms used, but the differences
seem to be very small. You are encouraged to test on your own data set.
lib/Image/PHash.pm view on Meta::CPAN
croak("Hashref expected for settings argument") unless ref($self->{settings}) eq 'HASH';
$self->{dct_size} = int($self->{settings}->{resize} || 32);
$self->{imager_qtype} = $self->{settings}->{imager_qtype} || 'mixing';
$self->{magick_filter} = $self->{settings}->{magick_filter} || 'Cubic';
croak("resize > 5 expected.") unless $self->{dct_size} > 5;
my %libs = ( # Library, reduce/resize function, pixels function, support for passing data variable
Imlib2 => ['Image::Imlib2', \&_reduce_Imlib2, \&_pixels_Imlib2],
GD => ['GD', \&_reduce_GD, \&_pixels_GD, 1],
ImageMagick => ['Image::Magick', \&_reduce_Magick, \&_pixels_Magick, 1],
Imager => ['Imager', \&_reduce_Imager, \&_pixels_Imager, 1],
);
my $ref = ref($self->{image});
my $file = $ref ? undef : -f $self->{image};
if ($ref) { # Passed image object
$self->{module} = undef;
foreach (_lib_order()) {
my $type = $_ eq 'GD' ? 'GD::Image' : $libs{$_}->[0];
lib/Image/PHash.pm view on Meta::CPAN
}
croak("No file at $self->{image}")
unless $ref || $file || (length($self->{image}) > 255 && $libs{$self->{module}}->[3]);
my $error = '';
if ($libs{$self->{module}}->[0] eq 'Image::Imlib2') {
$self->{im} = $ref ? $self->{image} : Image::Imlib2->load($self->{image});
} elsif ($libs{$self->{module}}->[0] eq 'GD') {
GD::Image->trueColor(1);
$self->{im} = $ref ? $self->{image} : GD::Image->new($self->{image});
} elsif ($libs{$self->{module}}->[0] eq 'Image::Magick') {
if ($ref) {
$self->{im} = $self->{image};
} else {
$self->{im} = Image::Magick->new();
$error =
($file)
? $self->{im}->Read($self->{image})
: $self->{im}->BlobToImage($self->{image});
$self->{im} = undef if $error;
}
} else {
my $type = $file ? 'file' : 'data';
$self->{im} = $ref ? $self->{image} : Imager->new($type => $self->{image});
$error = Imager->errstr() || '';
lib/Image/PHash.pm view on Meta::CPAN
my $dest = GD::Image->new($self->{dct_size}, $self->{dct_size});
$dest->copyResampled(
$self->{im_scaled}, 0, 0, # (srcimg, dstX, dstY)
0, 0, $self->{dct_size}, $self->{dct_size}, # (srcX, srxY, destX, destY)
$self->{im_scaled}->width, $self->{im_scaled}->height
);
$self->{im_scaled} = $dest;
}
# Reduce the size of an image using Image::Magick
sub _reduce_Magick {
my $self = shift;
$self->{im_scaled} = $self->{im};
my ($w, $h) = $self->{im}->Get('width', 'height');
return if $w == $self->{dct_size} && $h == $self->{dct_size};
$self->{im_scaled}->Set(antialias => 'True');
$self->{im_scaled}->Resize(
width => $self->{dct_size},
lib/Image/PHash.pm view on Meta::CPAN
my $color = $self->{im_scaled}->getPixel($x, $y);
my ($red, $green, $blue) = $self->{im_scaled}->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_Magick {
my $self = shift;
my @pixels;
for (my $y = 0; $y < $self->{dct_size}; $y++) {
for (my $x = 0; $x < $self->{dct_size}; $x++) {
my @pixel = $self->{im_scaled}->GetPixel(
x => $x,
y => $y,
normalize => 0
);
"Unsupported method"
);
like(
warnings { $iph->pHash(mirror_proof=>1) },
[qr/mirror_proof/],
"Unknown option"
);
my $blob = 'xdata'x1000;
foreach my $lib (qw/Image::Magick Imager/) {
next unless eval "require $lib;";
like(
warnings { Image::PHash->new($blob, $lib) },
[qr/Cannot load data/],
"Can't load fake data with $lib"
);
}
done_testing;
use Test2::V0;
use POSIX qw/ceil/;
use Image::PHash;
my %libs = (
'Image::Imlib2' => {resize => 64},
GD => {resize => 48},
'Image::Magick' => {magick_filter => 'Triangle'},
Imager => {imager_qtype => 'normal'}
);
my $cnt = 0;
foreach my $lib (keys %libs) {
next unless eval "require $lib;";
next if $lib eq 'Imager' && !eval "require Imager::File::JPEG;";
$cnt++;
my $iph = Image::PHash->new('images/M31.jpg', $lib);
my $iph2 = Image::PHash->new('images/M31_s.jpg', $lib);
is($p, 'D39F36E74DFB6D9F', 'Same hash expected for fixed image');
};
subtest "Loading $lib object" => sub {
my $obj;
if ($lib eq 'Image::Imlib2') {
$obj = Image::Imlib2->load('images/M31_s.jpg');
} elsif ($lib eq 'GD') {
GD::Image->trueColor(1);
$obj = GD::Image->new('images/M31_s.jpg');
} elsif ($lib eq 'Image::Magick') {
$obj = Image::Magick->new();
$obj->Read('images/M31_s.jpg');
} else {
$obj = Imager->new('file' => 'images/M31_s.jpg');
}
my $iph = Image::PHash->new($obj);
is($iph->{im}, $obj, 'object loaded');
};
}
# ok($cnt > 0, "At least 1 image library required - $cnt successfully loaded");
( run in 0.429 second using v1.01-cache-2.11-cpan-beeb90c9504 )