changeset 421:7798345304bc ref20150831

working on IMPL::Config, removed old stuff
author cin
date Sun, 16 Jul 2017 22:59:39 +0300
parents df591e3afd10
children b0481c071bea
files _test/sample.yaml lib/IMPL/Code/BasePropertyImplementor.pm lib/IMPL/Config/ActivationContext.pm lib/IMPL/Config/Activator.pm lib/IMPL/Config/Container.pm lib/IMPL/Config/Descriptor.pm lib/IMPL/Config/Include.pm lib/IMPL/Config/Path.pm lib/IMPL/Config/Reference.pm lib/IMPL/Config/ReferenceDescriptor.pm lib/IMPL/Config/Resolve.pm lib/IMPL/Config/ServiceDescriptor.pm lib/IMPL/Config/ValueDescriptor.pm lib/IMPL/Config/YAMLConfig.pm lib/IMPL/lang.pm
diffstat 15 files changed, 389 insertions(+), 653 deletions(-) [+]
line wrap: on
line diff
--- a/_test/sample.yaml	Sat Feb 25 22:35:26 2017 +0300
+++ b/_test/sample.yaml	Sun Jul 16 22:59:39 2017 +0300
@@ -2,15 +2,15 @@
 - secrets.yaml
 - defaults.yaml
 services:
-- role: db
+- name: db
   $type: My::Db::Context
-- role:
+- name:
   - auth
   - authz
   - users-provider
   - roles-provider
   $type: My::LDAP::Adapter
-- role: security-provider
+- name: security-provider
   $type: My::SecureCookies
   params:
     users:
--- a/lib/IMPL/Code/BasePropertyImplementor.pm	Sat Feb 25 22:35:26 2017 +0300
+++ b/lib/IMPL/Code/BasePropertyImplementor.pm	Sun Jul 16 22:59:39 2017 +0300
@@ -50,7 +50,7 @@
             ownerSet => (($spec & PROP_OWNERSET) == PROP_OWNERSET),
             direct => $spec & PROP_DIRECT
         };
-	} elsif ($spec =~ /(\*)?(r)?(w)?/) {
+	} elsif ($spec =~ /^(\*)?(ro?)?(w)?$/) {
 		return {
 			get => $2 ? 1 : 0,
 			set => 1,
@@ -58,7 +58,7 @@
 			direct => $1 ? 1 : 0
 		};
 	} else {
-		return die IMPL::Exception->new("Invalid property specification","$spec");
+		die IMPL::Exception->new("Invalid property specification","$spec");
 	}	    
 }
 
--- a/lib/IMPL/Config/ActivationContext.pm	Sat Feb 25 22:35:26 2017 +0300
+++ b/lib/IMPL/Config/ActivationContext.pm	Sun Jul 16 22:59:39 2017 +0300
@@ -4,95 +4,95 @@
 use IMPL::Const qw(:prop);
 use IMPL::Exception();
 use IMPL::declare {
-	require => {
-		Bag                      => 'IMPL::Config::ServicesBag',
-		ServiceNotFoundException => 'IMPL::Config::ServiceNotFoundException',
-	},
-	base => {
-		'IMPL::Object' => '@_'
-	},
-	props => [
-		container => PROP_RW,
-		instances => PROP_RW,
-		_services => PROP_RW,
-		_stack    => PROP_RW
-	]
+    require => {
+        Bag                      => 'IMPL::Config::ServicesBag',
+        ServiceNotFoundException => 'IMPL::Config::ServiceNotFoundException',
+    },
+    base => {
+        'IMPL::Object' => '@_'
+    },
+    props => [
+        container => PROP_RW,
+        instances => PROP_RW,
+        _services => PROP_RW,
+        _stack    => PROP_RW
+    ]
 };
 
 sub CTOR {
-	my ( $this, $container ) = @_;
+    my ( $this, $container ) = @_;
 
-	$this->container($container)
-	  or die IMPL::InvalidArgumentException->new('container');
-	$this->_services( $container->services );
-	$this->instances( {} );
-	$this->_stack( [] );
+    $this->container($container)
+      or die IMPL::InvalidArgumentException->new('container');
+    $this->_services( $container->services );
+    $this->instances( {} );
+    $this->_stack( [] );
 }
 
 sub EnterScope {
-	my ( $this, $name, $services ) = @_;
+    my ( $this, $name, $services ) = @_;
 
-	my $info = { name => $name };
+    my $info = { name => $name };
 
-	if ($services) {
-		die IMPL::InvalidArgumentException->new(
-			services => 'An array is required' )
-		  unless isarray($services);
+    if ($services) {
+        die IMPL::InvalidArgumentException->new(
+            services => 'An array is required' )
+          unless isarray($services);
 
-		my $bag = $this->container->serviceCache->{ ref($services) };
+        my $bag = $this->container->serviceCache->{ ref($services) };
 
-		unless ($bag) {
-			my $container = $this->container;
-			$bag = Bag->new( $this->_services );
+        unless ($bag) {
+            my $container = $this->container;
+            $bag = Bag->new( $this->_services );
 
-			#
-			$bag->Register(
-				$container->GetLinearRoleHash( $_->{role}, $_->{descriptor} ) )
-			  foreach @$services;
+            #
+            $bag->Register(
+                $container->GetLinearRoleHash( $_->{role}, $_->{descriptor} ) )
+              foreach @$services;
 
-			$container->serviceCache->{ ref($services) } = $bag;
-		}
+            $container->serviceCache->{ ref($services) } = $bag;
+        }
 
-		$info->{services} = $this->_services;
-		$this->_services($bag);
-	}
+        $info->{services} = $this->_services;
+        $this->_services($bag);
+    }
 
-	push @{ $this->_stack }, $info;
+    push @{ $this->_stack }, $info;
 }
 
 sub LeaveScope {
-	my ($this) = @_;
+    my ($this) = @_;
 
-	my $info = pop @{ $this->_stack }
-	  or die IMPL::InvalidOperationException->new();
+    my $info = pop @{ $this->_stack }
+      or die IMPL::InvalidOperationException->new();
 
-	$this->_services( $info->{services} ) if $info->{services};
+    $this->_services( $info->{services} ) if $info->{services};
 }
 
 sub Resolve {
-	my ( $this, $role, %opts ) = @_;
+    my ( $this, $role, %opts ) = @_;
 
-	my $d = $this->_services->Resolve($role);
+    my $d = $this->_services->Resolve($role);
 
-	unless ($d) {
-		die ServiceNotFoundException->new($role) unless $opts{optional};
-		return $opts{default};
-	}
-	else {
-		return $d->Activate($this);
-	}
+    unless ($d) {
+        die ServiceNotFoundException->new($role) unless $opts{optional};
+        return $opts{default};
+    }
+    else {
+        return $d->Activate($this);
+    }
 }
 
 sub Clone {
-	my ($this) = @_;
+    my ($this) = @_;
 
-	my $clone = SELF->new( $this->container );
+    my $clone = SELF->new( $this->container );
 
-	$clone->_services( $this->_services );
-	$clone->instances( { %{ $this->instances } } );
-	$clone->_stack( [ @{ $this->_stack } ] );
+    $clone->_services( $this->_services );
+    $clone->instances( { %{ $this->instances } } );
+    $clone->_stack( [ @{ $this->_stack } ] );
 
-	return $clone;
+    return $clone;
 }
 
 1;
