package IMPL::Config::ServicesBag;

require v5.9.5;

use mro;

use IMPL::Const qw(:prop);
use IMPL::declare {
	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 = { owner => $this, value => $value, valid => 1 };

	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;
		}

		if ($replaces) {

			# invalidate cache
			$replaces->{owner}->UpdateDescriptor($replaces);
		}
	}

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

	return $d;
}

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

	my $d2 = {};

	# copy descriptor
	while ( my ( $k, $v ) = each %$d ) {
		$d2->{$k} = $v;
	}

	# 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;
}

1;

__END__

=pod

=head1 NAME

=head1 SYNOPSIS

=head1 DESCRIPTION

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

=over

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

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

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

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

=back

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

=cut