Mercurial > pub > Impl

comparison lib/IMPL/Config/Bag.pm @ 415:3d24b10dd0d5 ref20150831

Find changesets by keywords (author, files, the commit message), revision number or hash, or revset expression.
working on IMPL::Config::Container
author cin
date Tue, 20 Oct 2015 07:32:55 +0300
parents ec6f2d389d1e
children 3ed0c58e9da3
comparison
equal deleted inserted replaced
414:ec6f2d389d1e 415:3d24b10dd0d5
6 base => [ 6 base => [
7 'IMPL::Object' => undef 7 'IMPL::Object' => undef
8 ], 8 ],
9 props => [ 9 props => [
10 _parents => '*rw', # array of parent bags 10 _parents => '*rw', # array of parent bags
11 _state => '*rw', #array of previous timestamps 11 _parentRev => '*rw', # the timestamp of the parent
12 _sealed => '*rw', # the bag has descendants
12 _cache => '*rw', # own or cached entries 13 _cache => '*rw', # own or cached entries
13 _timestamp => '*rw', 14 _timestamp => '*rw',
14 _entries => '*rw', # each entry is represented by hash 15 _entries => '*rw', # each entry is represented by hash
15 # { isa => linear_isa_hash, owner => owner_of_the_entry, value => value } 16 # { isa => linear_isa_hash, owner => owner_of_the_entry, value => value }
16 ] 17 ]
18 19
19 sub CTOR { 20 sub CTOR {
20 my ( $this, $p ) = @_; 21 my ( $this, $p ) = @_;
21 22
22 if ($p) { 23 if ($p) {
24 $p->_Seal();
23 my @parents; 25 my @parents;
24 push @parents, @{ $p->{$_parents} } if $p->{$_parents}; 26 push @parents, @{ $p->{$_parents} } if $p->{$_parents};
25 push @parents, $p; 27 push @parents, $p;
26 $this->{$_parents} = \@parents; 28 $this->{$_parents} = \@parents;
27 $this->{$_state} = [ map $_->{$_timestamp}, @parents ]; 29 $this->{$_parentRev} = $p->{$_timestamp};
28 } 30 }
29 31
30 $this->{$_timestamp} = 0; 32 $this->{$_timestamp} = 0;
31 $this->{$_cache} = {}; 33 $this->{$_cache} = {};
32 $this->{$_entries} = []; 34 $this->{$_entries} = [];
33 } 35 }
34 36
35 sub GetParent { 37 sub GetParent {
36 $_[0]->{$_parents} && $_[0]->{$_parents}[0]; 38 my ($this) = @_;
39
40 $this->{$_parents} && $this->{$_parents}[ @{ $this->{$_parents} } - 1 ];
41 }
42
43 sub _Seal {
44 unless ($_[0]->{$_sealed}) {
45 $_[0]->{$_sealed} = 1;
46 $_[0]->{$_timestamp} = 0; # from now the timestamp is important
47 }
37 } 48 }
38 49
39 sub _Validate { 50 sub _Validate {
40 my ($this) = @_; 51 my ($this) = @_;
41 52
42 my $parents = $this->{$_parents} 53 my $chain = $this->{$_parents}
43 or return; 54 or return 1;
44 my $state = $this->{$_state}; 55
45 my $len = @$parents; 56 my $rev = 0; # rev 0 means that parent was never modified
57 # this allows to made more efficient checks
46 my $flush; 58 my $flush;
47 59
48 for ( my $i = 0 ; $i < $len ; $i++ ) { 60 foreach my $bag (@$chain, $this) {
49 if ($flush) { 61 # we need to updated all bags after the first change was detected;
50 $parents->[$i]{$_cache} = {}; 62 if ($flush ||= $rev and $bag->{$_parentRev} != $rev) {
51 $state->[$i] = $parents->[$i]{$_timestamp}; 63 $bag->{$_cache} = {};
52 } 64 $bag->{$_parentRev} = $rev;
53 else { 65 }
54 $flush = ( $parents->[$i]{$_timestamp} != $state->[$i] ); 66 $rev = $bag->{$_timestamp};
55 }
56 } 67 }
57 68
58 if ($flush) { 69 return $flush ? 0 : 1;
59 $this->{$_cache} = {};
60 return 0;
61 }
62
63 return 1;
64 } 70 }
65 71
66 sub Resolve { 72 sub Resolve {
67 my ( $this, $role ) = @_; 73 my ( $this, $role ) = @_;
68 74
69 if ( my $d = $this->GetDescriptor() ) { 75 die IMPL::InvalidArgumentException->new('role')
76 unless defined $role;
77
78 if ( my $d = $this->_GetDescriptor($role) ) {
70 return $d->{value}; 79 return $d->{value};
71 } 80 }
72 else { 81 else {
73 return; 82 return;
74 } 83 }
75 } 84 }
76 85
77 sub GetDescriptor { 86 sub _GetDescriptor {
78 my ( $this, $role ) = @_; 87 my ( $this, $role ) = @_;
79 88
80 my $d = $this->{$_cache}{$role}; 89 my $d = $this->{$_cache}{$role};
81 90
82 # return descriptor if this is own descriptor and its level is 1 (i.e. it can't be overriden by the parent cache) 91 # return descriptor if this is own descriptor and its level is 1 (i.e. it can't be overriden by the parent cache)
83 # otherwise the cache must be validated 92 # otherwise the cache must be validated
84 return $d 93 return $d
85 if $d 94 if $d
86 and ( ( $d->{owner} == $this and $d->{isa}{$role} == 1 ) 95 and ( ( $d->{owner} == $this and $d->{isa}{$role} == 1 )
87 or $this->_Validate() ); 96 or $this->_Validate() );
97
98 # if there were no descriptor in cache we need to ensure that the cache
99 # chain is valid before reolving starts
100 $this->_Validate() unless $d;
88 101
89 # the cache chain is valid 102 # the cache chain is valid
90 # $d is not a valid descriptor 103 # $d is not a valid descriptor
91 104
92 $d = undef; 105 $d = undef;
125 my ( $this, $role ) = @_; 138 my ( $this, $role ) = @_;
126 139
127 return [ 140 return [
128 map $_->{value}, 141 map $_->{value},
129 grep $_->{isa}{$role}, 142 grep $_->{isa}{$role},
130 map $_->{$_entries}, 143 map @{$_->{$_entries}},
131 @{ $this->{$_parents} || [] }, 144 @{ $this->{$_parents} || [] },
132 $this 145 $this
133 ]; 146 ];
134 147
135 } 148 }
136 149
137 sub Register { 150 sub Register {
138 my ( $this, $isa, $value ) = @_; 151 my ( $this, $isa, $value ) = @_;
139 152
140 $isa = { $isa, 1 } unless isHash($isa); 153 $isa = { $isa, 1 } unless ishash($isa);
141 154
142 push @{ $this->{$_entries} }, 155 push @{ $this->{$_entries} },
143 { owner => $this, isa => $isa, value => $value }; 156 { owner => $this, isa => $isa, value => $value };
144 $this->{$_timestamp}++; 157 $this->{$_timestamp}++;
145 158