comparison lib/IMPL/Config/Bag.pm @ 417:3ed0c58e9da3 ref20150831

working on di container, tests
author cin
date Mon, 02 Nov 2015 01:56:53 +0300
parents 3d24b10dd0d5
children b0481c071bea
comparison
equal deleted inserted replaced
416:cc2cf8c0edc2 417:3ed0c58e9da3
39 39
40 $this->{$_parents} && $this->{$_parents}[ @{ $this->{$_parents} } - 1 ]; 40 $this->{$_parents} && $this->{$_parents}[ @{ $this->{$_parents} } - 1 ];
41 } 41 }
42 42
43 sub _Seal { 43 sub _Seal {
44 unless ($_[0]->{$_sealed}) { 44 unless ( $_[0]->{$_sealed} ) {
45 $_[0]->{$_sealed} = 1; 45 $_[0]->{$_sealed} = 1;
46 $_[0]->{$_timestamp} = 0; # from now the timestamp is important 46 $_[0]->{$_timestamp} = 0; # from now the timestamp is important
47 } 47 }
48 } 48 }
49 49
50 sub _Validate { 50 sub _Validate {
51 my ($this) = @_; 51 my ($this) = @_;
52 52
53 my $chain = $this->{$_parents} 53 my $chain = $this->{$_parents}
54 or return 1; 54 or return 1;
55 55
56 my $rev = 0; # rev 0 means that parent was never modified 56 my $rev = 0; # rev 0 means that parent was never modified
57 # this allows to made more efficient checks 57 # this allows to made more efficient checks
58 my $flush; 58 my $flush;
59 59
60 foreach my $bag (@$chain, $this) { 60 foreach my $bag ( @$chain, $this ) {
61
61 # we need to updated all bags after the first change was detected; 62 # we need to updated all bags after the first change was detected;
62 if ($flush ||= $rev and $bag->{$_parentRev} != $rev) { 63 if ( $flush ||= $rev and $bag->{$_parentRev} != $rev ) {
63 $bag->{$_cache} = {}; 64 $bag->{$_cache} = {};
64 $bag->{$_parentRev} = $rev; 65 $bag->{$_parentRev} = $rev;
65 } 66 }
66 $rev = $bag->{$_timestamp}; 67 $rev = $bag->{$_timestamp};
67 } 68 }
68 69
69 return $flush ? 0 : 1; 70 return $flush ? 0 : 1;
70 } 71 }
71 72
72 sub Resolve { 73 sub Resolve {
73 my ( $this, $role ) = @_; 74 my ( $this, $role ) = @_;
103 # $d is not a valid descriptor 104 # $d is not a valid descriptor
104 105
105 $d = undef; 106 $d = undef;
106 my $prev; 107 my $prev;
107 108
108 if ( my $parents = $this->{$_parents} ) { 109 my $parents = $this->{$_parents};
109 foreach my $bag ( @$parents, $this ) { 110 my @bags = $parents ? ( @$parents, $this ) : ($this);
110 111
111 # check the cache; 112 foreach my $bag (@bags) {
112 unless ( my $t = $bag->{$_cache}{$role} ) { 113
114 # check the cache;
115 unless ( my $t = $bag->{$_cache}{$role} ) {
113 116
114 # no cached entry this may be due cache flush 117 # no cached entry this may be due cache flush
115 # go through own entries and find better entry than inherited from parents 118 # go through own entries and find better entry than inherited from parents
116 foreach my $entry ( @{ $bag->{$_entries} } ) { 119 foreach my $entry ( @{ $bag->{$_entries} } ) {
117 my $level = $entry->{isa}{$role}; 120 my $level = $entry->{isa}{$role};
118 if ( $level and ( not($prev) or $level <= $prev ) ) { 121 if ( $level and ( not($prev) or $level <= $prev ) ) {
119 $d = $entry; 122 $d = $entry;
120 $prev = $level; 123 $prev = $level;
121 }
122 } 124 }
125 }
123 126
124 #cache it 127 #cache it
125 $bag->{$_cache}{$role} = $d if $d; 128 $bag->{$_cache}{$role} = $d if $d;
126 } 129 }
127 else { 130 else {
128 $d = $t; 131 $d = $t;
129 $prev = $d->{isa}{$role}; 132 $prev = $d->{isa}{$role};
130 }
131 } 133 }
132 } 134 }
133 135
134 return $d; 136 return $d;
135 } 137 }
138 my ( $this, $role ) = @_; 140 my ( $this, $role ) = @_;
139 141
140 return [ 142 return [
141 map $_->{value}, 143 map $_->{value},
142 grep $_->{isa}{$role}, 144 grep $_->{isa}{$role},
143 map @{$_->{$_entries}}, 145 map @{ $_->{$_entries} },
144 @{ $this->{$_parents} || [] }, 146 @{ $this->{$_parents} || [] },
145 $this 147 $this
146 ]; 148 ];
147 149
148 } 150 }