view release on metacpan or  search on metacpan

lib/Aion/Meta/RequiresFeature.pm  view on Meta::CPAN

package Aion::Meta::RequiresFeature;

use common::sense;

use Aion::Meta::Util qw//;
use List::Util qw/pairmap/;
use Scalar::Util qw/looks_like_number reftype blessed refaddr/;

Aion::Meta::Util::create_getters(qw/pkg name opt has/);

#  Конструктор
sub new {
	my ($cls, $pkg, $name, @has) = @_;
	bless {pkg => $pkg, name => $name, opt => {@has}, has => \@has}, ref $cls || $cls;
}

# Строковое представление фичи
sub stringify {
	my ($self) = @_;
	my $has = join ', ', pairmap { "$a => ${\
		Aion::Meta::Util::val_to_str($b)
	}" } @{$self->{has}};
	return "req $self->{name} => ($has) of $self->{pkg}";
}

# Сравнивает с фичей, но только значения которые есть в этой
sub compare {
	my ($self, $feature) = @_;

	die "Requires ${\$self->stringify}" unless UNIVERSAL::isa($feature, 'Aion::Meta::Feature');

	for my $key (keys %{$self->{opt}}) {
		my $value = $self->{opt}{$key};
		my $feature_value = $feature->{opt}{$key};
		
		die "Feature mismatch ($key => ${\
			Aion::Meta::Util::val_to_str($value)
		} != ${\
			Aion::Meta::Util::val_to_str($feature_value)
		}) with ${\$self->stringify}"
			unless _deep_equal($value, $feature_value);
	}
}

# Сравнивает два значения
sub _deep_equal {
	my ($value, $other_value) = @_;

	if (blessed $value) {
		return "" unless blessed $other_value;

		if (overload::Method($value, '==')) {
			return "" unless $value == $other_value;
		}
		elsif (overload::Method($value, 'eq')) {
			return "" unless $value eq $other_value;
		}
		else {
			return "" unless refaddr $value == refaddr $other_value;
		}
	}
	elsif (looks_like_number($value)) {
		return "" unless looks_like_number($other_value) && $value == $other_value;
	}
	elsif (reftype $value eq 'ARRAY') {
		for(my $i = 0; $i <= $#$value; $i++) {
			return "" unless _deep_equal($value->[$i], $other_value->[$i]);
		}
	}
	elsif (reftype $value eq 'HASH') {
		for my $k (keys %$value) {
			return "" unless exists $other_value->{$k} && _deep_equal($value->{$k}, $other_value->{$k});
		}
	}
	elsif (reftype $value eq 'SCALAR') {
		return "" unless reftype $other_value eq 'SCALAR' && _deep_equal($$value, $$other_value);
	}
	elsif (reftype $value eq 'CODE') {
		return "" unless reftype $other_value eq 'CODE' && refaddr $value == refaddr $other_value;
	}
	else {
		return "" if $value ne $other_value;
	}

	return 1;
}

1;

__END__

=encoding utf-8

=head1 NAME

Aion::Meta::RequiresFeature - feature requirement for interfaces

=head1 SYNOPSIS

	use Aion::Types qw(Str);
	use Aion::Meta::RequiresFeature;
	use Aion::Meta::Feature;
	
	my $req = Aion::Meta::RequiresFeature->new(
		'My::Package', 'name', is => 'rw', isa => Str);
	
	my $feature = Aion::Meta::Feature->new(
		'Other::Package',
		'name', is => 'rw', isa => Str,
		default => 'default_value');