# HG changeset patch
# User cin
# Date 1503177641 -10800
# Node ID b0481c071bea109b14c67d5fd0ae2f221ef894a4
# Parent  7798345304bcc3c74d25116cdbd2694e74e25095
IMPL::Config::Container tests, YAMLConfiguration now works and tested

diff -r 7798345304bc -r b0481c071bea _test/Resources/container1.yaml
--- /dev/null	Thu Jan 01 00:00:00 1970 +0000
+++ b/_test/Resources/container1.yaml	Sun Aug 20 00:20:41 2017 +0300
@@ -0,0 +1,25 @@
+include:
+- inc/base1.yaml
+services:
+- name:
+  - foo
+  - jiz
+  $type: Test::Config::Foo
+  params: simple Foo
+  activation: container
+- name: bar
+  $type: Test::Config::Bar
+  params:
+    $value: simple Bar
+  activation: context
+- name: baz
+  $type: Test::Config::Foo
+  params:
+    $value:
+    - $ref: foo
+    - $ref: foo
+- name: zoo
+  $type: Test::Config::Foo
+  params:
+  - $ref: jiz
+  - $ref: foo
\ No newline at end of file
diff -r 7798345304bc -r b0481c071bea _test/Resources/inc/base1.yaml
--- /dev/null	Thu Jan 01 00:00:00 1970 +0000
+++ b/_test/Resources/inc/base1.yaml	Sun Aug 20 00:20:41 2017 +0300
@@ -0,0 +1,6 @@
+include:
+- ../container1.yaml
+services:
+- name: base
+  $type: Test::Config::Foo
+  params: base 
\ No newline at end of file
diff -r 7798345304bc -r b0481c071bea _test/Test/Config/Container.pm
--- a/_test/Test/Config/Container.pm	Sun Jul 16 22:59:39 2017 +0300
+++ b/_test/Test/Config/Container.pm	Sun Aug 20 00:20:41 2017 +0300
@@ -1,17 +1,21 @@
 package Test::Config::Container;
 use strict;
 