--- a/lib/IMPL/Config/Activator.pm	Sat Feb 25 22:35:26 2017 +0300
+++ /dev/null	Thu Jan 01 00:00:00 1970 +0000
@@ -1,91 +0,0 @@
-package IMPL::Config::Activator;
-use strict;
-
-use Scalar::Util qw(reftype);
-use IMPL::lang;
-use IMPL::Const qw(:prop);
-use IMPL::declare {
-	require => {
-	   Loader => 'IMPL::Code::Loader',
-	   Exception => 'IMPL::Exception'
-	},
-	base => [
-	   'IMPL::Object' => undef,
-	   'IMPL::Object::Autofill' => '@_',
-	   'IMPL::Object::PublicSerializable' => undef
-	],
-	props => [
-	   factory => PROP_RW,
-	   parameters => PROP_RW,
-	   singleCall => PROP_RW,
-	   _object => PROP_RW
-	]
-};
-
-use constant {
-	SELF_CLASS => __PACKAGE__,
-};
-
-sub CTOR {
-    my $this = shift;
-
-    die Exception->new("A factory parameter is required") unless $this->factory;
-    
-}
-
-
-sub activate {
-    my $this = shift;
-    
-    unless ($this->_object) {
-        my @args;
-        
-        my $params = $this->parameters;
-        if (ref $params eq 'HASH') {
-            while ( my ($key,$value) = each %$params ) {
-                push @args,$key, is($value,SELF_CLASS) ? $value->activate : $value;
-            }
-        } elsif (ref $params eq 'ARRAY') {
-            push @args, map is($_,SELF_CLASS) ? $_->activate : $_, @$params;
-        } else {
-            push @args, is($params,SELF_CLASS) ? $params->activate : $params;
-        }
-        
-        push @args,  map is($_,SELF_CLASS) ? $_->activate : $_, @_ if @_;
-        
-        my $factory = $this->factory;
-        Loader->default->Require($factory)
-            unless ref($factory);
-        
-        my $instance = $factory->new(@args);
-        
-        $this->_object($instance)
-            unless $this->singleCall;
-        
-        return $instance;
-    } else {
-        return $this->_object;
-    }
-}
-
-1;
-
-__END__
-
-=pod
-
-=head1 NAME
-
-C<IMPL::Config::Activator> - объект, используемый для получения других объектов.
-
-=head1 DESCRIPTION
-
-Служит дополнительным уровнем абстракции в тех случаях, когда нужный объект
-заранее не известен или его создание должно происходить по требованию.
-От обычной фабрики отличается также тем, что рассматривает формальные параметры
-на наличие активаторов и выполняет их при активации.
-
-Кроме того можно указать, что процесс активации должен происходить при каждом
-обращении. 
-
-=cut
--- a/lib/IMPL/Config/Container.pm	Sat Feb 25 22:35:26 2017 +0300
+++ b/lib/IMPL/Config/Container.pm	Sun Jul 16 22:59:39 2017 +0300
@@ -111,7 +111,7 @@
 
     foreach my $service (@$all) {
         $context = ActivationContext->new($this)
-          unless $context || $opts{shared};
+          unless $context && $opts{shared};
 
         push @result, $service->Activate($context);
     }
