Image-ColorDetector

 view release on metacpan or  search on metacpan

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

package Image::ColorDetector;
use 5.008005;
use strict;
use warnings;

our $VERSION = "0.04";

use parent qw( Exporter );
our @EXPORT_OK = qw(
detect
);

use Carp ();

use Image::Magick;
use List::Util qw( max min );

sub detect {
	my ($file_path) = @_;

	Carp::croak(q{$file_path is required})
		unless (defined $file_path);

	my $hsvs_ref = _extract_hsv($file_path);
	my $color_names_ref = _allot_color_name($hsvs_ref);
	my $color_palette = _count_up_for_each_color_name($color_names_ref);
	my $color_name = _main_color_name($color_palette);

	if ($color_name) {
		return $color_name;
	}
	else {
		return;
	}
}

sub _extract_hsv {
	my ($img) = @_;
	$img or return;

	my $im = Image::Magick->new;
	open(IMAGE, $img);

	my $ret = $im->Read(file => \*IMAGE);

	if ($ret) {
		Carp::croak("$ret\ninvalid image source: $!");
	}

	close(IMAGE);

	my ($w, $h) = $im->Get('width', 'height');

	my @pixels = $im->GetPixels(
		width => $w,
		height => $h,
		x => 0,
		y => 0,
		map => 'RGB',
	);

	my @rgbs;
	my @hsvs;
	while (@pixels) {
		my %rgb_hash;
		$rgb_hash{r} = (int((shift @pixels) / 256) / 255);
		$rgb_hash{g} = (int((shift @pixels) / 256) / 255);
		$rgb_hash{b} = (int((shift @pixels) / 256) / 255);
		push @rgbs, \%rgb_hash;

		my $max = max $rgb_hash{r}, $rgb_hash{g}, $rgb_hash{b};
		my $min = min $rgb_hash{r}, $rgb_hash{g}, $rgb_hash{b};

		next if ($max <= 0);

		my %hsv_hash;
		$hsv_hash{v} = $max;
		$hsv_hash{s} = 255 * ( ($max - $min) / $max );

		if ($hsv_hash{s} == 0) {
			next;
		}
		elsif ($max == $rgb_hash{r}) {
			$hsv_hash{h} = 60 * ( ($rgb_hash{g} - $rgb_hash{b}) / ($max - $min) );
		}
		elsif ($max == $rgb_hash{g}) {
			$hsv_hash{h} = 60 * ( 2 + ($rgb_hash{b} - $rgb_hash{r}) / ($max - $min) );
		}
		elsif ($max == $rgb_hash{b}) {
			$hsv_hash{h} = 60 * ( 4 + ($rgb_hash{r} - $rgb_hash{g}) / ($max - $min) );
		}
		else {
			next;
		}
		push @hsvs, \%hsv_hash;
	}
	return \@hsvs;
}

sub _allot_color_name {
	my ($hsvs) = @_;



( run in 1.732 second using v1.01-cache-2.11-cpan-39bf76dae61 )