+sub true() { 1 }
+sub false() { 0 }
+
 {
+
     package Test::Config::Container::Baz;
     use IMPL::declare {
         base => {
             'IMPL::Object' => undef
         },
         props => [
-          value => 'r'
+            value => 'r'
         ]
     };
-    
+
     sub CTOR {
         my $this = shift;
         $this->value(shift);
@@ -19,35 +23,138 @@
 }
 
 use IMPL::declare {
-	require => {
-		Container => 'IMPL::Config::Container',
-		
-	},
-	base => {
-		'IMPL::Test::Unit' => '@_'
-	}
+    require => {
+        Container => 'IMPL::Config::Container',
+        Service   => 'IMPL::Config::ServiceDescriptor',
+        Value     => 'IMPL::Config::ValueDescriptor',
+        Reference => 'IMPL::Config::ReferenceDescriptor',
+        YAMLConfig => 'IMPL::Config::YAMLConfig'
+    },
+    base => {
+        'IMPL::Test::Unit' => '@_'
+    }
 };
+use File::Spec();
 use IMPL::Test qw(test assert failed);
+use IMPL::lang qw(:base);
 
 test CreateContainer => sub {
-	my $c1 = Container->new();
-};
-
-test RegisterServices => sub {
-	my $c1 = Container->new();
-	
-	$c1->Register( 'db' => Service->new(
-        type => 'Foo::Data',
-        norequire => 1,
-        activation => 'container'
-    ));
-	
-	return $c1;
-};
-
-test ResolveServices => sub {
-	
+    my $c1 = Container->new();
+    $c1->Dispose();
 };
 
 
-1;
\ No newline at end of file
+
+sub RegisterServices {
+    my $c1 = Container->new();
+
+    my %config = (
+        'db' => Service->new(
+            type       => 'Foo::Data',
+            norequire  => 1,
+            activation => 'container'
+        ),
+        foo => Service->new(
+            type       => 'Test::Config::Foo',
+            activation => 'container'
+        ),
+        bar => Service->new(
+            type       => 'Test::Config::Bar',
+            activation => 'context'
+        ),
+        boogie => Value->new(
+            {
+                foo   => Reference->new('foo'),
+                bar   => Reference->new('bar'),
+                lazyb => Reference->new( 'bar', lazy => 1 ),
+                opt   => Reference->new(
+                    'no-such-ref',
+                    optional => 1,
+                    default  => 'def-opt'
+                )
+            }
+        )
+    );
+    
+    while(my ($name, $d) = each %config) {
+        $c1->Register($name, $d);
+    }
+
+    return $c1->AutoPtr();
+};
+
+test RegisterServices => \&RegisterServices;
+
+test ResolveServices => sub {
+    my $this = shift;
+    my $c = $this->RegisterServices();
+    
+    my $foo = $c->Resolve('foo');
+    assert(is($foo, "Test::Config::Foo"), "foo is: $foo");
+    
+    my $foo2 = $c->Resolve('foo');
+    assert($foo == $foo2);
+    
+    my $bar = $c->Resolve('bar');
+    assert(is($bar, "Test::Config::Bar"));
+    
+    my $bar2 = $c->Resolve('bar');
+    
+    assert($bar != $bar2);
+    
+    my $boogie = $c->Resolve('boogie');
+    assert(ishash($boogie));
+    assert(is($boogie->{foo}, "Test::Config::Foo"));
+    
+    $bar = $boogie->{bar};
+    my $lazyb = $boogie->{lazyb};
+    assert(ref $lazyb eq 'CODE');
+    $bar2 = $lazyb->();
+    my $bar3 = $lazyb->();
+    
+    #test context activation with lazy
+    assert($bar == $bar2);
+    assert($bar == $bar3);
+    
+    my $bar4 = $c->Resolve('bar');
+    #new context, new bar
+    assert($bar != $bar4);
+    
+    my $opt = $boogie->{opt};
+    assert($opt eq 'def-opt');
+};
+
+sub LoadYamlConfig {
+    my $config = YAMLConfig->new();
+    $config->Load(File::Spec->catfile('Resources', 'container1.yaml'));
+    my $container = Container->new();
+    $config->ConfigureContainer($container);
+    return $container->AutoPtr(); 
+}
+
+test LoadYamlConfig => \&LoadYamlConfig;
+test ResolveYamlConfig => sub {
+    my $this = shift;
+    
+    my $c = $this->LoadYamlConfig();
+    
+    my $foo = $c->Resolve('foo');
+    assert(is($foo, "Test::Config::Foo"), "foo is: $foo");
+    
+    my $foo2 = $c->Resolve('foo');
+    assert($foo == $foo2);
+    
+    my $bar = $c->Resolve('bar');
+    assert(is($bar, "Test::Config::Bar"));
+    
+    my $bar2 = $c->Resolve('bar');
+    
+    assert($bar != $bar2);
+    
+    my $baz = $c->Resolve('baz');
+    assert(is($baz, "Test::Config::Foo"));
+    assert(isarray($baz->value));
+    assert($baz->value->[0] == $baz->value->[1]);
+};
+
+1;
diff -r 7798345304bc -r b0481c071bea _test/config.t
--- a/_test/config.t	Sun Jul 16 22:59:39 2017 +0300
+++ b/_test/config.t	Sun Aug 20 00:20:41 2017 +0300
@@ -3,8 +3,18 @@
 use lib '../Lib';
 use lib '.';
 
+use IMPL::Debug();
 use IMPL::Test qw(run_plan);
 
+$IMPL::Debug::ENABLE{'IMPL::Config::YAMLConfig'} = 1;
+
+IMPL::Debug->subscribe(sub {
+    my $text = join('', @_);
+    
+    $text =~ s/^/# /gm;
+    print "$text\n"; 
+});
+
 run_plan( qw(
     Test::Config::Container
 ) );
diff -r 7798345304bc -r b0481c071bea _test/defaults.yaml
diff -r 7798345304bc -r b0481c071bea _test/sample.yaml
--- a/_test/sample.yaml	Sun Jul 16 22:59:39 2017 +0300
+++ b/_test/sample.yaml	Sun Aug 20 00:20:41 2017 +0300
@@ -13,8 +13,6 @@
 - name: security-provider
   $type: My::SecureCookies
   params:
-    users:
-      $ref: users-provider
-    roles:
-      $ref: roles-provider
+    users: { $ref: users-provider }
+    roles: { $ref: roles-provider }
     persistent: 0
\ No newline at end of file
diff -r 7798345304bc -r b0481c071bea _test/secrets.yaml
diff -r 7798345304bc -r b0481c071bea _test/temp.pl
--- a/_test/temp.pl	Sun Jul 16 22:59:39 2017 +0300
+++ b/_test/temp.pl	Sun Aug 20 00:20:41 2017 +0300
@@ -4,30 +4,34 @@
 use Time::HiRes qw(gettimeofday tv_interval);
 use Scalar::Util qw(blessed refaddr);
 use YAML::XS qw(Dump Load);
-
+use Data::Dumper;
+use URI;
 
 
 use IMPL::require {
 	Container => 'IMPL::Config::Container',
 	Service => 'IMPL::Config::ServiceDescriptor',
 	Reference => 'IMPL::Config::ReferenceDescriptor',
-	Value => 'IMPL::Config::ValueDescriptor'
+	Value => 'IMPL::Config::ValueDescriptor',
+	YAMLConfig => 'IMPL::Config::YAMLConfig'
 };
 
-my $data;
-{
-	open my $h, "<", "sample.yaml" or die;
-	print "H: ", *{$h}{IO}, "\n";
-	binmode $h;
-	local $/;
-	$data = <$h>;
-}
 
 my $t = [gettimeofday];
+my $config = YAMLConfig->new(load => 'sample.yaml');
+print "Loaded: ",tv_interval($t,[gettimeofday]),"\n";
 
-print Dump Load($data);
+my $container = Container->new()->AutoPtr;
+$config->ConfigureContainer($container);
 
-print "Activated: ",tv_interval($t,[gettimeofday]),"\n";
 
 
+print "Configured: ",tv_interval($t,[gettimeofday]),"\n";
+#print Data::Dumper->Dump([$container]);
+#$container->Dispose();
+
+my $base = URI->new('some/path');
+my $rel = URI->new('../other/path')->abs($base)->rel('/');
+print $rel,"\n";
+
 1;
diff -r 7798345304bc -r b0481c071bea _test/test_transform.pl
--- a/_test/test_transform.pl	Sun Jul 16 22:59:39 2017 +0300
+++ /dev/null	Thu Jan 01 00:00:00 1970 +0000
@@ -1,131 +0,0 @@
-use strict;
-package Person;
-use IMPL::lang qw(:declare);
-use IMPL::declare {
-	base => [
-		'IMPL::Object'           => undef,
-		'IMPL::Object::Autofill' => '@_'
-	]
-};
-
-BEGIN {
-	public property name      => PROP_ALL;
-	public property age       => PROP_ALL;
-	public property addresses => PROP_ALL | PROP_LIST;
-}
-
-package Address;
-use IMPL::lang qw(:declare);
-use IMPL::declare {
-	base => [
-		'IMPL::Object'           => undef,
-		'IMPL::Object::Autofill' => '@_'
-	]
-};
-
-BEGIN {
-	public property country => PROP_ALL;
-	public property city    => PROP_ALL;
-}
-
-package main;
-
-my $data = {
-	name      => 'Peter',
-	age       => '99',
-	addresses => {
-		address => [
-			{
-				country => 'Airot',
-				city    => 'Torhiq',
-				street => 'avenu1'
-			},
-			{
-				country => 'Olkson',
-				city    => 'Zoxs',
-				street => 'av2'
-			}
-		]
-	}
-};
-
-use Carp qw(confess);
-
-sub Rule(&) {
-	my ($block) = @_;
-	
-	return sub {
-        local $_ = shift;
-        $block->();
-    }
-}
-
-sub Inspect($$) {
-	my ($path,$block) = @_;
-    my $data = $_;
-    
-    foreach my $name (@$path) {
-    	$data = ref $data ? $data->{$name} : undef;
-    	print "$name = $data\n";
-    }
-    
-    local $_ = $data;
-    $block->($data);
-}
-
-sub Required(@);
-
-sub Required(@) {
-	if(@_) {
-	   Inspect([@_],Rule { Required });
-	} else {
-	   confess "required" unless $_;
-	}
-}
-
-sub Regexp($) {
-	my $rx = shift;
-	die "Regular expression doesn't match" unless m/$rx/; 
-}
-
-my $validate = Rule {
-	Required('name');
-	
-	Inspect ['age'] => Rule {
-		Regexp(qr/^\d+$/);
-		die "invalid person age" unless $_ > 0 && $_ < 200;
-	};
-	
-	Inspect ['addresses', 'address'] => Rule {
-		Required;
-		foreach(@{$_}) {
-            Required('street');
-		}
-	}
-};
-
-$validate->($data);
-
-my ($person) =
-  map {
-	Person->new(
-		name      => $_->{name},
-		age       => $_->{age},
-		addresses => [
-			map {
-				Address->new(
-					country => $_->{country},
-					city    => $_->{city}
-				  )
-			  } as_list( $_->{addresses}{address} )
-		]
-	  )
-  } $data;
-  
-use Data::Dumper;
-print Dumper($person);
-
-sub as_list {
-	return @{ $_[0] } if ref $_[0] eq 'ARRAY';
-	return @_;
-}
diff -r 7798345304bc -r b0481c071bea lib/IMPL/AppException.pm
--- a/lib/IMPL/AppException.pm	Sun Jul 16 22:59:39 2017 +0300
+++ b/lib/IMPL/AppException.pm	Sun Aug 20 00:20:41 2017 +0300
@@ -31,7 +31,7 @@
 	
 	$instance->source(shortmess);
 	$instance->callStack(longmess);
-    
+	
     return $instance;
 }
 
