File Coverage

blib/lib/Mo/utils.pm

Criterion	Covered	Total	%
statement	105	105	100.0
branch	58	58	100.0
condition	12	12	100.0
subroutine	21	21	100.0
pod	12	12	100.0
total	208	208	100.0

package Mo::utils;

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

use Error::Pure qw(err);
use List::Util qw(none);
use Readonly;
use Scalar::Util qw(blessed);

Readonly::Array our @EXPORT_OK => qw(check_array check_array_object check_bool
	check_code check_isa check_length check_number check_number_of_items
	check_regexp check_required check_string_begin check_strings);

our $VERSION = 0.17;

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

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

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

	return;
}

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

	check_array($self, $key);

	foreach my $obj (@{$self->{$key}}) {
		if (! $obj->isa($class)) {
			err $class_name." isn't '".$class."' object.";
		}
	}

	return;
}

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

	_check_key($self, $key) && return;

	if ($self->{$key} !~ m/^\d+$/ms || ($self->{$key} != 0 && $self->{$key} != 1)) {
		err "Parameter '$key' must be a bool (0/1).",
			'Value', $self->{$key},
		;
	}

	return;
}

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

	_check_key($self, $key) && return;

	if (ref $self->{$key} ne 'CODE') {
		err "Parameter '$key' must be a code.",
			'Value', $self->{$key},
		;
	}

	return;
}

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

	_check_key($self, $key) && return;

	if (! blessed($self->{$key})) {
		err "Parameter '$key' must be a '$class' object.",

			# Only, if value is scalar.
			(ref $self->{$key} eq '') ? (
				'Value', $self->{$key},
			) : (),

			# Only if value is reference.
			(ref $self->{$key} ne '') ? (
				'Reference', (ref $self->{$key}),
			) : (),
	}

	if (! $self->{$key}->isa($class)) {
		err "Parameter '$key' must be a '$class' object.",
			'Reference', (ref $self->{$key}),
		;
	}

	return;
}

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

	_check_key($self, $key) && return;

	if (length $self->{$key} > $max_length) {
		err "Parameter '$key' has length greater than '$max_length'.",
			'Value', $self->{$key},
		;
	}

	return;
}

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

	_check_key($self, $key) && return;

	if ($self->{$key} !~ m/^[-+]?\d+(\.\d+)?$/ms) {
		err "Parameter '$key' must be a number.",
			'Value', $self->{$key},
		;
	}

	return;
}

sub check_number_of_items {
	my ($self, $list_method, $item_method, $object_name, $item_name) = @_;

	my $item_hr = {};
	foreach my $item (@{$self->$list_method}) {
		$item_hr->{$item->$item_method} += 1;
	}

	foreach my $item (keys %{$item_hr}) {
		if ($item_hr->{$item} > 1) {
			err "$object_name for $item_name '$item' has multiple values."
		}
	}

	return;
}

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

	_check_key($self, $key) && return;

	if (! defined $regexp) {
		err "Parameter '$key' must have defined regexp.";
	}
	if ($self->{$key} !~ m/^$regexp/ms) {
		err "Parameter '$key' does not match the specified regular expression.",
			'String', $self->{$key},
			'Regexp', $regexp,
		;
	}

	return;
}

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

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

	return;
}

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

	_check_key($self, $key) && return;

	if (! defined $string_base) {
		err "Parameter '$key' must have defined string base.";
	}
	if ($self->{$key} !~ m/^$string_base/) {
		err "Parameter '$key' must begin with defined string base.",
			'String', $self->{$key},
			'String base', $string_base,
		;
	}

	return;
}

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

	_check_key($self, $key) && return;

	if (! defined $strings_ar) {
		err "Parameter '$key' must have strings definition.";
	}
	if (ref $strings_ar ne 'ARRAY') {
		err "Parameter '$key' must have right string definition.";
	}
	if (none { $self->{$key} eq $_ } @{$strings_ar}) {
		err "Parameter '$key' must be one of defined strings.",
			'String', $self->{$key},
			'Possible strings', (join ', ', @{$strings_ar}),
		;
	}

	return;
}

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

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

	return 0;
}

1;

__END__