--- a/lib/IMPL/Config/Descriptor.pm	Sat Feb 25 22:35:26 2017 +0300
+++ b/lib/IMPL/Config/Descriptor.pm	Sun Jul 16 22:59:39 2017 +0300
@@ -10,39 +10,39 @@
 sub ACTIVATE_CALL()      { 5 }
 
 my %activateNames = (
-	singleton => ACTIVATE_SINGLETON,
-	container => ACTIVATE_CONTAINER,
-	hierarchy => ACTIVATE_HIERARCHY,
-	context   => ACTIVATE_CONTEXT,
-	call      => ACTIVATE_CALL
+    singleton => ACTIVATE_SINGLETON,
+    container => ACTIVATE_CONTAINER,
+    hierarchy => ACTIVATE_HIERARCHY,
+    context   => ACTIVATE_CONTEXT,
+    call      => ACTIVATE_CALL
 );
 
-my %activateNamesLookup = map { $activateNames{$_}, $_ } keys %activateNames;
+my %activateNamesLookup = reverse %activateNames;
 
 sub Activate {
-	my ( $this, $context ) = @_;
-	die IMPL::NotImplementedException->new();
+    my ( $this, $context ) = @_;
+    die IMPL::NotImplementedException->new();
 }
 
 sub ParseActivation {
-	my $val = pop @_;
+    my $val = pop @_;
 
-	return ACTIVATE_CALL unless $val;
+    return ACTIVATE_CALL unless $val;
 
-	return grep $_ == $val,
-	  ACTIVATE_SINGLETON,
-	  ACTIVATE_CONTAINER,
-	  ACTIVATE_HIERARCHY,
-	  ACTIVATE_CONTEXT, ACTIVATE_CALL ? $val : ACTIVATE_CALL
-	  if looks_like_number($val);
+    return grep( $_ == $val,
+        ACTIVATE_SINGLETON,
+        ACTIVATE_CONTAINER,
+        ACTIVATE_HIERARCHY,
+        ACTIVATE_CONTEXT, ACTIVATE_CALL ) ? $val : ACTIVATE_CALL
+      if looks_like_number($val);
 
-	return $activateNames{ lc($val) } || ACTIVATE_CALL;
+    return $activateNames{ lc($val) } || ACTIVATE_CALL;
 }
 
 sub ActivationToString {
-	my $val = pop @_;
+    my $val = pop @_;
 
-	return ( $val && $activateNamesLookup{$val} ) || '';
+    return ( $val && $activateNamesLookup{$val} ) || '';
 }
 
 1;
--- a/lib/IMPL/Config/Include.pm	Sat Feb 25 22:35:26 2017 +0300
+++ /dev/null	Thu Jan 01 00:00:00 1970 +0000
@@ -1,18 +0,0 @@
-package IMPL::Config::Include;
-use strict;
-use warnings;
-use IMPL::require {
-    Conf => 'IMPL::Config',
-    Exception => 'IMPL::Exception'
-};
-
-
-sub restore {
-	my ($self,$data) = @_;
-	
-	die Exception->new("A file name is required") if ref $data || not $data;
-	
-	return Conf->spawn($data);
-}
-
-1;
\ No newline at end of file
--- a/lib/IMPL/Config/Path.pm	Sat Feb 25 22:35:26 2017 +0300
+++ /dev/null	Thu Jan 01 00:00:00 1970 +0000
@@ -1,29 +0,0 @@
-package IMPL::Config::Path;
-use strict;
-use IMPL::Config();
-
-use IMPL::require {
-	Exception => 'IMPL::Exception',
-	OpException => '-IMPL::InvalidOperationException'
-};
-
-sub restore {
-	my ($self,$data,$surrogate) = @_;
-	
-	die OpException->new("Invalid content") unless ref $data eq 'ARRAY' && @$data == 2;
-	
-	my ($base,$path) = @$data;
-	
-	my %types = (
-	   appBase => 'AppDir',
-	   configBase => 'ConfigDir'
-	);
-	
-	my $method = $types{$base};
-	
-	die OpException->new("Unsupported path type",$base) unless $method;
-	
-	return IMPL::Config->$method($path);
-}
-
-1;
\ No newline at end of file
--- a/lib/IMPL/Config/Reference.pm	Sat Feb 25 22:35:26 2017 +0300
+++ /dev/null	Thu Jan 01 00:00:00 1970 +0000
@@ -1,92 +0,0 @@
-package IMPL::Config::Reference;
-use strict;
-
-use IMPL::Exception;
-
-sub restore {
-	my ($self,$data,$surrogate) = @_;
-	
-	my @path;
-	
-	my ($tagTarget,$target) = splice @$data, 0, 2;
-	
-	die new IMPL::Exception('A traget tag must be the first tag in the reference specification') unless $tagTarget eq 'target';
-	while(my ($method,$args) = splice @$data, 0, 2 ) {
-		$target = $self->_InvokeMember($target,{ method => $method, args => $args});
-	}
-	return $target;
-}
-
-sub _InvokeMember {
-    my ($self,$object,$member) = @_;
-    
-    my $method = $member->{method};
-    return 
-        ref $object eq 'HASH' ?
-            $object->{$method}
-            :
-            $object->$method(
-                exists $member->{args} ?
-                    _as_list($member->{args})
-                    :
-                    ()
-            )
-    ;
-}
-
-sub _as_list {
-    ref $_[0] ?
-        (ref $_[0] eq 'HASH' ?
-            %{$_[0]}
-            :
-            (ref $_[0] eq 'ARRAY'?
-                @{$_[0]}
-                :
-                $_[0]
-            )
-        )
-        :
-        ($_[0]);
-}
-
-1;
-
-__END__
-
-=pod
-
-=head1 NAME
-
-C<IMPL::Config::Reference> - ссылка на внешний объект, вычисляемый на этапе десериализации данных.
-
-=head1 SYNOPSIS
-
-=begin code xml
-
-<Application>
-	<processingStack type="IMPL::Config::Reference">
-	   <target>IMPL::Config</target>
-	   <LoadXMLFile>stdprocessing.xml</LoadXMLFile>
-	</processingStack>
-</Application>
-
-=end code xml
-
-=head1 DESCRIPTION
-
-Позволяет на указвать ссылки на вычисляемые объекты, например, загружаемые из файлов. Ссылки такого рода
-будут вычислены на этапе десериализации еще до того, как будет создан объект верхнего уровня, поэтому
-следует избегать таких ссылок на сам (его свойства и методы) десериализуемый объект.  
-
-=head1 MEMBERS
-
-=head2 C<restore($class,$data,$surrogate)>
-
-Использует данные переданные в параметре дата C<$data> для вычисления свойства. Данный метод - стандартный
-метод для десериализации объекта, а параметр C<$data> содержит пары значений C<(имя_узла,значение_узла)>,
-первая пара обязательно является узлом C<target>, а его значение - целевой объект, который будет
-использован для вычисления конечного значения.
-
-=back
-
-=cut
\ No newline at end of file
--- a/lib/IMPL/Config/ReferenceDescriptor.pm	Sat Feb 25 22:35:26 2017 +0300
+++ b/lib/IMPL/Config/ReferenceDescriptor.pm	Sun Jul 16 22:59:39 2017 +0300
@@ -38,20 +38,22 @@
 
 	my $ref = $this->reference;
 	my %opts;