@@ -44,7 +44,7 @@
 sub throw {
 	my $self = shift;
 	
-	die $self->new(@_);
+	die ref $self ? $self : $self->new(@_);
 }
 
 1;
diff -r 7798345304bc -r b0481c071bea lib/IMPL/Config/ActivationContext.pm
--- a/lib/IMPL/Config/ActivationContext.pm	Sun Jul 16 22:59:39 2017 +0300
+++ b/lib/IMPL/Config/ActivationContext.pm	Sun Aug 20 00:20:41 2017 +0300
@@ -1,21 +1,23 @@
 package IMPL::Config::ActivationContext;
 
 use IMPL::lang qw(:base);
-use IMPL::Const qw(:prop);
 use IMPL::Exception();
 use IMPL::declare {
     require => {
-        Bag                      => 'IMPL::Config::ServicesBag',
+        Bag                      => 'IMPL::Config::Bag',
         ServiceNotFoundException => 'IMPL::Config::ServiceNotFoundException',
+        Descriptor               => '-IMPL::Config::Descriptor'
     },
     base => {
         'IMPL::Object' => '@_'
     },
     props => [
-        container => PROP_RW,
-        instances => PROP_RW,
-        _services => PROP_RW,
-        _stack    => PROP_RW
+        container => 'rw',
+        owner   => 'rw',
+        instances => 'rw',
+        name      => 'rw',
+        _services => 'rw',
+        _stack    => 'rw'
     ]
 };
 
@@ -24,15 +26,23 @@
 
     $this->container($container)
       or die IMPL::InvalidArgumentException->new('container');
