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