Mercurial > pub > Impl
diff lib/IMPL/Config/Bag.pm @ 414:ec6f2d389d1e ref20150831
working on IMPL::Config::Bag
author | cin |
---|---|
date | Fri, 02 Oct 2015 06:56:24 +0300 |
parents | af8d359ee4cc |
children | 3d24b10dd0d5 |
line wrap: on
line diff
--- a/lib/IMPL/Config/Bag.pm Thu Sep 24 12:19:30 2015 +0300 +++ b/lib/IMPL/Config/Bag.pm Fri Oct 02 06:56:24 2015 +0300 @@ -1,104 +1,151 @@ package IMPL::Config::Bag; use strict; +use IMPL::lang qw(:base); use IMPL::declare { base => [ 'IMPL::Object' => undef ], props => [ - parent => '*r', - _cache => '*rw', - _entries => '*rw' + _parents => '*rw', # array of parent bags + _state => '*rw', #array of previous timestamps + _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 } ] }; sub CTOR { - my ($this, $p) = @_; - - $this->{$parent} = $p; - $this->{$_cache} = {}; - $this->{$_entries} = []; + my ( $this, $p ) = @_; + + if ($p) { + my @parents; + push @parents, @{ $p->{$_parents} } if $p->{$_parents}; + push @parents, $p; + $this->{$_parents} = \@parents; + $this->{$_state} = [ map $_->{$_timestamp}, @parents ]; + } + + $this->{$_timestamp} = 0; + $this->{$_cache} = {}; + $this->{$_entries} = []; +} + +sub GetParent { + $_[0]->{$_parents} && $_[0]->{$_parents}[0]; +} + +sub _Validate { + my ($this) = @_; + + my $parents = $this->{$_parents} + or return; + my $state = $this->{$_state}; + my $len = @$parents; + my $flush; + + for ( my $i = 0 ; $i < $len ; $i++ ) { + if ($flush) { + $parents->[$i]{$_cache} = {}; + $state->[$i] = $parents->[$i]{$_timestamp}; + } + else { + $flush = ( $parents->[$i]{$_timestamp} != $state->[$i] ); + } + } + + if ($flush) { + $this->{$_cache} = {}; + return 0; + } + + return 1; } sub Resolve { - my ($this,$role) = @_; - - my $d = $this->GetDescriptor(); + my ( $this, $role ) = @_; + + if ( my $d = $this->GetDescriptor() ) { + return $d->{value}; + } + else { + return; + } } sub GetDescriptor { - my ($this, $role) = @_; - + my ( $this, $role ) = @_; + my $d = $this->{$_cache}{$role}; - return $d if $d and $d->{valid}; - - my @entries = @{$this->{$_entries}}; - - if(my $t = $this->{$parent} && $this->{$parent}->GetDescriptor($role)) { - push @entries, $t; + +# 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() ); + + # the cache chain is valid + # $d is not a valid descriptor + + $d = undef; + my $prev; + + if ( my $parents = $this->{$_parents} ) { + foreach my $bag ( @$parents, $this ) { + + # 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; + } + } + + #cache it + $bag->{$_cache}{$role} = $d if $d; + } + else { + $d = $t; + $prev = $d->{isa}{$role}; + } + } } - - my $level; - foreach my $entry (@entries) { - my $t = $entry->{isa}{$role}; - next unless defined $t; - if (defined($level) && $level > $t) { - $d = $entry; - $level = $t; - } - } - - if ($d and $d->{valid}) { - $this->{$_cache}{$role} = $d; - return $d; - } else { - return; - } + + return $d; } sub ResolveAll { - my ($this, $role) = @_; - - my $result = $this->{$parent} ? $this->{$parent}->ResolveAll() : []; - - push @$result, map $_->{value}, grep $_->{isa}{$role}, @{$this->{$_entries}}; - - return $result; + my ( $this, $role ) = @_; + + return [ + map $_->{value}, + grep $_->{isa}{$role}, + map $_->{$_entries}, + @{ $this->{$_parents} || [] }, + $this + ]; + } sub Register { - my ($this, $role, $isa, $value) = @_; -} + my ( $this, $isa, $value ) = @_; + + $isa = { $isa, 1 } unless isHash($isa); -sub _UpdateDescriptor { - + push @{ $this->{$_entries} }, + { owner => $this, isa => $isa, value => $value }; + $this->{$_timestamp}++; + + delete $this->{$_cache}{$_} foreach keys %$isa; + + return $this; } -package IMPL::Config::Bag::Entry; -use IMPL::Exception(); -use IMPL::declare { - base => [ - 'IMPL::Object::Fields' => undef - ] -}; - -my @fields = qw(owner type isa valid value index); -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; \ No newline at end of file +1;