+    $this->owner($container);
     $this->_services( $container->services );
     $this->instances( {} );
     $this->_stack( [] );
 }
 
 sub EnterScope {
-    my ( $this, $name, $services ) = @_;
+    my ( $this, $name, $services, $container ) = @_;
+
+    my $info = { name => $this->name };
 
-    my $info = { name => $name };
+    $this->name($name);
+
+    if ( $container && $this->container != $container ) {
+        $info->{container} = $this->container;
+        $this->container($container);
+    }
 
     if ($services) {
         die IMPL::InvalidArgumentException->new(
@@ -42,12 +52,11 @@
         my $bag = $this->container->serviceCache->{ ref($services) };
 
         unless ($bag) {
-            my $container = $this->container;
             $bag = Bag->new( $this->_services );
+            $bag->tag( $container || $this->container );
 
-            #
-            $bag->Register(
-                $container->GetLinearRoleHash( $_->{role}, $_->{descriptor} ) )
+            $bag->Register( $container->GetLinearRoleHash( $_->{role} ),
+                $_->{descriptor} )
               foreach @$services;
 
             $container->serviceCache->{ ref($services) } = $bag;
@@ -66,30 +75,45 @@
     my $info = pop @{ $this->_stack }
       or die IMPL::InvalidOperationException->new();
 
-    $this->_services( $info->{services} ) if $info->{services};
+    $this->name( $info->{name} );
+    $this->_services( $info->{services} )  if $info->{services};
+    $this->conatiner( $info->{container} ) if $info->{container};
 }
 
 sub Resolve {
     my ( $this, $role, %opts ) = @_;
 
-    my $d = $this->_services->Resolve($role);
+    #change of the container may occur only due resolution of the dependency
+    my ( $d, $bag ) = $this->_services->Resolve($role);
 
     unless ($d) {
-        die ServiceNotFoundException->new($role) unless $opts{optional};
+        die ServiceNotFoundException->new(serviceName => $role) unless $opts{optional};
         return $opts{default};
     }
     else {
-        return $d->Activate($this);
+        $this->EnterScope( $d->GetName(), $d->services(), $bag->tag() );
+        my $instance = $d->Activate($this);
+        $this->LeaveScope();
+        return $instance;
     }
 }
 
+sub Activate {
+    my ( $this, $d ) = @_;
+    $this->EnterScope( $d->GetName(), $d->services() );
+    my $instance = $d->Activate($this);
+    $this->LeaveScope();
+    return $instance;
+}
+
 sub Clone {
     my ($this) = @_;
 
-    my $clone = SELF->new( $this->container );
-
+    my $clone = SELF->new( $this->owner );
+    $clone->name($this->name);
+    $clone->container( $this->container );
     $clone->_services( $this->_services );
-    $clone->instances( { %{ $this->instances } } );
+    $clone->instances( $this->instances );
     $clone->_stack( [ @{ $this->_stack } ] );
 
     return $clone;
@@ -110,8 +134,33 @@
 
 =head1 MEMBERS
 
+=head2 PROPERTIES
+
+=head3 [get] container
+
+Current container for the activation context, this container changes
+during resolution process to match the one in which the resulting
+descriptor were defined. Descriptors can use this property to
+access the cache of theirs container.  
+
+=head3 [get] owner
+
+The container which created this context. Descriptors can use this
+property during theirs activation.
+
+=head3 [get] instances
+
+The activation cache which can be used to store instances during
+single resolution process.
+
 =head2 METHODS
 
-=head3 Resolve($serviceId)
+=head3 Resolve($serviceId): $instance
+
+Activates and returns an instance specified by C<$serviceId>
+
+=head3 Activate($descriptor): $instance
+
+Activates and returns an instance of the services for the specified descriptor/
 
 =cut
diff -r 7798345304bc -r b0481c071bea lib/IMPL/Config/Bag.pm
--- a/lib/IMPL/Config/Bag.pm	Sun Jul 16 22:59:39 2017 +0300
+++ b/lib/IMPL/Config/Bag.pm	Sun Aug 20 00:20:41 2017 +0300
@@ -3,164 +3,165 @@
 
 use IMPL::lang qw(:base);
 use IMPL::declare {
-	base => [
-		'IMPL::Object' => undef
-	],
-	props => [
-		_parents   => '*rw',    # array of parent bags
-		_parentRev => '*rw',    # the timestamp of the parent
-		_sealed    => '*rw',    # the bag has descendants
-		_cache     => '*rw',    # own or cached entries
-		_timestamp => '*rw',
-		_entries   => '*rw',    # each entry is represented by hash
-		  # { isa => linear_isa_hash, owner => owner_of_the_entry, value => value }
-	]
+    base => [
+        'IMPL::Object' => undef
+    ],
+    props => [
+        _parents   => '*rw',    # array of parent bags
+        _parentRev => '*rw',    # the timestamp of the parent
+        _sealed    => '*rw',    # the bag has descendants
+        _cache     => '*rw',    # own or cached entries
+        _timestamp => '*rw',
+        _entries   => '*rw',    # each entry is represented by hash
+          # { isa => linear_isa_hash, owner => owner_of_the_entry, value => value }
+        tag => 'rw'    # used to store additional information
+    ]
 };
 
 sub CTOR {
-	my ( $this, $p ) = @_;
+    my ( $this, $p ) = @_;
 
-	if ($p) {
-		$p->_Seal();
-		my @parents;
-		push @parents, @{ $p->{$_parents} } if $p->{$_parents};
-		push @parents, $p;
-		$this->{$_parents}   = \@parents;
-		$this->{$_parentRev} = $p->{$_timestamp};
-	}
+    if ($p) {
+        $p->_Seal();
+        my @parents;
+        push @parents, @{ $p->{$_parents} } if $p->{$_parents};
+        push @parents, $p;
+        $this->{$_parents}   = \@parents;
+        $this->{$_parentRev} = $p->{$_timestamp};
+    }
 
-	$this->{$_timestamp} = 0;
-	$this->{$_cache}     = {};
-	$this->{$_entries}   = [];
+    $this->{$_timestamp} = 0;
+    $this->{$_cache}     = {};
+    $this->{$_entries}   = [];
 }
 
 sub GetParent {
-	my ($this) = @_;
+    my ($this) = @_;
 
-	$this->{$_parents} && $this->{$_parents}[ @{ $this->{$_parents} } - 1 ];
+    $this->{$_parents} && $this->{$_parents}[ @{ $this->{$_parents} } - 1 ];
 }
 
 sub _Seal {
-	unless ( $_[0]->{$_sealed} ) {
-		$_[0]->{$_sealed}    = 1;
-		$_[0]->{$_timestamp} = 0;    # from now the timestamp is important
-	}
+    unless ( $_[0]->{$_sealed} ) {
+        $_[0]->{$_sealed}    = 1;
+        $_[0]->{$_timestamp} = 0;    # from now the timestamp is important
+    }
 }
 
 sub _Validate {
-	my ($this) = @_;
+    my ($this) = @_;
 
-	my $chain = $this->{$_parents}
-	  or return 1;
+    my $chain = $this->{$_parents}
+      or return 1;
 
-	my $rev = 0;    # rev 0 means that parent was never modified
-	                # this allows to made more efficient checks
-	my $flush;
+    my $rev = 0;    # rev 0 means that parent was never modified
+                    # this allows to made more efficient checks
+    my $flush;
 
-	foreach my $bag ( @$chain, $this ) {
+    foreach my $bag ( @$chain, $this ) {
 
-		# we need to updated all bags after the first change was detected;
-		if ( $flush ||= $rev and $bag->{$_parentRev} != $rev ) {
-			$bag->{$_cache}     = {};
-			$bag->{$_parentRev} = $rev;
-		}
-		$rev = $bag->{$_timestamp};
-	}
+        # we need to updated all bags after the first change was detected;
+        if ( $flush ||= $rev and $bag->{$_parentRev} != $rev ) {
+            $bag->{$_cache}     = {};
+            $bag->{$_parentRev} = $rev;
+        }
+        $rev = $bag->{$_timestamp};
+    }
 
-	return $flush ? 0 : 1;
+    return $flush ? 0 : 1;
 }
 
 sub Resolve {
-	my ( $this, $role ) = @_;
+    my ( $this, $role ) = @_;
 
-	die IMPL::InvalidArgumentException->new('role')
-	  unless defined $role;
+    die IMPL::InvalidArgumentException->new('role')
+      unless defined $role;
 
-	if ( my $d = $this->_GetDescriptor($role) ) {
-		return $d->{value};
-	}
-	else {
-		return;
-	}
+    if ( my $d = $this->_GetDescriptor($role) ) {
+        return wantarray ? @{$d}{'value', 'owner'} : $d->{value};
+    }
+    else {
+        return;
+    }
 }
 
 sub _GetDescriptor {
-	my ( $this, $role ) = @_;
+    my ( $this, $role ) = @_;
 
-	my $d = $this->{$_cache}{$role};
+    my $d = $this->{$_cache}{$role};
 
 # return descriptor if this is own descriptor and its level is 1 (i.e. it can't be overriden by the parent cache)
 # otherwise the cache must be validated
-	return $d
-	  if $d
-	  and ( ( $d->{owner} == $this and $d->{isa}{$role} == 1 )
-		or $this->_Validate() );
+    return $d
+      if $d
+      and ( ( $d->{owner} == $this and $d->{isa}{$role} == 1 )
+        or $this->_Validate() );
 
-	# if there were no descriptor in cache we need to ensure that the cache
-	# chain is valid before reolving starts
-	$this->_Validate() unless $d;
+    # if there were no descriptor in cache we need to ensure that the cache
+    # chain is valid before reolving starts
+    $this->_Validate() unless $d;
 
-	# the cache chain is valid
-	# $d is not a valid descriptor
+    # the cache chain is valid
+    # $d is not a valid descriptor
 
-	$d = undef;
-	my $prev;
+    $d = undef;
+    my $prev;
 
-	my $parents = $this->{$_parents};
-	my @bags = $parents ? ( @$parents, $this ) : ($this);
+    my $parents = $this->{$_parents};
+    my @bags = $parents ? ( @$parents, $this ) : ($this);
 
-	foreach my $bag (@bags) {
+    foreach my $bag (@bags) {
 
-		# check the cache;
-		unless ( my $t = $bag->{$_cache}{$role} ) {
+        # check the cache;
+        unless ( my $t = $bag->{$_cache}{$role} ) {
 
-	  # no cached entry this may be due cache flush
-	  # go through own entries and find better entry than inherited from parents
-			foreach my $entry ( @{ $bag->{$_entries} } ) {
-				my $level = $entry->{isa}{$role};
-				if ( $level and ( not($prev) or $level <= $prev ) ) {
-					$d    = $entry;
-					$prev = $level;
-				}
-			}
+      # no cached entry this may be due cache flush
+      # go through own entries and find better entry than inherited from parents
+            foreach my $entry ( @{ $bag->{$_entries} } ) {
+                my $level = $entry->{isa}{$role};
+                if ( $level and ( not($prev) or $level <= $prev ) ) {
+                    $d    = $entry;
+                    $prev = $level;
+                }
+            }
 
-			#cache it
-			$bag->{$_cache}{$role} = $d if $d;
-		}
-		else {
-			$d    = $t;
-			$prev = $d->{isa}{$role};
-		}
-	}
+            #cache it
+            $bag->{$_cache}{$role} = $d if $d;
+        }
+        else {
+            $d    = $t;
+            $prev = $d->{isa}{$role};
+        }
+    }
 
-	return $d;
+    return $d;
 }
 
 sub ResolveAll {
-	my ( $this, $role ) = @_;
+    my ( $this, $role ) = @_;
 
-	return [
-		map $_->{value},
-		grep $_->{isa}{$role},
-		map @{ $_->{$_entries} },
-		@{ $this->{$_parents} || [] },
-		$this
-	];
+    return [
+        map $_->{value},
+        grep $_->{isa}{$role},
+        map @{ $_->{$_entries} },
+        @{ $this->{$_parents} || [] },
+        $this
+    ];
 
 }
 
 sub Register {
-	my ( $this, $isa, $value ) = @_;
+    my ( $this, $isa, $value ) = @_;
 
-	$isa = { $isa, 1 } unless ishash($isa);
+    $isa = { $isa, 1 } unless ishash($isa);
 
-	push @{ $this->{$_entries} },
-	  { owner => $this, isa => $isa, value => $value };
-	$this->{$_timestamp}++;
+    push @{ $this->{$_entries} },
+      { owner => $this, isa => $isa, value => $value };
+    $this->{$_timestamp}++;
 
-	delete $this->{$_cache}{$_} foreach keys %$isa;
+    delete $this->{$_cache}{$_} foreach keys %$isa;
 
-	return $this;
+    return $this;
 }
 
 1;
diff -r 7798345304bc -r b0481c071bea lib/IMPL/Config/Container.pm
--- a/lib/IMPL/Config/Container.pm	Sun Jul 16 22:59:39 2017 +0300
+++ b/lib/IMPL/Config/Container.pm	Sun Aug 20 00:20:41 2017 +0300
@@ -1,6 +1,6 @@
 package IMPL::Config::Container;
 use strict;
-
+use mro;
 use Scalar::Util qw(blessed);
 use IMPL::Exception();
 use IMPL::lang qw(:base);
@@ -17,12 +17,13 @@
         'IMPL::Object::Disposable' => undef
     ],
     props => [
-        roles     => 'r',
-        services  => 'r',
-        instances => 'r',
-        parent    => 'r',
-        root      => 'r',
-        loader    => 'r'
+        roles        => 'r',
+        services     => 'r',
+        serviceCache => 'r',
+        instances    => 'r',
+        parent       => 'r',
+        root         => 'r',
+        loader       => 'r'
     ]
 };
 
@@ -46,6 +47,8 @@
         $this->services( Bag->new() );
         $this->root($this);
     }
+
+    $this->services->tag($this);
 }
 
 sub Dispose {
@@ -57,6 +60,8 @@
             &$d($v);
         }
     }
