view release on metacpan or  search on metacpan

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

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::Env::Etc EON => (default => {}, key => 'aion.eon');

use Aion;

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

# Конфигурация: ключ => 'класс#метод_класса' | хеш-описание эона
has pleroma => (is => 'ro?!', isa => HashRef, default => sub {
	my ($self) = @_;
	
	my %pleroma = ('Aion::Pleroma' => 'Aion::Pleroma#new', %{&EON});
	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(ref $config eq 'HASH') {
		$self->{eon}{$key} = $self->build($key, $config);
	}
	elsif($config) {
		$self->{eon}{$key} = $self->construct($config, []);
	}
	elsif(AION_PLEROMA_AUTOWARE and $key =~ /^([\w:]+)(#\w+)?$/ and eval "require $1") { $self->autoware($key)->get($key) }
	else { undef }
}

# Построить эон из хеш-описания: class, method, arguments, calls
sub build {
	my ($self, $key, $conf) = @_;

	my $pkg = $conf->{class} // ($key =~ /^[\w:]+$/ ? $key : undef)
		or die "Eon $key: class is undef! Optional 'class' key or key-as-class.";
	my $method = $conf->{method} // 'new';

	$self->_require($pkg);

	my $args = $conf->{arguments} // {};
	$args = $self->resolve_args($args);

	my $eon = $self->construct("$pkg#$method", $args);

	for my $call (@{ $conf->{calls} // [] }) {
		my ($name, @call_args);
		if(ref $call eq 'ARRAY') { ($name, @call_args) = @$call }
		else { $name = $call }
		@call_args = map { $self->resolve_value($_) } @call_args;
		$eon->$name(@call_args);
	}