package IMPL::Config::ServicesBag;

require v5.9.5;

use mro;

use IMPL::Const qw(:prop);
use IMPL::declare {
	require => {
		Entry => '-IMPL::Config::ServicesBag::Entry'
	},
	base => [
		'IMPL::Object' => undef
	],
	props => [
		_prototype => PROP_RW,
		_nameMap   => PROP_RW,
		_typeMap   => PROP_RW,
		_props     => PROP_RW,
	]
};

sub CTOR {
	my ( $this, $prototype ) = @_;

	$this->_prototype($prototype) if $prototype;
	$this->_nameMap( {} );
	$this->_typeMap( {} );
}

sub GetDescriptorByName {
	my ( $this, $name ) = @_;

	my $d = $this->_nameMap->{$name};
	return $d if $d and $d->{valid};

	my $parent = $this->_prototype;

	if ( $parent and $d = $parent->GetDescriptorByName($name) ) {
		return $this->_nameMap->{$name} = $d;
	}

	return undef;
}

sub GetDescriptorByType {
	my ( $this, $type ) = @_;

	my $d = $this->_typeMap->{$type};
	return $d if $d and $d->{valid};

	my $parent = $this->_prototype;
	if ( $parent and $d = $parent->GetDescriptorByType($type) ) {
		return $this->_typeMap->{$type} = $d;
	}

	return undef;
}

sub RegisterValue {
	my ( $this, $value, $name, $type ) = @_;

	my $d = Entry->new( {owner => $this, value => $value} );

	if ($type) {
		my $map = $this->_typeMap;
		my $isa = mro::get_linear_isa($type);
		$d->{isa} = $isa;

		# the service record which is superseded by the current one
		my $replaces = $this->GetDescriptorByType($type);

		foreach my $t (@$isa) {
			if ( my $prev = $this->GetDescriptorByType($t) ) {

				# keep previous registrations if they are valid
				next if not $replaces or $prev != $replaces;
			}

			$map->{$t} = $d;
		}

			# invalidate cache
			$replaces->Invalidate() if $replaces;
		
	}

	if ($name) {
		my $prev = $this->_nameMap->{$name};
		$d->{name} = $name;
		$this->_nameMap->{$name} = $d;
		$prev->Invalidate() if $prev;
	}

	return $d;
}

sub _UpdateDescriptor {
	my ( $this, $d ) = @_;

	my $d2 = Entry->new($d);

	# update named entries
	my $name = $d->{name};
	if ( $name and $this->_nameMap->{$name} == $d ) {
		$this->_nameMap->{$name} = $d2;
	}

	# update type entries
	if ( my $isa = $d->{isa} ) {
		my $map = $this->_typeMap;
		foreach my $t (@$isa) {
			next unless $map->{$t} == $d;
			$map->{$t} = $d2;
		}
	}

	$d->{valid} = 0;
}

package IMPL::Config::ServicesBag::Entry;
use IMPL::Exception();
use IMPL::declare {
	base => [
	   'IMPL::Object::Fields' => undef
	]
};

my @fields = qw(owner type isa valid value); 
use fields @fields;

sub CTOR {
	my SELF $this = shift;
	my $args = shift;
	
	$this->{valid} = 1;
	$this->{owner} = $args{owner} or die IMPL::InvalidArgumentException->new("owner");
	$this->{value} = $args{value} if exists $args->{value};
	$this->{isa} = $args{isa} if $args->{isa};
}

sub Invalidate {
	my SELF $this = shift;
	
	$this->{owner}->_UpdateDescriptor($this);
}

1;

__END__

=pod

=head1 NAME

=head1 SYNOPSIS

=head1 DESCRIPTION

Коллекция сервисов построена на прототиптровании экземпляров, т.е. при создании
новой коллекции может указваться базовая коллекция в которой будет происходить
поиск сервисов в случае их отсутсвия в основной. Для оптимизации данного процесса
сервисы кешируются, чтобы избежать можестрвенных операций поиска по иерархии
коллекций, для этого каждый сервис описывается дескриптором:

=over

=item * isa массив типов сервиса, если он регистрировался как сервис

=item * value значение

=item * valid признак того, что дескриптор действителен

=item * owner коллекция, которая создала данный дескриптор

=back

Если запрашиваемый десриптор не найден это является ошибкой, поэтому негативные
ответы не кешируются

=cut