+    
+    $this->next::method();
 }
 
 sub Require {
@@ -90,14 +95,12 @@
 }
 
 sub Resolve {
-    my ( $this, $role, %opts ) = @_;
+    my ( $this, $role ) = @_;
 
     my $descriptor = $this->services->Resolve($role);
 
-    return $descriptor->Activate( ActivationContext->new($this) )
+    return ActivationContext->new($this)->Activate($descriptor)
       if $descriptor;
-
-    return $opts{default} if exists $opts{default};
 }
 
 sub ResolveAll {
@@ -113,7 +116,7 @@
         $context = ActivationContext->new($this)
           unless $context && $opts{shared};
 
-        push @result, $service->Activate($context);
+        push @result, $context->Activate($service);
     }
 
     return \@result;
diff -r 7798345304bc -r b0481c071bea lib/IMPL/Config/Descriptor.pm
--- a/lib/IMPL/Config/Descriptor.pm	Sun Jul 16 22:59:39 2017 +0300
+++ b/lib/IMPL/Config/Descriptor.pm	Sun Aug 20 00:20:41 2017 +0300
@@ -24,6 +24,14 @@
     die IMPL::NotImplementedException->new();
 }
 
+sub services {
+    
+}
+
+sub GetName {
+    die IMPL::NotImplementedException->new();
+}
+
 sub ParseActivation {
     my $val = pop @_;
 
diff -r 7798345304bc -r b0481c071bea lib/IMPL/Config/ReferenceDescriptor.pm
--- a/lib/IMPL/Config/ReferenceDescriptor.pm	Sun Jul 16 22:59:39 2017 +0300
+++ b/lib/IMPL/Config/ReferenceDescriptor.pm	Sun Aug 20 00:20:41 2017 +0300
@@ -3,57 +3,54 @@
 
 use IMPL::Exception();
 use IMPL::declare {
-	base => [
-		'IMPL::Object'             => undef,
-		'IMPL::Config::Descriptor' => undef
-	],
-	props => [
-		reference => 'ro',
-		services  => 'ro',
-		lazy      => 'ro',
-		optional  => 'ro',
-		default   => 'ro',
-		_name     => 'rw'
-	]
+    base => [
+        'IMPL::Object'             => undef,
+        'IMPL::Config::Descriptor' => undef
+    ],
+    props => [
+        reference => 'ro',
+        services  => 'ro',
+        lazy      => 'ro',
+        optional  => 'ro',
+        default   => 'ro',
+        _name     => 'rw'
+    ]
 };
 
 sub CTOR {
-	my ( $this, $ref, %opts ) = @_;
+    my ( $this, $ref, %opts ) = @_;
 
-	$this->reference($ref)
-	  or die IMPL::InvalidArgumentException->new('ref');
+    $this->reference($ref)
+      or die IMPL::InvalidArgumentException->new('ref');
 
-	$this->lazy( $opts{lazy} )         if $opts{lazy};
-	$this->optional( $opts{optional} ) if $opts{optional};
-	$this->default( $opts{default} )
-	  if $opts{optional} and exists $opts{default};
+    $this->lazy( $opts{lazy} )         if $opts{lazy};
+    $this->optional( $opts{optional} ) if $opts{optional};
+    $this->default( $opts{default} )
+      if $opts{optional} and exists $opts{default};
 
-	$this->_name( 'ref ' . $ref );
+    $this->_name( 'ref ' . $ref );
 }
 
 sub Activate {
-	my ( $this, $context ) = @_;
-
-	$context->EnterScope( $this->_name, $this->services );
+    my ( $this, $context ) = @_;
 
-	my $ref = $this->reference;
-	my %opts;
-	my $inst;
-	$opts{default} = $this->default
-	  if $this->optional;
+    my $ref = $this->reference;
+    my %opts;
+    my $inst;
+    if ( $this->optional ) {
+        $opts{optional} = 1;
+        $opts{default}  = $this->default;
+    }
 
-	if ( $this->lazy ) {
-		my $clone = $context->Clone();
-		$inst = sub {
-			$clone->Resolve( $ref, %opts );
-		};
-	}
-	else {
-		$inst = $context->Resolve( $ref, %opts );
-	}
-
-	$context->LeaveScope();
-	return $inst;
+    if ( $this->lazy ) {
+        my $clone = $context->Clone();
+        return sub {
+            $clone->Resolve( $ref, %opts );
+        };
+    }
+    else {
+        return $context->Resolve( $ref, %opts );
+    }
 }
 
 1;
diff -r 7798345304bc -r b0481c071bea lib/IMPL/Config/ServiceDescriptor.pm
--- a/lib/IMPL/Config/ServiceDescriptor.pm	Sun Jul 16 22:59:39 2017 +0300
+++ b/lib/IMPL/Config/ServiceDescriptor.pm	Sun Aug 20 00:20:41 2017 +0300
@@ -18,7 +18,6 @@
         args       => 'r',
         services   => 'r',
         norequire  => 'r',
-        owner      => 'r',
         _name      => 'rw',
         _loaded    => 'rw'
     ]