+	my $inst;
 	$opts{default} = $this->default
 	  if $this->optional;
 
 	if ( $this->lazy ) {
 		my $clone = $context->Clone();
-		return sub {
+		$inst = sub {
 			$clone->Resolve( $ref, %opts );
 		};
 	}
 	else {
-		return $context->Resolve( $ref, %opts );
+		$inst = $context->Resolve( $ref, %opts );
 	}
 
 	$context->LeaveScope();
+	return $inst;
 }
 
 1;
--- a/lib/IMPL/Config/Resolve.pm	Sat Feb 25 22:35:26 2017 +0300
+++ /dev/null	Thu Jan 01 00:00:00 1970 +0000
@@ -1,77 +0,0 @@
-package IMPL::Config::Resolve;
-use strict;
-use parent qw(IMPL::Object IMPL::Object::Serializable);
-
-use IMPL::Class::Property;
-use IMPL::Exception;
-use Carp qw(carp);
-
-BEGIN {
-    public property path => prop_all|prop_list;
-}
-
-__PACKAGE__->PassThroughArgs;
-
-sub CTOR {
-    my $this = shift;
-    
-    my $list = $this->path;
-    
-    while(my $name = shift ) {
-        my $args = shift;
-        $list->Append({ method => $name, (defined $args ? (args => $args) : ()) });
-    }
-    
-    #die new IMPL::InvalidArgumentException("The argument is mandatory","path") unless $this->path->Count;
-}
-
-sub Invoke {
-    my ($this,$target,$default) = @_;
-    
-    my $result = $target;
-    $result = $this->_InvokeMember($result,$_) || return $default foreach $this->path;
-    
-    return $result;
-}
-
-sub _InvokeMember {
-    my ($self,$object,$member) = @_;
-    
-    my $method = $member->{method};
-    
-    local $@;
-    return eval {
-        ref $object eq 'HASH' ?
-            $object->{$method}
-            :
-            $object->$method(
-                exists $member->{args} ?
-                    _as_list($member->{args})
-                    :
-                    ()
-            )
-    };
-}
-
-sub save {
-    my ($this,$ctx) = @_;
-    
-    $ctx->AddVar($_->{method},$_->{args}) foreach $this->path;
-}
-
-sub _as_list {
-    ref $_[0] ?
-        (ref $_[0] eq 'HASH' ?
-            %{$_[0]}
-            :
-            (ref $_[0] eq 'ARRAY'?
-                @{$_[0]}
-                :
-                $_[0]
-            )
-        )
-        :
-        ($_[0]);
-}
-
-1;
--- a/lib/IMPL/Config/ServiceDescriptor.pm	Sat Feb 25 22:35:26 2017 +0300
+++ b/lib/IMPL/Config/ServiceDescriptor.pm	Sun Jul 16 22:59:39 2017 +0300
@@ -4,103 +4,101 @@
 use IMPL::lang qw(:base);
 use IMPL::Exception();
 use IMPL::declare {
-	require => {
-		Bag                 => 'IMPL::Config::Bag',
-		ActivationException => 'IMPL::Config::ActivationException'
-	},
-	base => [
-		'IMPL::Object'             => undef,
-		'IMPL::Config::Descriptor' => undef
-	],
-	props => [
-		type       => 'r',
-		activation => 'r',
-		args       => 'r',
-		services   => 'r',
-		norequire  => 'r',
-		owner      => 'r',
-		_name      => 'rw',
-		_loaded    => 'rw'
-	]
+    require => {
+        Bag                 => 'IMPL::Config::Bag',
+        ActivationException => 'IMPL::Config::ActivationException'
+    },
+    base => [
+        'IMPL::Object'             => undef,
+        'IMPL::Config::Descriptor' => undef
+    ],
+    props => [
+        type       => 'r',
+        activation => 'r',
+        args       => 'r',
+        services   => 'r',
+        norequire  => 'r',
+        owner      => 'r',
+        _name      => 'rw',
+        _loaded    => 'rw'
+    ]
 };
 
 sub CTOR {
-	my ( $this, %opts ) = @_;
+    my ( $this, %opts ) = @_;
 
-	$this->type( $opts{type} )
-	  or die IMPL::InvalidArgumentException->new('type');
-	$this->owner( $opts{owner} )
-	  or die IMPL::InvalidArgumentException->new('owner');
+    $this->type( $opts{type} )
+      or die IMPL::InvalidArgumentException->new('type');
+    $this->owner( $opts{owner} )
+      or die IMPL::InvalidArgumentException->new('owner');
 
-	$this->activation( SELF->ParseActivation( $opts{activation} ) );
-	$this->args( $opts{args} )           if exists $opts{args};
-	$this->services( $opts{services} )   if exists $opts{services};
-	$this->norequire( $opts{norequire} ) if exists $opts{norequire};
+    $this->activation( SELF->ParseActivation( $opts{activation} ) );
+    $this->args( $opts{args} )           if exists $opts{args};
+    $this->services( $opts{services} )   if exists $opts{services};
+    $this->norequire( $opts{norequire} ) if exists $opts{norequire};
 
-	$this->_name( 'new {'
-		  . SELF->ActivationToString( $this->activation )
-		  . '} '
-		  . $this->type );
+    $this->_name( 'new {'
+          . SELF->ActivationToString( $this->activation ) . '} '
+          . $this->type );
 }
 
 sub Activate {
-	my ( $this, $context ) = @_;
+    my ( $this, $context ) = @_;
 
-	my $instance;
-	$context->EnterScope( $this->_name, $this->services );
+    my $instance;
+    $context->EnterScope( $this->_name, $this->services );
 
-	my $activation = $this->activation;
-	my $cache;
+    my $activation = $this->activation;
+    my $cache;
 
-	if ( $activation == SELF->ACTIVATE_SINGLETON ) {
-		$cache = $context->container->root->instances;
-	}
-	elsif ( $activation == SELF->ACTIVATE_CONTAINER ) {
-		$cache = $this->owner->instances;
-	}
-	elsif ( $activation == SELF->ACTIVATE_HIERARCHY ) {
-		$cache = $context->container->instances;
-	}
-	elsif ( $activation == SELF->ACTIVATE_CONTEXT ) {
-		$cache = $context->instances;
-	}
+    if ( $activation == SELF->ACTIVATE_SINGLETON ) {
+        $cache = $context->container->root->instances;
+    }
+    elsif ( $activation == SELF->ACTIVATE_CONTAINER ) {
+        $cache = $this->owner->instances;
+    }
+    elsif ( $activation == SELF->ACTIVATE_HIERARCHY ) {
+        $cache = $context->container->instances;
+    }
+    elsif ( $activation == SELF->ACTIVATE_CONTEXT ) {
+        $cache = $context->instances;
+    }
 
-	$instance = $cache->{ ref($this) } if $cache;
-	unless ($instance) {
-		$instance = $this->CreateInstance($context);
-	}
+    $instance = $cache->{ ref($this) } if $cache;
+    unless ($instance) {
+        $instance = $this->CreateInstance($context);
+        $cache->{ ref($this) } = $instance if $cache;
+    }
 
-	$cache->{ ref($this) } = $instance if $cache;
+    $context->LeaveScope();
 
-	$context->LeaveScope();
-
-	return $instance;
+    return $instance;
 }
 
 sub CreateInstance {
-	my ( $this, $context ) = @_;
+    my ( $this, $context ) = @_;
 
-	my $class =
-	    $this->norequire
-	  ? $this->type
-	  : $context->container->Require( $this->type );
+    my $class =
+        $this->norequire
+      ? $this->type
+      : $context->container->Require( $this->type );
 
-	my $args = $this->args ? $this->args->Activate($context) : undef;
+    my $args = $this->args ? $this->args->Activate($context) : undef;
 
-	if ( defined $args ) {
-		if ( isarray($args) ) {
-			return $class->new(@$args);
-		}
-		elsif ( ishash($args) ) {
-			return $class->new(%$args);
-		}
-		else {
-			return $class->new($args);
-		}
-	}
-	else {
-		return $class->new();
-	}
+    if ( defined $args ) {
+        if ( isarray($args) ) {
+            return $class->new(@$args);
+        }
+        elsif ( ishash($args) ) {
+            return $class->new(%$args);
+        }
+        else {
+            return $class->new($args);
+        }
+    }
+    else {
+        return $class->new();
+    }
 }
 
 1;
