|
412
|
1 package IMPL::Config::Bag;
|
|
|
2 use strict;
|
|
|
3
|
|
414
|
4 use IMPL::lang qw(:base);
|
|
412
|
5 use IMPL::declare {
|
|
413
|
6 base => [
|
|
|
7 'IMPL::Object' => undef
|
|
|
8 ],
|
|
|
9 props => [
|
|
414
|
10 _parents => '*rw', # array of parent bags
|
|
|
11 _state => '*rw', #array of previous timestamps
|
|
|
12 _cache => '*rw', # own or cached entries
|
|
|
13 _timestamp => '*rw',
|
|
|
14 _entries => '*rw', # each entry is represented by hash
|
|
|
15 # { isa => linear_isa_hash, owner => owner_of_the_entry, value => value }
|
|
413
|
16 ]
|
|
412
|
17 };
|
|
|
18
|
|
413
|
19 sub CTOR {
|
|
414
|
20 my ( $this, $p ) = @_;
|
|
|
21
|
|
|
22 if ($p) {
|
|
|
23 my @parents;
|
|
|
24 push @parents, @{ $p->{$_parents} } if $p->{$_parents};
|
|
|
25 push @parents, $p;
|
|
|
26 $this->{$_parents} = \@parents;
|
|
|
27 $this->{$_state} = [ map $_->{$_timestamp}, @parents ];
|
|
|
28 }
|
|
|
29
|
|
|
30 $this->{$_timestamp} = 0;
|
|
|
31 $this->{$_cache} = {};
|
|
|
32 $this->{$_entries} = [];
|
|
|
33 }
|
|
|
34
|
|
|
35 sub GetParent {
|
|
|
36 $_[0]->{$_parents} && $_[0]->{$_parents}[0];
|
|
|
37 }
|
|
|
38
|
|
|
39 sub _Validate {
|
|
|
40 my ($this) = @_;
|
|
|
41
|
|
|
42 my $parents = $this->{$_parents}
|
|
|
43 or return;
|
|
|
44 my $state = $this->{$_state};
|
|
|
45 my $len = @$parents;
|
|
|
46 my $flush;
|
|
|
47
|
|
|
48 for ( my $i = 0 ; $i < $len ; $i++ ) {
|
|
|
49 if ($flush) {
|
|
|
50 $parents->[$i]{$_cache} = {};
|
|
|
51 $state->[$i] = $parents->[$i]{$_timestamp};
|
|
|
52 }
|
|
|
53 else {
|
|
|
54 $flush = ( $parents->[$i]{$_timestamp} != $state->[$i] );
|
|
|
55 }
|
|
|
56 }
|
|
|
57
|
|
|
58 if ($flush) {
|
|
|
59 $this->{$_cache} = {};
|
|
|
60 return 0;
|
|
|
61 }
|
|
|
62
|
|
|
63 return 1;
|
|
413
|
64 }
|
|
|
65
|
|
412
|
66 sub Resolve {
|
|
414
|
67 my ( $this, $role ) = @_;
|
|
|
68
|
|
|
69 if ( my $d = $this->GetDescriptor() ) {
|
|
|
70 return $d->{value};
|
|
|
71 }
|
|
|
72 else {
|
|
|
73 return;
|
|
|
74 }
|
|
413
|
75 }
|
|
|
76
|
|
|
77 sub GetDescriptor {
|
|
414
|
78 my ( $this, $role ) = @_;
|
|
|
79
|
|
413
|
80 my $d = $this->{$_cache}{$role};
|
|
414
|
81
|
|
|
82 # 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
|
|
|
84 return $d
|
|
|
85 if $d
|
|
|
86 and ( ( $d->{owner} == $this and $d->{isa}{$role} == 1 )
|
|
|
87 or $this->_Validate() );
|
|
|
88
|
|
|
89 # the cache chain is valid
|
|
|
90 # $d is not a valid descriptor
|
|
|
91
|
|
|
92 $d = undef;
|
|
|
93 my $prev;
|
|
|
94
|
|
|
95 if ( my $parents = $this->{$_parents} ) {
|
|
|
96 foreach my $bag ( @$parents, $this ) {
|
|
|
97
|
|
|
98 # check the cache;
|
|
|
99 unless ( my $t = $bag->{$_cache}{$role} ) {
|
|
|
100
|
|
|
101 # no cached entry this may be due cache flush
|
|
|
102 # go through own entries and find better entry than inherited from parents
|
|
|
103 foreach my $entry ( @{ $bag->{$_entries} } ) {
|
|
|
104 my $level = $entry->{isa}{$role};
|
|
|
105 if ( $level and ( not($prev) or $level <= $prev ) ) {
|
|
|
106 $d = $entry;
|
|
|
107 $prev = $level;
|
|
|
108 }
|
|
|
109 }
|
|
|
110
|
|
|
111 #cache it
|
|
|
112 $bag->{$_cache}{$role} = $d if $d;
|
|
|
113 }
|
|
|
114 else {
|
|
|
115 $d = $t;
|
|
|
116 $prev = $d->{isa}{$role};
|
|
|
117 }
|
|
|
118 }
|
|
413
|
119 }
|
|
414
|
120
|
|
|
121 return $d;
|
|
413
|
122 }
|
|
|
123
|
|
|
124 sub ResolveAll {
|
|
414
|
125 my ( $this, $role ) = @_;
|
|
|
126
|
|
|
127 return [
|
|
|
128 map $_->{value},
|
|
|
129 grep $_->{isa}{$role},
|
|
|
130 map $_->{$_entries},
|
|
|
131 @{ $this->{$_parents} || [] },
|
|
|
132 $this
|
|
|
133 ];
|
|
|
134
|
|
413
|
135 }
|
|
|
136
|
|
|
137 sub Register {
|
|
414
|
138 my ( $this, $isa, $value ) = @_;
|
|
|
139
|
|
|
140 $isa = { $isa, 1 } unless isHash($isa);
|
|
413
|
141
|
|
414
|
142 push @{ $this->{$_entries} },
|
|
|
143 { owner => $this, isa => $isa, value => $value };
|
|
|
144 $this->{$_timestamp}++;
|
|
|
145
|
|
|
146 delete $this->{$_cache}{$_} foreach keys %$isa;
|
|
|
147
|
|
|
148 return $this;
|
|
412
|
149 }
|
|
|
150
|
|
414
|
151 1;
|