@@ -29,8 +28,6 @@
 
     $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};
@@ -43,11 +40,9 @@
 }
 
 sub Activate {
-    my ( $this, $context ) = @_;
+    my ( $this, $context) = @_;
 
     my $instance;
-    $context->EnterScope( $this->_name, $this->services );
-
     my $activation = $this->activation;
     my $cache;
 
@@ -55,10 +50,10 @@
         $cache = $context->container->root->instances;
     }
     elsif ( $activation == SELF->ACTIVATE_CONTAINER ) {
-        $cache = $this->owner->instances;
+        $cache = $context->container->instances;
     }
     elsif ( $activation == SELF->ACTIVATE_HIERARCHY ) {
-        $cache = $context->container->instances;
+        $cache = $context->owner->instances;
     }
     elsif ( $activation == SELF->ACTIVATE_CONTEXT ) {
         $cache = $context->instances;
@@ -70,35 +65,39 @@
         $cache->{ ref($this) } = $instance if $cache;
     }
 
-    $context->LeaveScope();
-
     return $instance;
 }
 
 sub CreateInstance {
-    my ( $this, $context ) = @_;
+    my ( $this, $context) = @_;
 
     my $class =
         $this->norequire
       ? $this->type
       : $context->container->Require( $this->type );
-
-    my $args = $this->args ? $this->args->Activate($context) : undef;
-
-    if ( defined $args ) {
-        if ( isarray($args) ) {
-            return $class->new(@$args);
+      
+    
+    # determine how to pass arguments
+    if (isarray($this->args)) {
+        # if args is an array ref, pass it as list
+        return $class->new(map $context->Activate($_), @{$this->args});
+    } elsif (ishash($this->args)) {
+        # if args is a hash ref, pass it as list
+        my %args;
+        while(my ($k,$v) = each %{$this->args}) {
+            $args{$k} = $context->Activate($v);
         }
-        elsif ( ishash($args) ) {
-            return $class->new(%$args);
-        }
-        else {
-            return $class->new($args);
-        }
-    }
-    else {
+        return $class->new(%args);
+    } elsif(defined $this->args) {
+        # otherwise pass it as a single argument
+        return $class->new($context->Activate($this->args)); 
+    } else {
         return $class->new();
     }
 }
 
+sub GetName {
+    shift->_name;
+}
+
 1;
diff -r 7798345304bc -r b0481c071bea lib/IMPL/Config/ServicesBag.pm
--- a/lib/IMPL/Config/ServicesBag.pm	Sun Jul 16 22:59:39 2017 +0300
+++ /dev/null	Thu Jan 01 00:00:00 1970 +0000
@@ -1,181 +0,0 @@
-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
diff -r 7798345304bc -r b0481c071bea lib/IMPL/Config/ValueDescriptor.pm
--- a/lib/IMPL/Config/ValueDescriptor.pm	Sun Jul 16 22:59:39 2017 +0300
+++ b/lib/IMPL/Config/ValueDescriptor.pm	Sun Aug 20 00:20:41 2017 +0300
@@ -29,12 +29,7 @@
     my ( $this, $context ) = @_;
     return $this->value if $this->raw;
 
-    my $services = $this->services;
-
-    $context->EnterScope( '$value: ' . $this->value, $services ) if $services;
-    my $value = $this->_ActivateValue( $this->value, $context );
-    $context->LeaveScope() if $services;
-    return $value;
+    return $this->_ActivateValue( $this->value, $context );
 }
 
 sub _ActivateValue {
@@ -57,4 +52,8 @@
     }
 }
 
