--- /dev/null	Thu Jan 01 00:00:00 1970 +0000
+++ b/lib/IMPL/Config/ServicesBag.pm	Fri Sep 04 19:40:23 2015 +0300
@@ -0,0 +1,158 @@
+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