|
407
|
1 package IMPL::Config::ServicesBag;
|
|
|
2
|
|
|
3 require v5.9.5;
|
|
|
4
|
|
|
5 use mro;
|
|
|
6
|
|
|
7 use IMPL::Const qw(:prop);
|
|
|
8 use IMPL::declare {
|
|
411
|
9 require => {
|
|
|
10 Entry => '-IMPL::Config::ServicesBag::Entry'
|
|
|
11 },
|
|
407
|
12 base => [
|
|
|
13 'IMPL::Object' => undef
|
|
|
14 ],
|
|
|
15 props => [
|
|
|
16 _prototype => PROP_RW,
|
|
|
17 _nameMap => PROP_RW,
|
|
|
18 _typeMap => PROP_RW,
|
|
|
19 _props => PROP_RW,
|
|
|
20 ]
|
|
|
21 };
|
|
|
22
|
|
|
23 sub CTOR {
|
|
|
24 my ( $this, $prototype ) = @_;
|
|
|
25
|
|
|
26 $this->_prototype($prototype) if $prototype;
|
|
|
27 $this->_nameMap( {} );
|
|
|
28 $this->_typeMap( {} );
|
|
|
29 }
|
|
|
30
|
|
|
31 sub GetDescriptorByName {
|
|
|
32 my ( $this, $name ) = @_;
|
|
|
33
|
|
|
34 my $d = $this->_nameMap->{$name};
|
|
|
35 return $d if $d and $d->{valid};
|
|
|
36
|
|
|
37 my $parent = $this->_prototype;
|
|
|
38
|
|
|
39 if ( $parent and $d = $parent->GetDescriptorByName($name) ) {
|
|
|
40 return $this->_nameMap->{$name} = $d;
|
|
|
41 }
|
|
|
42
|
|
|
43 return undef;
|
|
|
44 }
|
|
|
45
|
|
|
46 sub GetDescriptorByType {
|
|
|
47 my ( $this, $type ) = @_;
|
|
|
48
|
|
|
49 my $d = $this->_typeMap->{$type};
|
|
|
50 return $d if $d and $d->{valid};
|
|
|
51
|
|
|
52 my $parent = $this->_prototype;
|
|
|
53 if ( $parent and $d = $parent->GetDescriptorByType($type) ) {
|
|
|
54 return $this->_typeMap->{$type} = $d;
|
|
|
55 }
|
|
|
56
|
|
|
57 return undef;
|
|
|
58 }
|
|
|
59
|
|
|
60 sub RegisterValue {
|
|
|
61 my ( $this, $value, $name, $type ) = @_;
|
|
|
62
|
|
411
|
63 my $d = Entry->new( {owner => $this, value => $value} );
|
|
407
|
64
|
|
|
65 if ($type) {
|
|
|
66 my $map = $this->_typeMap;
|
|
|
67 my $isa = mro::get_linear_isa($type);
|
|
|
68 $d->{isa} = $isa;
|
|
|
69
|
|
|
70 # the service record which is superseded by the current one
|
|
|
71 my $replaces = $this->GetDescriptorByType($type);
|
|
|
72
|
|
|
73 foreach my $t (@$isa) {
|
|
|
74 if ( my $prev = $this->GetDescriptorByType($t) ) {
|
|
|
75
|
|
|
76 # keep previous registrations if they are valid
|
|
|
77 next if not $replaces or $prev != $replaces;
|
|
|
78 }
|
|
|
79
|
|
|
80 $map->{$t} = $d;
|
|
|
81 }
|
|
|
82
|
|
|
83 # invalidate cache
|
|
411
|
84 $replaces->Invalidate() if $replaces;
|
|
|
85
|
|
407
|
86 }
|
|
|
87
|
|
|
88 if ($name) {
|
|
|
89 my $prev = $this->_nameMap->{$name};
|
|
|
90 $d->{name} = $name;
|
|
|
91 $this->_nameMap->{$name} = $d;
|
|
411
|
92 $prev->Invalidate() if $prev;
|
|
407
|
93 }
|
|
|
94
|
|
|
95 return $d;
|
|
|
96 }
|
|
|
97
|
|
411
|
98 sub _UpdateDescriptor {
|
|
407
|
99 my ( $this, $d ) = @_;
|
|
|
100
|
|
411
|
101 my $d2 = Entry->new($d);
|
|
407
|
102
|
|
|
103 # update named entries
|
|
|
104 my $name = $d->{name};
|
|
|
105 if ( $name and $this->_nameMap->{$name} == $d ) {
|
|
|
106 $this->_nameMap->{$name} = $d2;
|
|
|
107 }
|
|
|
108
|
|
|
109 # update type entries
|
|
|
110 if ( my $isa = $d->{isa} ) {
|
|
|
111 my $map = $this->_typeMap;
|
|
|
112 foreach my $t (@$isa) {
|
|
|
113 next unless $map->{$t} == $d;
|
|
|
114 $map->{$t} = $d2;
|
|
|
115 }
|
|
|
116 }
|
|
|
117
|
|
|
118 $d->{valid} = 0;
|
|
|
119 }
|
|
|
120
|
|
411
|
121 package IMPL::Config::ServicesBag::Entry;
|
|
|
122 use IMPL::Exception();
|
|
|
123 use IMPL::declare {
|
|
|
124 base => [
|
|
|
125 'IMPL::Object::Fields' => undef
|
|
|
126 ]
|
|
|
127 };
|
|
|
128
|
|
|
129 my @fields = qw(owner type isa valid value);
|
|
|
130 use fields @fields;
|
|
|
131
|
|
|
132 sub CTOR {
|
|
|
133 my SELF $this = shift;
|
|
|
134 my $args = shift;
|
|
|
135
|
|
|
136 $this->{valid} = 1;
|
|
|
137 $this->{owner} = $args{owner} or die IMPL::InvalidArgumentException->new("owner");
|
|
|
138 $this->{value} = $args{value} if exists $args->{value};
|
|
|
139 $this->{isa} = $args{isa} if $args->{isa};
|
|
|
140 }
|
|
|
141
|
|
|
142 sub Invalidate {
|
|
|
143 my SELF $this = shift;
|
|
|
144
|
|
|
145 $this->{owner}->_UpdateDescriptor($this);
|
|
|
146 }
|
|
|
147
|
|
407
|
148 1;
|
|
|
149
|
|
|
150 __END__
|
|
|
151
|
|
|
152 =pod
|
|
|
153
|
|
|
154 =head1 NAME
|
|
|
155
|
|
|
156 =head1 SYNOPSIS
|
|
|
157
|
|
|
158 =head1 DESCRIPTION
|
|
|
159
|
|
|
160 Коллекция сервисов построена на прототиптровании экземпляров, т.е. при создании
|
|
|
161 новой коллекции может указваться базовая коллекция в которой будет происходить
|
|
|
162 поиск сервисов в случае их отсутсвия в основной. Для оптимизации данного процесса
|
|
|
163 сервисы кешируются, чтобы избежать можестрвенных операций поиска по иерархии
|
|
|
164 коллекций, для этого каждый сервис описывается дескриптором:
|
|
|
165
|
|
|
166 =over
|
|
|
167
|
|
|
168 =item * isa массив типов сервиса, если он регистрировался как сервис
|
|
|
169
|
|
|
170 =item * value значение
|
|
|
171
|
|
|
172 =item * valid признак того, что дескриптор действителен
|
|
|
173
|
|
|
174 =item * owner коллекция, которая создала данный дескриптор
|
|
|
175
|
|
|
176 =back
|
|
|
177
|
|
|
178 Если запрашиваемый десриптор не найден это является ошибкой, поэтому негативные
|
|
|
179 ответы не кешируются
|
|
|
180
|
|
|
181 =cut
|