+sub GetName {
+    return '$value: ' . shift->value;
+}
+
 1;
diff -r 7798345304bc -r b0481c071bea lib/IMPL/Config/YAMLConfig.pm
--- a/lib/IMPL/Config/YAMLConfig.pm	Sun Jul 16 22:59:39 2017 +0300
+++ b/lib/IMPL/Config/YAMLConfig.pm	Sun Aug 20 00:20:41 2017 +0300
@@ -1,49 +1,142 @@
+
+=head1 NAME
+
+C<IMPL::Condig::YAMLConfig> - YAML configuration parser for the container
+
+=head1 SYNOPSIS
+
+=begin code
+
+use IMPL::require {
+    YAMLConfig => 'IMPL::Config::YAMLConfig',
+    Container => 'IMPL::Config::Container'
+};
+
+my $config = YAMLConfig->new('config.yaml');
+$config->Load('additional.yaml');
+my $container = Container->new($parent);
+$config->ConfigureContainer($container);
+
+=end code
+
+=head1 DESCRIPTION
+
+This module load YAML configuration and applies it to the container. 
+
+=head1 MEMBERS
+
+=cut
+
 package IMPL::Config::YAMLConfig;
 use strict;
 
+use IMPL::Debug;
 use IMPL::lang qw(:base);
 use IMPL::Exception();
 use YAML::XS();
+use Sub::Util;
+use File::Spec();
+use URI::file();
 
 use IMPL::declare {
     require => {
         ReferenceDescriptor => 'IMPL::Config::ReferenceDescriptor',
         ServiceDescriptor   => 'IMPL::Config::ServiceDescriptor',
-        ValueDescriptor     => 'IMPL::Config::ValueDescriptor'
+        ValueDescriptor     => 'IMPL::Config::ValueDescriptor',
+        Descriptor          => '-IMPL::Config::Descriptor'
     },
     base => [
         'IMPL::Object' => undef
     ],
     props => [
-        container => 'ro'
+        _services => 'ro',
+        _stack    => 'ro',
+        _visited  => 'ro',
+        _current  => 'ro'
     ]
 };
 
 sub CTOR {
-    my ( $this, $container ) = @_;
-    die IMPL::InvalidArgumentException('container')
-      unless $container;
-    $this->container($container);
+    my ( $this, %args ) = @_;
+    $this->_services( {} );
+    $this->_stack( [] );
+    $this->_visited( {} );
+    $this->Load( $args{load} ) if ( $args{load} );
+}
+
+sub Load {
+    my ( $this, $file ) = @_;
+
+    dbg_log("Load $file");
+    my $prev = $this->_current;
+    push @{ $this->_stack }, "$file";
+    
+    dbg_log( "base: ", $prev || '' );
+
+    $this->_current( $prev ? URI::file->new($file)->abs($prev) : URI::file->new_abs($file))
+      unless ref $file;
+    
+    dbg_log( "translated: ", $this->_current);
+
+    my $config;
+
+    if ( isscalar($file) ) {
+        $this->LoadConfiguration( YAML::XS::Load( ${$file} ) );
+    }
+    else {
+        if ( not ref $file and defined $file ) {
+            if ( not $this->_visited->{$this->_current} ) {
+                $this->_visited->{$this->_current} = 1;
+                
+                dbg_log("Loading YAML from file ", $this->_current->file);
+                
+                $config = YAML::XS::LoadFile($this->_current->file);
+            } else {
+                dbg_warn("recursive includes: \n\t", join("\n\t", reverse @{$this->_stack}));
+            }
+        }
+        else {
+            $config = YAML::XS::LoadFile($file);
+        }
+    }
+
+    $this->LoadConfiguration($config) if defined $config;
+
+    $this->_current($prev);
+    pop @{ $this->_stack };
+
+    return 1;
 }
 
 sub LoadConfiguration {
-    my ( $this, $file ) = @_;
+    my ( $this, $config ) = @_;
 
-    $this->Configure(
-          isscalar($file)
-        ? YAML::XS::Load( ${$file} )
-        : YAML::XS::LoadFile($file)
-    );
+    die IMPL::InvalidArgumentException->new('config')
+      unless ishash($config);
+
+    $this->Include( $config->{include} );
+
+    $this->_services( $this->ParseServices( $config->{services} ) );
 }
 
