File Coverage

blib/lib/Mo/utils/Array.pm

Criterion	Covered	Total	%
statement	72	72	100.0
branch	24	24	100.0
condition	6	6	100.0
subroutine	14	14	100.0
pod	5	5	100.0
total	121	121	100.0

package Mo::utils::Array;

use base qw(Exporter);
use strict;
use warnings;

use Error::Pure qw(err);
use List::Util 1.33 qw(none);
use Mo::utils::common qw(check_object);
use Readonly;
use Scalar::Util qw(blessed);

Readonly::Array our @EXPORT_OK => qw(check_array check_array_items check_array_object
	check_array_required check_array_strings);

our $VERSION = 0.05;

sub check_array {
	my ($self, $key) = @_;

	if (! exists $self->{$key}) {
		return;
	}

	if (ref $self->{$key} ne 'ARRAY') {
		my $ref = ref $self->{$key};
		err "Parameter '".$key."' must be a array.",
			'Value', $self->{$key},
			'Reference', ($ref eq '' ? 'SCALAR' : $ref),
		;
	}

	return;
}

sub check_array_items {
	my ($self, $key, $max_items) = @_;

	if (! exists $self->{$key}) {
		return;
	}

	check_array($self, $key);

	if (@{$self->{$key}} > $max_items) {
		err "Parameter '".$key."' has more items than expected.",
			'Maximum items', $max_items,
			'Number of items', (scalar @{$self->{$key}}),
		;
	}

	return;
}

sub check_array_object {
	my ($self, $key, $class) = @_;

	if (! exists $self->{$key}) {
		return;
	}

	check_array($self, $key);

	foreach my $obj (@{$self->{$key}}) {
		check_object($obj, $class,
			"Parameter '%s' with array must contain '%s' objects.",
			[$key, $class],
		);
	}

	return;
}

sub check_array_required {
	my ($self, $key) = @_;

	if (! exists $self->{$key}) {
		err "Parameter '$key' is required.";
	}

	check_array($self, $key);

	if (! @{$self->{$key}}) {
		err "Parameter '".$key."' with array must have at least one item.";
	}

	return;
}

sub check_array_strings {
	my ($self, $key, $strings_ar) = @_;

	if (! exists $self->{$key}) {
		return;
	}

	if (defined $strings_ar && ref $strings_ar ne 'ARRAY') {
		err "Parameter '$key' must have right string definition.";
	}

	check_array($self, $key);

	foreach my $value (@{$self->{$key}}) {
		if (ref $value ne '') {
			err "Parameter '$key' must contain a list of strings.",
				'Value', $value,
				'Reference', (ref $value),
			;
		}
		if (defined $strings_ar && none { $value eq $_ } @{$strings_ar}) {
			err "Parameter '$key' must be one of the defined strings.",
				'Value', $value,
				'Possible strings', "'".(join "', '", @{$strings_ar})."'",
			;
		}
	}

	return;
}

1;

__END__