--- a/lib/IMPL/Config/ValueDescriptor.pm	Sat Feb 25 22:35:26 2017 +0300
+++ b/lib/IMPL/Config/ValueDescriptor.pm	Sun Jul 16 22:59:39 2017 +0300
@@ -3,52 +3,58 @@
 
 use IMPL::lang qw(:base);
 use IMPL::declare {
-	require => {
-		Descriptor => 'IMPL::Config::Descriptor'
-	},
-	base => [
-		'IMPL::Object' => undef,
-		'Descriptor'   => undef
-	],
-	props => [
-		value => 'rw',
-		raw   => 'rw'
-	]
+    require => {
+        Descriptor => 'IMPL::Config::Descriptor'
+    },
+    base => [
+        'IMPL::Object' => undef,
+        'Descriptor'   => undef
+    ],
+    props => [
+        value    => 'rw',
+        raw      => 'rw',
+        services => 'rw'
+    ]
 };
 
 sub CTOR {
-	my ( $this, $value, $raw ) = @_;
+    my ( $this, $value, %opts) = @_;
 
-	$this->value($value);
-	$this->raw($raw);
+    $this->value($value);
+    $this->raw($opts{raw}) if exists $opts{raw};
+    $this->services($opts{services}) if exists $opts{services};
 }
 
 sub Activate {
-	my ( $this, $context ) = @_;
+    my ( $this, $context ) = @_;
+    return $this->value if $this->raw;
+
+    my $services = $this->services;
 
-	return $this->raw
-	  ? $this->value
-	  : $this->_ActivateValue( $this->value, $context );
+    $context->EnterScope( '$value: ' . $this->value, $services ) if $services;
+    my $value = $this->_ActivateValue( $this->value, $context );
+    $context->LeaveScope() if $services;
+    return $value;
 }
 
 sub _ActivateValue {
-	my ( $this, $value, $context ) = @_;
+    my ( $this, $value, $context ) = @_;
 
-	if ( is( $value, Descriptor ) ) {
-		return $value->Activate($context);
-	}
-	elsif ( isarray($value) ) {
-		return [ map $this->_ActivateValue($_, $context), @$value ];
-	}
-	elsif ( ishash($value) ) {
-		return {
-			map { $_, $this->_ActivateValue( $value->{$_}, $context ) }
-			  keys %$value
-		};
-	}
-	else {
-		return $value;
-	}
+    if ( is( $value, Descriptor ) ) {
+        return $value->Activate($context);
+    }
+    elsif ( isarray($value) ) {
+        return [ map $this->_ActivateValue( $_, $context ), @$value ];
+    }
+    elsif ( ishash($value) ) {
+        return {
+            map { $_, $this->_ActivateValue( $value->{$_}, $context ) }
+              keys %$value
+        };
+    }
+    else {
+        return $value;
+    }
 }
 
 1;