-sub Configure {
-    my ( $this, $config ) = @_;
+sub Include {
+    my ( $this, $inc ) = @_;
+    if ( isarray($inc) ) {
+        $this->Include($_) foreach @$inc;
+    }
+    elsif ( defined $inc and not ref $inc ) {
+        dbg_log("include: $inc");
+        $this->Load( $inc );
+    }
+}
 
-    die IMPL::InvalidArgumentException('config')
-      unless ishash($config);
+sub ConfigureContainer {
+    my ( $this, $container ) = @_;
 
-    my $container = $this->container;
-    foreach my $item ( @{ $this->ParseServices( $config->{services} ) } ) {
+    die IMPL::InvalidArgumentException->new($container)
+      unless $container;
+
+    foreach my $item ( @{ $this->_services } ) {
         $container->Register( $item->{role}, $item->{descriptor} );
     }
 
@@ -68,40 +161,68 @@
 sub ParseDescriptor {
     my ( $this, $data ) = @_;
 
-    my %opts = ( onwer => $this->container() );
+    my %opts;
+    if ( ref $data ) {
+        if ( my $type = $data->{'$type'} ) {
+            $opts{services} = $this->ParseServices( $data->{services} );
+            $opts{type}     = $type;
+            $opts{args}     = $this->ParseParams( $data->{params} )
+              if $data->{params};
+            $opts{norequire}  = $data->{norequire};
+            $opts{activation} = $data->{activation};
 
-    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 ServiceDescriptor->new(%opts);
+            return ReferenceDescriptor->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 );
+        }
+
     }
-    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 );
-    }
+    my ( $parsed, $raw ) = $this->ParseValue($data);
+    $opts{raw} = $raw;
+    return is( $parsed, Descriptor )
+      ? $parsed
+      : ValueDescriptor->new( $parsed, %opts );
 }
 
+sub IsDescriptorSpec {
+    my ( $this, $spec ) = @_;
+    return ( ishash($spec) and grep exists $spec->{$_}, qw($type $ref $value) );
+}
+
+sub ParseParams {
+    my ( $this, $params ) = @_;
+
+    if ( isarray($params) ) {
+        return [ map $this->ParseDescriptor($_), @$params ];
+    }
+    elsif ( ishash($params) and not $this->IsDescriptorSpec($params) ) {
+        return {
+            map { $_, $this->ParseDescriptor( $params->{$_} ) }
+              keys %$params
+        };
+    }
+    return $this->ParseDescriptor($params);
+}
+
+# parses value and returns a reference to the parsed value, i.e. descriptors
+# are recognized and instantinated.
+# returns ($parsed, $raw)
+#   $parsed - the parsed value
+#   $raw - the parsed value doesn't contain descriptors
 sub ParseValue {
     my ( $this, $value ) = @_;
 
@@ -109,7 +230,7 @@
 
     if ( ishash($value) ) {
         return ( $this->ParseDescriptor($value), 0 )
-          if grep exists $value->{$_}, qw($type $ref $value);
+          if $this->IsDescriptorSpec($value);
 
         my %res;
         while ( my ( $k, $v ) = each %$value ) {
@@ -125,27 +246,15 @@
                 map {
                     my ( $parsed, $flag ) = $this->ParseValue($_);
                     $raw &&= $flag;
-                    return $parsed;
+                    $parsed;
                 } @$value
             ],
             $raw
         );
     }
     else {
-        return ($value, 1);
+        return ( $value, 1 );
     }
 }
 
 1;
-
-__END__
-
-=pod
-
-=head1 NAME
-
-=head1 SYNOPSIS
-
-=
-
-=cut
diff -r 7798345304bc -r b0481c071bea lib/IMPL/Debug.pm
--- /dev/null	Thu Jan 01 00:00:00 1970 +0000
+++ b/lib/IMPL/Debug.pm	Sun Aug 20 00:20:41 2017 +0300
@@ -0,0 +1,66 @@
+package IMPL::Debug;
+use strict;
+use warnings;
+
+our $ENABLE = 0;
+our %ENABLE;
+
+my %subscriptions;
+my @subscriptions;
+
+sub stub { }
+
+sub import {
+    my ( $self, @args ) = @_;
+
+    my $caller = caller;
+    no strict 'refs';
+
+    my $enabled = exists $ENABLE{$caller} ? $ENABLE{$caller} : $ENABLE;
+
+    *{"${caller}::dbg_log"} = $enabled
+      ? sub {
+        $self->log( $caller, @_ );
+      }
+      : \&stub;
+
+    *{"${caller}::dbg_error"} = $enabled
+      ? sub {
+        $self->log( $caller, @_ );
+      }
+      : \&stub;
+
+    *{"${caller}::dbg_warn"} = $enabled
+      ? sub {
+        $self->log( $caller, @_ );
+      }
+      : \&stub;
+}
+
+sub log {
+    my $self    = shift;
+    my $channel = shift;
+    $_->(@_) foreach @{ $subscriptions{$channel} || [] };
+    $_->(@_) foreach @subscriptions;
+}
+
+sub subscribe {
+    my ( $self, $channel, $callback ) = @_;
+
+    if ( @_ == 2 ) {
+        $callback = $channel;
+        $channel  = undef;
+    }
+
+    die IMPL::InvalidArgumentException->new('callback')
+      unless ref $callback eq 'CODE';
+
+    if ($channel) {
+        push @{ $subscriptions{$channel} }, $callback;
+    }
+    else {
+        push @subscriptions, $callback;
+    }
+}
+
+1;
diff -r 7798345304bc -r b0481c071bea lib/IMPL/declare.pm
--- a/lib/IMPL/declare.pm	Sun Jul 16 22:59:39 2017 +0300
+++ b/lib/IMPL/declare.pm	Sun Aug 20 00:20:41 2017 +0300
@@ -30,8 +30,9 @@
 	_trace("declare $caller");
 	$IMPL::require::level++;
 
+    my $tcaller = $caller;
 	*{"${caller}::SELF"} = sub () {
-		$caller;
+		$tcaller;
 	};
 
 	while ( my ( $alias, $class ) = each %$aliases ) {
diff -r 7798345304bc -r b0481c071bea lib/IMPL/require.pm
--- a/lib/IMPL/require.pm	Sun Jul 16 22:59:39 2017 +0300
+++ b/lib/IMPL/require.pm	Sun Aug 20 00:20:41 2017 +0300
@@ -27,10 +27,10 @@
 		_trace("$alias => $class");
 		$level++;
 
-		$class = _require($class);
+		my $c = _require($class);
 
 		*{"${caller}::$alias"} = sub () {
-			$class;
+			$c;
 		};
 
 		$level--;