File Coverage

blib/lib/Aion/Meta/Feature.pm

Criterion	Covered	Total	%
statement	287	436	65.8
branch	72	130	55.3
condition	5	11	45.4
subroutine	57	68	83.8
pod	9	18	50.0
total	430	663	64.8

package Aion::Meta::Feature;

use common::sense;

use Aion::Meta::Util qw//;
use Aion::Meta::FeatureConstruct;
use List::Util qw/pairmap/;

Aion::Meta::Util::create_getters(qw/pkg name opt has construct order/);
Aion::Meta::Util::create_accessors(qw/
	required excessive isa
	lazy builder default trigger release cleaner
	make_reader make_writer make_predicate make_clearer
/);

#  Конструктор
sub new {
	my ($cls, $pkg, $name, @has) = @_;

	my $meta = $Aion::META{$pkg};

	bless {
		pkg => $pkg,
		name => $name,
		opt => {@has},
		has => \@has,
		construct => Aion::Meta::FeatureConstruct->new($pkg, $name),
		order => scalar keys %{$meta->{feature}},
		stash => {},
	}, ref $cls || $cls;
}

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

# Создаёт свойство
sub mk_property {
	my ($self) = @_;

	my $meta = $Aion::META{$self->pkg};

	my $ASPECT = $meta->{aspect};
	my $has = $self->{has};
	for(my $i=0; $i<@$has; $i+=2) {
		my ($aspect, $value) = @$has[$i, $i+1];
		my $aspect_sub = $ASPECT->{$aspect};
		die "has: not exists aspect `$aspect`!" if !$aspect_sub;
		$aspect_sub->($value, $self, $aspect);
	}

	my $accessor = $self->construct->accessor;
	eval $accessor;
	die if $@;

	if($self->{make_reader}) {
		my $reader = $self->construct->reader;
		eval $reader;
		die if $@;
	}

	if($self->{make_writer}) {
		my $writer = $self->construct->writer;
		eval $writer;
		die if $@;
	}

	if($self->{make_predicate}) {
		my $predicate = $self->construct->predicate;
		eval $predicate;
		die if $@;
	}

	if($self->{make_clearer}) {
		my $clearer = $self->construct->clearer;
		eval $clearer;
		die if $@;
	}
}

# Представление себя в коде
sub meta {
	my ($self) = @_;
	$self->{meta} //= do {
		my ($cls, $name) = @$self{qw/pkg name/};
		"\$Aion::META{'$cls'}{feature}{$name}"
	};
}

# Доступ к сташу со свойствами
sub stash {
	my ($self, $key, $val) = @_;

	my $stash = $self->{stash}{scalar caller} //= {};

	@_ > 2? do { $stash->{$key} = $val; $self }: $stash->{$key};
}

# Сравнивает старую фичу с перезагружаемой
sub compare {
	my ($self, $other) = @_;

	die "Types mismatch: $other->{isa} <=> $self->{isa}" if $self->{isa} && $self->{isa} ne $other->{isa};
}

1;

__END__