--- a/lib/IMPL/Config/YAMLConfig.pm	Sat Feb 25 22:35:26 2017 +0300
+++ b/lib/IMPL/Config/YAMLConfig.pm	Sun Jul 16 22:59:39 2017 +0300
@@ -5,19 +5,135 @@
 use IMPL::Exception();
 use YAML::XS();
 
-sub Load {
-	my ( $this, $container, $file ) = @_;
+use IMPL::declare {
+    require => {
+        ReferenceDescriptor => 'IMPL::Config::ReferenceDescriptor',
+        ServiceDescriptor   => 'IMPL::Config::ServiceDescriptor',
+        ValueDescriptor     => 'IMPL::Config::ValueDescriptor'
+    },
+    base => [
+        'IMPL::Object' => undef
+    ],
+    props => [
+        container => 'ro'
+    ]
+};
 
-	$this->Configure( isscalar($file)
-		? YAML::XS::Load( ${$file} )
-		: YAML::XS::LoadFile($file) );
+sub CTOR {
+    my ( $this, $container ) = @_;
+    die IMPL::InvalidArgumentException('container')
+      unless $container;
+    $this->container($container);
+}
+
+sub LoadConfiguration {
+    my ( $this, $file ) = @_;
+
+    $this->Configure(
+          isscalar($file)
+        ? YAML::XS::Load( ${$file} )
+        : YAML::XS::LoadFile($file)
+    );
 }
 
 sub Configure {
-	my ( $this, $container, $config ) = @_;
-	
-	
+    my ( $this, $config ) = @_;
+
+    die IMPL::InvalidArgumentException('config')
+      unless ishash($config);
+
+    my $container = $this->container;
+    foreach my $item ( @{ $this->ParseServices( $config->{services} ) } ) {
+        $container->Register( $item->{role}, $item->{descriptor} );
+    }
+
+    return $container;
+}
+
+sub ParseServices {
+    my ( $this, $services ) = @_;
+
+    return $services
+      ? [
+        map {
+            {
+                role       => delete $_->{name},
+                descriptor => $this->ParseDescriptor($_)
+            };
+        } @$services
+      ]
+      : undef;
+}
+
+sub ParseDescriptor {
+    my ( $this, $data ) = @_;
+
+    my %opts = ( onwer => $this->container() );
+
+    if ( my $type = $data->{'$type'} ) {
+        $opts{services} = $this->ParseServices( $data->{services} );
+        $opts{type}     = $type;
+        $opts{args}     = $this->ParseDescriptor( $data->{params} )
+          if $data->{params};
+        $opts{norequire}  = $data->{norequire};
+        $opts{activation} = $data->{activation};
 
+        return ServiceDescriptor->new(%opts);
+    }
+    elsif ( my $dep = $data->{'$ref'} ) {
+        $opts{services} = $this->ParseServices( $data->{services} );
+        $opts{lazy}     = $data->{lazy};
+        $opts{optional} = $data->{optional};
+        $opts{default}  = $this->ParseDescriptor( $data->{default} )
+          if exists $data->{default};
+
+        return ReferenceDesriptor->new( $dep, %opts );
+    }
+    elsif ( my $value = $data->{'$value'} ) {
+        my ( $parsed, $raw ) = $this->ParseValue($value);
+        $opts{services} = $this->ParseServices( $data->{services} );
+        $opts{raw}      = $raw;
+        return ValueDescriptor->new( $parsed, %opts );
+    }
+    else {
+        my ( $parsed, $raw ) = $this->ParseValue($value);
+        $opts{raw} = $raw;
+        return ValueDescriptor->new( $parsed, %opts );
+    }
+}
+
+sub ParseValue {
+    my ( $this, $value ) = @_;
+
+    my $raw = 1;
+
+    if ( ishash($value) ) {
+        return ( $this->ParseDescriptor($value), 0 )
+          if grep exists $value->{$_}, qw($type $ref $value);
+
+        my %res;
+        while ( my ( $k, $v ) = each %$value ) {
+            my ( $parsed, $flag ) = $this->ParseValue($v);
+            $res{$k} = $parsed;
+            $raw &&= $flag;
+        }
+        return ( \%res, $raw );
+    }
+    elsif ( isarray($value) ) {
+        return (
+            [
+                map {
+                    my ( $parsed, $flag ) = $this->ParseValue($_);
+                    $raw &&= $flag;
+                    return $parsed;
+                } @$value
+            ],
+            $raw
+        );
+    }
+    else {
+        return ($value, 1);
+    }
 }
 
 1;
@@ -26,5 +142,10 @@
 
 =pod
 
+=head1 NAME
+
+=head1 SYNOPSIS
+
+=
 
 =cut
--- a/lib/IMPL/lang.pm	Sat Feb 25 22:35:26 2017 +0300
+++ b/lib/IMPL/lang.pm	Sun Jul 16 22:59:39 2017 +0300
@@ -22,29 +22,6 @@
           &isglob
           )
     ],
