File Coverage

blib/lib/Aion/Pleroma.pm

Criterion	Covered	Total	%
statement	31	32	96.8
branch	16	18	88.8
condition	9	13	69.2
subroutine	7	7	100.0
pod	3	3	100.0
total	66	73	90.4

package Aion::Pleroma;
# Контейнер для эонов (сервисов)

use common::sense;

use Aion::Env AION_PLEROMA_INI => (default => 'etc/annotation/eon.ann');
use Aion::Env AION_PLEROMA_AUTOWARE => (default => 1);

use Aion;

# Файл с аннотациями
has ini => (is => 'ro', isa => Maybe[Str], default => AION_PLEROMA_INI);

# Конфигурация: ключ => класс#метод_класса
has pleroma => (is => 'ro', isa => HashRef[Str], default => sub {
	my ($self) = @_;

	my %pleroma = ('Aion::Pleroma' => 'Aion::Pleroma#new');
	return \%pleroma unless defined $self->ini and -e $self->ini;

	open my $f, '<:utf8', $self->ini or die "Not open ${\$self->ini}: $!";
	while(<$f>) {
		close($f), die "${\$self->ini} corrupt at line $.: $_" unless /^([\w:]+)#(\w*),\d+=(.*)$/;
		my ($pkg, $sub, $key) = ($1, $2, $3);
		my $action = join "#", $pkg, $sub || 'new';

		$key = $key ne ""? $key: ($sub? "$pkg#$sub": $pkg);

		close($f), die "The eon $key is $pleroma{$key}, but added other $action" if exists $pleroma{$key};

		$pleroma{$key} = $action;
	}
	close $f;

	\%pleroma
});

# Совокупность порождённых эонов-сервисов
has eon => (is => 'ro', isa => HashRef[Object], lazy => 0, default => sub { +{'Aion::Pleroma' => shift} });

# Получить эон из контейнера
sub get {
	my ($self, $key) = @_;

	my $eon = $self->{eon}{$key};
	return $eon if $eon;

	my $config = $self->pleroma->{$key};
	if($config) {
		my ($pkg, $method) = $config =~ /#/? ($`, $'): ();
		eval "require $pkg" or die unless $pkg->can('new') || $pkg->can('does');
		$self->{eon}{$key} = $pkg->$method;
	}
	elsif(AION_PLEROMA_AUTOWARE and $key =~ /^([\w:]+)(#\w+)?$/ and eval "require $1") { $self->autoware($key)->get($key) }
	else { undef }
}

# Получить эон из контейнера или исключение, если его там нет
sub resolve {
	my ($self, $key) = @_;

	$self->get($key) // die "$key is'nt eon!"
}

# Добавить в плерому пакет
sub autoware {
	my ($self, $action, $key) = @_;
	my ($pkg, $sub) = $action =~ /#/? ($`, $'): ($action, 'new');
	$action = "$pkg#$sub";
	$key //= $action =~ /#new$/? $pkg: $action;

	if(my $action_exists = $self->pleroma->{$key}) {
		die "Added eon $key twice, with $action ne $action_exists" if $action_exists ne $action;
	}
	else {
		$self->pleroma->{$key} = $action;
	}
	$self
}

1;

__END__