Mercurial > pub > Impl
changeset 415:3d24b10dd0d5 ref20150831
working on IMPL::Config::Container
author | cin |
---|---|
date | Tue, 20 Oct 2015 07:32:55 +0300 |
parents | ec6f2d389d1e |
children | cc2cf8c0edc2 |
files | _test/temp.pl lib/IMPL/Config/ActivationContext.pm lib/IMPL/Config/Bag.pm lib/IMPL/Config/Container.pm lib/IMPL/Config/Descriptor.pm lib/IMPL/Config/Hierarchy.pm lib/IMPL/Config/ReferenceDescriptor.pm lib/IMPL/Config/ServiceDescriptor.pm lib/IMPL/Config/ValueDescriptor.pm |
diffstat | 9 files changed, 345 insertions(+), 84 deletions(-) [+] |
line wrap: on
line diff
--- a/_test/temp.pl Fri Oct 02 06:56:24 2015 +0300 +++ b/_test/temp.pl Tue Oct 20 07:32:55 2015 +0300 @@ -2,10 +2,12 @@ use strict; use Carp; use Time::HiRes qw(gettimeofday tv_interval); -use Scalar::Util qw(blessed); - -my $data = [1,2,3]; +use Scalar::Util qw(blessed refaddr); +use YAML::XS qw(Dump); -print foreach @$data, 4; - +print Dump { + services => [ + { role => 'db', type => 'My::Data::Context', params => { '-ref' => 'some-role' } } + ] +}; 1;
--- a/lib/IMPL/Config/ActivationContext.pm Fri Oct 02 06:56:24 2015 +0300 +++ b/lib/IMPL/Config/ActivationContext.pm Tue Oct 20 07:32:55 2015 +0300 @@ -10,40 +10,49 @@ 'IMPL::Object' => '@_' }, props => { + container => PROP_RW, _services => PROP_RW, - _cache => PROP_RW, - _stack => PROP_RW + _cache => PROP_RW, + _stack => PROP_RW } }; -sub GetService { - my ($this,$serviceId) = @_; - - $this->_services-> +sub CTOR { + my ( $this, $container ) = @_; + + $this->container($container) + or die IMPL::InvalidArgumentException('container'); } sub EnterScope { - my ($this, $name, $localize) = @_; - + my ( $this, $name, $services ) = @_; + my $info = { name => $name }; - - if ($localize) { + + if ($services) { $info->{services} = $this->_services; - - $this->_services(PropertyBag->new($this->_services)); + + $this->_services( $services ); } - + $this->_stack->Push($info); } sub LeaveScope { my ($this) = @_; - + my $info = $this->_stack->Pop() - or die IMPL::InvalidOperationException(); - - if ($info->{services}) - $this->_services($info->{services}); + or die IMPL::InvalidOperationException(); + + if ( $info->{services} ) $this->_services( $info->{services} ); +} + +sub Resolve { + my ($this, $role, %opts) = @_; +} + +sub Clone { + my ($this) = @_; } 1; @@ -65,4 +74,4 @@ =head3 GetService($serviceId) -=cut \ No newline at end of file +=cut
--- a/lib/IMPL/Config/Bag.pm Fri Oct 02 06:56:24 2015 +0300 +++ b/lib/IMPL/Config/Bag.pm Tue Oct 20 07:32:55 2015 +0300 @@ -8,7 +8,8 @@ ], props => [ _parents => '*rw', # array of parent bags - _state => '*rw', #array of previous timestamps + _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 @@ -20,11 +21,12 @@ my ( $this, $p ) = @_; if ($p) { + $p->_Seal(); my @parents; push @parents, @{ $p->{$_parents} } if $p->{$_parents}; push @parents, $p; - $this->{$_parents} = \@parents; - $this->{$_state} = [ map $_->{$_timestamp}, @parents ]; + $this->{$_parents} = \@parents; + $this->{$_parentRev} = $p->{$_timestamp}; } $this->{$_timestamp} = 0; @@ -33,40 +35,47 @@ } sub GetParent { - $_[0]->{$_parents} && $_[0]->{$_parents}[0]; + my ($this) = @_; + + $this->{$_parents} && $this->{$_parents}[ @{ $this->{$_parents} } - 1 ]; +} + +sub _Seal { + unless ($_[0]->{$_sealed}) { + $_[0]->{$_sealed} = 1; + $_[0]->{$_timestamp} = 0; # from now the timestamp is important + } } sub _Validate { my ($this) = @_; - my $parents = $this->{$_parents} - or return; - my $state = $this->{$_state}; - my $len = @$parents; - my $flush; + my $chain = $this->{$_parents} + or return 1; - for ( my $i = 0 ; $i < $len ; $i++ ) { - if ($flush) { - $parents->[$i]{$_cache} = {}; - $state->[$i] = $parents->[$i]{$_timestamp}; - } - else { - $flush = ( $parents->[$i]{$_timestamp} != $state->[$i] ); - } + 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) { + # 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}; } - - if ($flush) { - $this->{$_cache} = {}; - return 0; - } - - return 1; + + return $flush ? 0 : 1; } sub Resolve { my ( $this, $role ) = @_; - if ( my $d = $this->GetDescriptor() ) { + die IMPL::InvalidArgumentException->new('role') + unless defined $role; + + if ( my $d = $this->_GetDescriptor($role) ) { return $d->{value}; } else { @@ -74,7 +83,7 @@ } } -sub GetDescriptor { +sub _GetDescriptor { my ( $this, $role ) = @_; my $d = $this->{$_cache}{$role}; @@ -86,6 +95,10 @@ 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; + # the cache chain is valid # $d is not a valid descriptor @@ -127,7 +140,7 @@ return [ map $_->{value}, grep $_->{isa}{$role}, - map $_->{$_entries}, + map @{$_->{$_entries}}, @{ $this->{$_parents} || [] }, $this ]; @@ -137,7 +150,7 @@ sub Register { 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 };
--- a/lib/IMPL/Config/Container.pm Fri Oct 02 06:56:24 2015 +0300 +++ b/lib/IMPL/Config/Container.pm Tue Oct 20 07:32:55 2015 +0300 @@ -9,7 +9,8 @@ ValueDescriptor => 'IMPL::Config::ValueDescriptor', ActivationContext => 'IMPL::Config::ActivationContext', Hierarchy => 'IMPL::Config::Hierarchy', - Bag => 'IMPL::Config::Bag' + Bag => 'IMPL::Config::Bag', + Loader => 'IMPL::Code::Loader' }, base => [ 'IMPL::Object' => undef @@ -18,36 +19,48 @@ roles => 'r', services => 'r', instances => 'r', - parent => 'r' + parent => 'r', + root => 'r', + loader => 'r' ] }; my $nextRoleId = 1; sub CTOR { - my ( $this, $parent ) = @_; + my ( $this, $parent, %opts ) = @_; $this->instances( {} ); + $this->loader( $opts{loader} || Loader->safe ); + if ($parent) { $this->roles( Hierarchy->new( $parent->roles ) ); $this->services( Bag->new( $parent->services ) ); $this->parent($parent); + $this->root( $parent->root ); } else { $this->roles( Hierarchy->new() ); $this->services( Bag->new() ); + $this->root($this); } } sub Register { my ( $this, $role, $service ) = @_; + die IMPL::InvalidArgumentException->new('service') + unless is( $service, Descriptor ); + $this->services->Register( $this->GetLinearRoleHash($role), $service ); +} + +sub GetLinearRoleHash { + my ( $this, $role ) = @_; + die IMPL::InvalidArgumentException->new( role => 'The argument is required' ) unless $role; - die IMPL::InvalidArgumentException->new('service') - unless is( $service, Descriptor ); if ( isarray($role) ) { my $tempRole = "unnamed-" . $nextRoleId++; @@ -55,10 +68,7 @@ $role = $tempRole; } - $service = ValueDescriptor->new( value => $service ) - unless is( $service, Descriptor ); - - $this->services->Register( $this->roles->GetLinearRoleHash($role), $service ); + $this->roles->GetLinearRoleHash($role); } sub Resolve { @@ -105,21 +115,10 @@ =head2 METHODS -=head3 GetService($serviceId) - -=over - -=item * $serviceId +=head3 Resolve($role) -A string indetifier of the service, it can be in two forms: class name or service name, -for the class name it should be prefixed with C<@>, for example: C<@Foo::Bar>. - -=back +=head3 ResolveAll($role, shared => $useSharedContext) -The activation container maintains two maps, one for classes and the other for names. -The first one is useful when we searching for an implementation the second one when -we need a particular service. - -=head3 RegisterService($descriptor) +=head3 Register($role, $service) =cut
--- a/lib/IMPL/Config/Descriptor.pm Fri Oct 02 06:56:24 2015 +0300 +++ b/lib/IMPL/Config/Descriptor.pm Tue Oct 20 07:32:55 2015 +0300 @@ -1,12 +1,46 @@ package IMPL::Config::Descriptor; use strict; use IMPL::Exception(); +use Scalar::Util qw(looks_like_number); + +sub ACTIVATE_SINGLETON() { 1 } +sub ACTIVATE_CONTAINER() { 2 } +sub ACTIVATE_CONTEXT() { 3 } +sub ACTIVATE_CALL() { 4 } + +my %activateNames = ( + singleton => ACTIVATE_SINGLETON, + container => ACTIVATE_CONTAINER, + context => ACTIVATE_CONTEXT, + call => ACTIVATE_CALL +); + +my %activateNamesLookup = map { $activateNames{$_}, $_ } keys %activateNames; sub Activate { - my ($this, $context) = @_; + my ( $this, $context ) = @_; die IMPL::NotImplementedException->new(); } +sub ParseActivation { + my $val = pop @_; + + return ACTIVATE_CALL unless $val; + + return grep $_ == $val, + ACTIVATE_SINGLETON, + ACTIVATE_CONTAINER, + ACTIVATE_CONTEXT, ACTIVATE_CALL ? $val : ACTIVATE_CALL + if looks_like_number($val); + + return $activateNames{ lc($val) } || ACTIVATE_CALL; +} + +sub ActivationToString { + my $val = pop @_; + + return ( $val && $activateNamesLookup{$val} ) || ''; +} 1; @@ -54,4 +88,4 @@ =back -=cut \ No newline at end of file +=cut
--- a/lib/IMPL/Config/Hierarchy.pm Fri Oct 02 06:56:24 2015 +0300 +++ b/lib/IMPL/Config/Hierarchy.pm Tue Oct 20 07:32:55 2015 +0300 @@ -8,10 +8,10 @@ base => { 'IMPL::Object' => undef }, - props => { + props => [ roles => '*rw', _cache => '*rw' - } + ] }; sub CTOR { @@ -21,10 +21,13 @@ $this->roles( clone( $roles->roles ) ); } elsif ( ishash($roles) ) { - $this->roles($roles); + $this->roles({}); + while(my ($n, $p) = each %$roles) { + $this->AddRole($n,$p); + } } elsif ( isarray($roles) ) { - $this->roles( { map { $_, 1 } @$roles } ); + $this->roles( { map { $_, undef } @$roles } ); } else { $this->roles( {} ); @@ -52,7 +55,7 @@ unless ($cache) { $cache = { $role, 1 }; - my @roles = [$role, 1]; + my @roles = ([$role, 1]); while (my $r = shift @roles ) { my ($name, $level) = @$r; @@ -60,8 +63,8 @@ $cache->{$name} = $level; if(my $parents = $this->{$roles}{$name}) { foreach my $p (@$parents) { - next if $cache{$p}; - push @roles, [$p, $cache{$p} = $level + 1]; + next if $cache->{$p}; + push @roles, [$p, $cache->{$p} = $level + 1]; } } }
--- a/lib/IMPL/Config/ReferenceDescriptor.pm Fri Oct 02 06:56:24 2015 +0300 +++ b/lib/IMPL/Config/ReferenceDescriptor.pm Tue Oct 20 07:32:55 2015 +0300 @@ -0,0 +1,52 @@ +package IMPL::Config::ReferenceDescriptor; +use strict; + +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' + ] +}; + +sub CTOR { + my ( $this, $ref, %opts ) = @_; + + $this->reference($ref) + or die IMPL::InvalidArgumentException->new('ref'); + + $this->_name( 'ref ' . $ref ); +} + +sub Activate { + my ( $this, $context ) = @_; + + $this->EnterScope( $this->_name, $this->services ); + + my $ref = $this->reference; + my %opts; + $opts{default} = $this->default + if $this->optional; + + if ( $this->lazy ) { + my $clone = $context->Clone(); + return sub { + $clone->Resolve( $ref, %opts ); + }; + } + else { + return $context->Resolve( $ref, %opts ); + } + + $this->LeaveScope(); +} + +1;
--- a/lib/IMPL/Config/ServiceDescriptor.pm Fri Oct 02 06:56:24 2015 +0300 +++ b/lib/IMPL/Config/ServiceDescriptor.pm Tue Oct 20 07:32:55 2015 +0300 @@ -0,0 +1,95 @@ +package IMPL::Config::ServiceDescriptor; +use strict; + +use IMPL::lang qw(:base); +use IMPL::Exception(); +use IMPL::declare { + require => { + Bag => 'IMPL::Config::Bag' + }, + base => [ + 'IMPL::Object' => undef, + 'IMPL::Config::Descriptor' => undef + ], + props => [ + type => 'ro', + activation => 'ro', + args => 'ro', + services => 'ro', + _name => 'rw', + _loaded => 'rw' + ] +}; + +sub CTOR { + my ( $this, %opts ) = @_; + + $this->type( $opts{type} ) + or die IMPL::InvalidArgumentException->new('type'); + + $this->activation( + IMPL::Config::Descriptor::ParseActivation( $opts{activation} ) ); + $this->args( $opts{args} ) if exists $opts{args}; + $this->services( $opts{services} ) if exists $opts{services}; + + $this->_name( 'new {' + . IMPL::Config::Descriptor::ActivationToString( $this->activation ) + . '} ' + . $this->type ); +} + +sub Activate { + my ( $this, $context ) = @_; + + $context->EnterScope( $this->_name, $this->services ); + + my $activation = $this->activation; + my $cache; + + if ( $activation == IMPL::Config::Descriptor::ACTIVATE_SINGLETON ) { + $cache = $context->container->root->instances; + } + elsif ( $activation == IMPL::Config::Descriptor::ACTIVATE_CONTAINER ) { + $cache = $context->container->instances; + } + elsif ( $activation == IMPL::Config::Descriptor::ACTIVATE_CONTEXT ) { + $cache = $context->instances; + } + + my $instance = $cache->{ ref($this) } if $cache; + + unless ($instance) { + $instance = $this->CreateInstance($context); + } + + $cache->{ ref($this) } = $instance if $cache; + + $context->LeaveScope(); + + return $instance; +} + +sub CreateInstance { + my ( $this, $context ) = @_; + + my $class = $context > container->Require( $this->type ); + + 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(); + } +} + +1;
--- a/lib/IMPL/Config/ValueDescriptor.pm Fri Oct 02 06:56:24 2015 +0300 +++ b/lib/IMPL/Config/ValueDescriptor.pm Tue Oct 20 07:32:55 2015 +0300 @@ -0,0 +1,54 @@ +package IMPL::Config::ValueDescriptor; +use strict; + +use IMPL::lang qw(:base); +use IMPL::declare { + require => { + Descriptor => 'IMPL::Config::Descriptor' + }, + base => [ + 'IMPL::Object' => undef, + 'Descriptor' => undef + ], + props => [ + value => 'rw', + raw => 'rw' + ] +}; + +sub CTOR { + my ( $this, $value, $raw ) = @_; + + $this->value($value); + $this->raw($raw); +} + +sub Activate { + my ( $this, $context ) = @_; + + return $this->raw + ? $this->value + : $this->_ActivateValue( $this->value, $context ); +} + +sub _ActivateValue { + my ( $this, $value, $context ) = @_; + + if ( is( $value, Descriptor ) ) { + return $value->Activate($context); + } + elsif ( isarray($value) ) { + return [ map $this->_ActivateValue($_), @$value ]; + } + elsif ( ishash($value) ) { + return { + map { $_, $this->_ActivateValue( $value->{$_} ) } + keys %$value + }; + } + else { + return $value; + } +} + +1;