-
-    declare => [
-        qw(
-          &public
-          &protected
-          &private
-          &property
-          &static
-          &property
-          &_direct
-          &ACCESS_PUBLIC
-          &ACCESS_PROTECTED
-          &ACCESS_PRIVATE
-          &PROP_GET
-          &PROP_SET
-          &PROP_OWNERSET
-          &PROP_LIST
-          &PROP_ALL
-          &PROP_RO
-          &PROP_RW
-          &PROP_DIRECT
-          )
-    ],
     compare => [
         qw(
           &equals
@@ -64,98 +41,45 @@
     ]
 );
 
-our @EXPORT_OK = keys %{ { map (($_,1) , map (@{$_}, values %EXPORT_TAGS) ) } };
+our @EXPORT_OK =
+  keys %{ { map ( ( $_, 1 ), map ( @{$_}, values %EXPORT_TAGS ) ) } };
 
 use IMPL::Const qw(:all);
 
 sub is {
     carp "A typename can't be undefined" unless $_[1];
-    blessed($_[0]) and $_[0]->isa( $_[1] );
+    blessed( $_[0] ) and $_[0]->isa( $_[1] );
 }
 
 sub isclass {
     carp "A typename can't be undefined" unless $_[1];
     local $@;
-    eval {not ref $_[0] and $_[0]->isa( $_[1] ) };
+    eval { not ref $_[0] and $_[0]->isa( $_[1] ) };
 }
 
 sub typeof(*) {
-    blessed($_[0]);
+    blessed( $_[0] );
 }
 
 sub isarray {
-	not blessed($_[0]) and ref $_[0] eq 'ARRAY';
+    not blessed( $_[0] ) and ref $_[0] eq 'ARRAY';
 }
 
 sub ishash {
-	not blessed($_[0]) and ref $_[0] eq 'HASH';
+    not blessed( $_[0] ) and ref $_[0] eq 'HASH';
 }
 
 sub isscalar {
-	not blessed($_[0]) and ref $_[0] eq 'SCALAR';
+    not blessed( $_[0] ) and ref $_[0] eq 'SCALAR';
 }
 
 sub isglob {
-	not blessed($_[0]) and ref $_[0] eq 'GLOB';
-}
-
-sub public($) {
-    my $info = shift;
-    $info->{access} = ACCESS_PUBLIC;
-    my $implementor = delete $info->{implementor};
-    $implementor->Implement($info);
-}
-
-sub private($) {
-    my $info = shift;
-    $info->{access} = ACCESS_PRIVATE;
-    my $implementor = delete $info->{implementor};
-    $implementor->Implement($info);
-}
-
-sub protected($) {
-    my $info = shift;
-    $info->{access} = ACCESS_PROTECTED;
-    my $implementor = delete $info->{implementor};
-    $implementor->Implement($info);
-}
-
-sub _direct ($) {
-    my $info = shift;
-    $info->{direct} = 1;
-    return $info;
-}
-
-sub property($$) {
-    my ($propName,$attributes) = @_;
-    
-    $attributes = {
-        get => $attributes & PROP_GET,
-        set => $attributes & PROP_SET,
-        isList => $attributes & PROP_LIST
-    } unless ref $attributes;
-    
-    my $class = caller;
-     
-    return hashMerge (
-        $attributes,
-        {
-            implementor => $class->ClassPropertyImplementor,
-            name => $propName,
-            class => scalar(caller),
-        }
-    );
-}
-
-sub static($$) {
-    my ( $name, $value ) = @_;
-    my $class = caller;
-    $class->static_accessor( $name, $value );
+    not blessed( $_[0] ) and ref $_[0] eq 'GLOB';
 }
 
 sub coarsen {
-	my ( $value, $resolution ) = @_;
-	return $resolution ? ceil( $value / $resolution ) * $resolution : $value;
+    my ( $value, $resolution ) = @_;
+    return $resolution ? ceil( $value / $resolution ) * $resolution : $value;
 }
 
 # datetime is DateTime object
