File Coverage

blib/lib/Data/Faker/Colour.pm

Criterion	Covered	Total	%
statement	50	62	80.6
branch	11	14	78.5
condition	10	10	100.0
subroutine	10	16	62.5
pod	7	10	70.0
total	88	112	78.5

package Data::Faker::Colour;

use 5.014000;
use strict;
use warnings;
use parent qw/Data::Faker/;
use Convert::Color::HSLuv;

our $VERSION = '0.001';

sub new { bless {}, shift } # Don't call superclass constructor

sub ir ($) { int rand $_[0] }

sub colour {
	shift; # drop $self
	my $cnt = shift // 1;
	my %args = @_;
	my @ret;

	for (1 .. $cnt) {
		push @ret, [ir 256, ir 256, ir 256]
	}

	wantarray ? @ret : $ret[0]
}

sub colour_hsluv {
	shift; # drop $self
	my @ret;
	my ($cnt, $ch, $cs, $cl) = @_;
	$cnt //= 1;
	$ch  //= -1;
	$cs  //= -1;
	$cl  //= -1;

	for (1 .. $cnt) {
		my ($h, $s, $l) = ($ch, $cs, $cl);
		$h = rand 360 if $h < 0;
		$s = rand 100 if $s < 0;
		$l = rand 100 if $l < 0;
		my @colour = Convert::Color::HSLuv->new($h, $s, $l)->rgb;
		for (@colour) {
			$_ = int (256 * $_);
			$_ = 0 if $_ < 0;
			$_ = 255 if $_ > 255;
		}
		push @ret, \@colour
	}

	wantarray ? @ret : $ret[0]
}

sub to_hex {
	my ($rgb) = @_;
	sprintf "#%02x%02x%02x", @$rgb
}

sub to_css {
	my ($rgb) = @_;
	sprintf 'rgb(%d,%d,%d)', @$rgb
}

sub colour_hex       { map { to_hex $_ } colour @_ }
sub colour_css       { map { to_css $_ } colour @_ }
sub colour_hsluv_hex { map { to_hex $_ } colour_hsluv @_ }
sub colour_hsluv_css { map { to_css $_ } colour_hsluv @_ }

BEGIN {
	*color           = *colour;
	*color_hsluv     = *colour_hsluv;
	*color_hex       = *colour_hex;
	*color_hsluv_hex = *colour_hsluv_hex;
	*color_css       = *colour_css;
	*color_hsluv_css = *colour_hsluv_css;

	for my $c (qw/colour color/) {
		__PACKAGE__->register_plugin(
			"${c}"           => \&colour,
			"${c}_hsluv"     => \&colour_hsluv,
			"${c}_hex"       => \&colour_hex,
			"${c}_hsluv_hex" => \&colour_hsluv_hex,
			"${c}_css"       => \&colour_css,
			"${c}_hsluv_css" => \&colour_hsluv_css,
		);
	}
}

1;
__END__