@@ -176,117 +100,109 @@
 }
 
 sub equals {
-    if (defined $_[0]) {
-        return 0 if (not defined $_[1]);
-        
+    if ( defined $_[0] ) {
+        return 0 if ( not defined $_[1] );
+
         return $_[0] == $_[1];
-    }  else {
+    }
+    else {
         return 0 if defined $_[1];
-        
+
         return 1;
     }
 }
 
 sub equals_s {
-    if (defined $_[0]) {
-        return 0 if (not defined $_[1]);
-        
+    if ( defined $_[0] ) {
+        return 0 if ( not defined $_[1] );
+
         return $_[0] eq $_[1];
-    }  else {
+    }
+    else {
         return 0 if defined $_[1];
-        
+
         return 1;
     }
 }
 
 sub hashDiff {
-    my ($src,$dst) = @_;
-    
-    $dst = $dst ? { %$dst } : {} ;
+    my ( $src, $dst ) = @_;
+
+    $dst = $dst ? {%$dst} : {};
     $src ||= {};
-    
+
     my %result;
-    
+
     foreach my $key ( keys %$src ) {
-        if (exists $dst->{$key}) {
-            $result{"+$key"} = $dst->{$key} unless equals_s($dst->{$key}, $src->{$key});
+        if ( exists $dst->{$key} ) {
+            $result{"+$key"} = $dst->{$key}
+              unless equals_s( $dst->{$key}, $src->{$key} );
             delete $dst->{$key};
-        } else {
+        }
+        else {
             $result{"-$key"} = 1;
         }
     }
-    
+
     $result{"+$_"} = $dst->{$_} foreach keys %$dst;
-    
+
     return \%result;
 }
 
 sub hashMerge {
-    return hashApply( { %{$_[0] || {}} }, $_[1] );
+    return hashApply( { %{ $_[0] || {} } }, $_[1] );
 }
 
 sub hashApply {
-    my ($target,$diff) = @_;
-    
+    my ( $target, $diff ) = @_;
+
     return $target unless ref $diff eq 'HASH';
-    
-    while ( my ($key,$value) = each %$diff) {
+
+    while ( my ( $key, $value ) = each %$diff ) {
         $key =~ /^(\+|-)?(.*)$/;
         my $op = $1 || '+';
         $key = $2;
-        
-        if ($op eq '-') {
+
+        if ( $op eq '-' ) {
             delete $target->{$key};
-        } else {
+        }
+        else {
             $target->{$key} = $value;
         }
     }
-    
+
     return $target;
 }
 
 sub hashCompare {
-    my ($l,$r,$cmp) = @_;
-    
+    my ( $l, $r, $cmp ) = @_;
+
     $cmp ||= \&equals_s;
-    
+
     return 0 unless scalar keys %$l == scalar keys %$r;
-    &$cmp($l->{$_},$r->{$_}) || return 0 foreach keys %$l;
-    
+    &$cmp( $l->{$_}, $r->{$_} ) || return 0 foreach keys %$l;
+
     return 1;
 }
 
 sub hashParse {
-    my ($s,$p,$d) = @_;
-    
+    my ( $s, $p, $d ) = @_;
+
     $p = $p ? qr/$p/ : qr/\n+/;
     $d = $d ? qr/$d/ : qr/\s*=\s*/;
-    
-    return {
-        map split($d,$_,2), split($p,$s)
-    };
+
+    return { map split( $d, $_, 2 ), split( $p, $s ) };
 }
 
 sub hashSave {
-    my ($hash,$p,$d) = @_;
-    
+    my ( $hash, $p, $d ) = @_;
+
     return "" unless ref $hash eq 'HASH';
-    
+
     $p ||= "\n";
     $d ||= " = ";
-    
-    return
-        join(
-            $p,
-            map(
-                join(
-                    $d,
-                    $_,
-                    $hash->{$_}
-                ),
-                keys %$hash
-            )
-        );
+
+    return join( $p, map( join( $d, $_, $hash->{$_} ), keys %$hash ) );
 }
 
 1;