407
|
1 package IMPL::Config;
|
|
2 use strict;
|
|
3 use warnings;
|
|
4 use mro;
|
|
5
|
|
6 use Carp qw(carp);
|
|
7
|
|
8 use IMPL::lang qw(is);
|
|
9 use IMPL::Exception;
|
|
10 use IMPL::Const qw(:access);
|
|
11 use IMPL::declare {
|
|
12 require => {
|
|
13 PropertyInfo => 'IMPL::Class::PropertyInfo',
|
|
14 XmlFormatter => 'IMPL::Serialization::XmlFormatter',
|
|
15 Serializer => '-IMPL::Serializer',
|
|
16 Activator => '-IMPL::Config::Activator',
|
|
17
|
|
18 Exception => 'IMPL::Exception',
|
|
19 IOException => '-IMPL::IOException'
|
|
20 },
|
|
21 base => [
|
|
22 'IMPL::Object::Accessor' => undef,
|
|
23 'IMPL::Object::Serializable' => undef,
|
|
24 'IMPL::Object::Autofill' => '@_'
|
|
25 ]
|
|
26 };
|
|
27
|
|
28 use File::Spec();
|
|
29
|
|
30
|
|
31 our $ConfigBase ||= '';
|
|
32 our $AppBase;
|
|
33
|
|
34 sub LoadXMLFile {
|
|
35 my ($self,$file) = @_;
|
|
36
|
|
37 my $class = ref $self || $self;
|
|
38
|
|
39 my $serializer = Serializer->new(
|
|
40 formatter => XmlFormatter->new(
|
|
41 IdentOutput => 1,
|
|
42 SkipWhitespace => 1
|
|
43 )
|
|
44 );
|
|
45
|
|
46 open my $hFile,'<',$file or die IOException->new("Failed to open file",$file,$!);
|
|
47
|
|
48 my $obj;
|
|
49 eval {
|
|
50 $obj = $serializer->Deserialize($hFile);
|
|
51 };
|
|
52
|
|
53 if ($@) {
|
|
54 my $e=$@;
|
|
55 die Exception->new("Can't load the configuration file",$file,$e);
|
|
56 }
|
|
57 return $obj;
|
|
58 }
|
|
59
|
|
60 sub SaveXMLFile {
|
|
61 my ($this,$file) = @_;
|
|
62
|
|
63 my $serializer = Serializer->new(
|
|
64 formatter => XmlFormatter->new(
|
|
65 IdentOutput => 1,
|
|
66 SkipWhitespace => 1
|
|
67 )
|
|
68 );
|
|
69
|
|
70 open my $hFile,'>',$file or die IOException->new("Failed to open file",$file,$!);
|
|
71
|
|
72 $serializer->Serialize($hFile, $this);
|
|
73 }
|
|
74
|
|
75 sub xml {
|
|
76 my $this = shift;
|
|
77 my $serializer = Serializer->new(
|
|
78 formatter => XmlFormatter->new(
|
|
79 IdentOutput => 1,
|
|
80 SkipWhitespace => 1
|
|
81 )
|
|
82 );
|
|
83 my $str = '';
|
|
84 open my $hFile,'>',\$str or die IOException->new("Failed to open stream",$!);
|
|
85
|
|
86 $serializer->Serialize($hFile, $this);
|
|
87
|
|
88 undef $hFile;
|
|
89
|
|
90 return $str;
|
|
91 }
|
|
92
|
|
93 sub save {
|
|
94 my ($this,$ctx) = @_;
|
|
95
|
|
96 my $val;
|
|
97
|
|
98 $val = $this->rawGet($_) and $ctx->AddVar($_ => $val) foreach map $_->Name, $this->get_meta(
|
|
99 PropertyInfo,
|
|
100 sub {
|
|
101 $_->access == ACCESS_PUBLIC and
|
|
102 $_->setter;
|
|
103 },
|
|
104 1);
|
|
105 }
|
|
106
|
|
107 sub spawn {
|
|
108 my ($this,$file) = @_;
|
|
109 unless ($file) {
|
|
110 ($file = ref $this || $this) =~ s/:+/./g;
|
|
111 $file .= ".xml";
|
|
112 }
|
|
113 return $this->LoadXMLFile( File::Spec->catfile($ConfigBase,$file) );
|
|
114 }
|
|
115
|
|
116 sub get {
|
|
117 my $this = shift;
|
|
118
|
|
119 if (@_ == 1) {
|
|
120 my $obj = $this->SUPER::get(@_);
|
|
121 return is($obj,Activator) ? $obj->activate : $obj;
|
|
122 } else {
|
|
123 my @objs = $this->SUPER::get(@_);
|
|
124 return map is($_,Activator) ? $_->activate : $_, @objs ;
|
|
125 }
|
|
126 }
|
|
127
|
|
128 sub rawGet {
|
|
129 my $this = shift;
|
|
130 return $this->SUPER::get(@_);
|
|
131 }
|
|
132
|
|
133 sub Exists {
|
|
134 $_[0]->SUPER::get($_[1]) ? 1 : 0;
|
|
135 }
|
|
136
|
|
137 sub AppBase {
|
|
138 carp "obsolete";
|
|
139 shift;
|
|
140 File::Spec->catdir($AppBase,@_);
|
|
141 }
|
|
142
|
|
143 sub AppDir {
|
|
144 shift;
|
|
145 File::Spec->catdir($AppBase,@_);
|
|
146 }
|
|
147
|
|
148 sub AppFile {
|
|
149 shift;
|
|
150 File::Spec->catfile($AppBase,@_);
|
|
151 }
|
|
152
|
|
153 sub ConfigBase {
|
|
154 carp "obsolete";
|
|
155 shift;
|
|
156 File::Spec->catdir($ConfigBase,@_);
|
|
157 }
|
|
158
|
|
159 sub ConfigDir {
|
|
160 shift;
|
|
161 File::Spec->catdir($ConfigBase,@_);
|
|
162 }
|
|
163
|
|
164 sub ConfigFile {
|
|
165 shift;
|
|
166 File::Spec->catfile($ConfigBase,@_);
|
|
167 }
|
|
168
|
|
169 1;
|
|
170 __END__
|
|
171
|
|
172 =pod
|
|
173
|
|
174 =head1 NAME
|
|
175
|
|
176 C<IMPL::Config> - базовый класс для настраиваемого приложения.
|
|
177
|
|
178 =head1 SYNOPSIS
|
|
179
|
|
180 =begin code
|
|
181
|
|
182 # define application
|
|
183
|
|
184 package MyApp;
|
|
185 use parent qw(IMPL::Config);
|
|
186
|
|
187 use IMPL::Class::Property;
|
|
188 use IMPL::Config::Class;
|
|
189
|
|
190 BEGIN {
|
|
191 public property SimpleString => prop_all;
|
|
192 public property DataSource => prop_all;
|
|
193 }
|
|
194
|
|
195 sub CTOR {
|
|
196 my $this = shift;
|
|
197
|
|
198 $this->DataSource(
|
|
199 new IMPL::Config::Activator(
|
|
200 factory => 'MyDataSource',
|
|
201 parameters=>{
|
|
202 host => 'localhost',
|
|
203 user => 'dbuser'
|
|
204 }
|
|
205 )
|
|
206 ) unless $this->Exists('DataSource');
|
|
207 }
|
|
208
|
|
209 # using application object
|
|
210
|
|
211 my $app = spawn MyApp('default.xml');
|
|
212
|
|
213 $app->Run();
|
|
214
|
|
215 =end code
|
|
216
|
|
217 Ниже приведен пример файла C<default.xml> содержащего настройки приложения
|
|
218
|
|
219 =begin code xml
|
|
220
|
|
221 <app type='MyApp'>
|
|
222 <SimpleString>The application</SimpleString>
|
|
223 <DataSource type='IMPL::Config::Activator'>
|
|
224 <factory>MyDataSourceClass</factory>
|
|
225 <parameters type='HASH'>
|
|
226 <host>localhost</host>
|
|
227 <user>dbuser</user>
|
|
228 </parameters>
|
|
229 </DataSource>
|
|
230 </app>
|
|
231
|
|
232 =end code xml
|
|
233
|
|
234 =head1 DESCRIPTION
|
|
235
|
|
236 C<[Serializable]>
|
|
237
|
|
238 C<[Autofill]>
|
|
239
|
|
240 C<use parent IMPL::Object::Accessor>
|
|
241
|
|
242 Базовый класс для приложений. Использует подход, что приложение
|
|
243 является объектом, состояние которого предтавляет собой конфигурацию,
|
|
244 а методы - логику.
|
|
245
|
|
246 Данный класс реализует функционал десериализации (и сериализации) экземпляра
|
|
247 приложения из XML документа. Для этого используется механизм C<IMPL::Serialization>.
|
|
248 При этом используются опции C<IMPL::Serialization::XmlFormatter> C<IdentOutput> и
|
|
249 C<SkipWhitespace> для записи документа в легко читаемом виде.
|
|
250
|
|
251 Поскольку в результате восстановления приложения восстанавливаются все элементы
|
|
252 из файла конфигурации, то это может потребовать значительных ресурсов для
|
|
253 создания частей, которые могут никогда не понадобиться. Например, не требуется инициализация
|
|
254 источника данных для передачи пользователю статических данных, сохраненных на диске.
|
|
255
|
|
256 Для решения этой проблемы используются специальные объекты C<IMPL::Config::Activator>.
|
|
257
|
|
258 Если у приложения описано свойство, в котором хранится C<IMPL::Config::Activator>, то
|
|
259 при первом обращении к такому свойству, будет создан объект вызовом метода
|
|
260 C<< IMPL::Config::Activator->activate() >> и возвращен как значение этого свойства.
|
|
261 Таким образом реализуется прозрачная отложенная активация объектов, что позволяет
|
|
262 экономить ресурсы.
|
|
263
|
|
264 =head1 MEMBERS
|
|
265
|
|
266 =over
|
|
267
|
|
268 =item C<[static] LoadXMLFile($fileName) >
|
|
269
|
|
270 Создает из XML файла C<$fileName> экземпляр приложения
|
|
271
|
|
272 =item C<SaveXMLFile($fileName)>
|
|
273
|
|
274 Сохраняет приложение в файл C<$fileName>
|
|
275
|
|
276 =item C<[get] xml >
|
|
277
|
|
278 Сохраняет конфигурацию приложения в XML строку.
|
|
279
|
|
280 =item C<[static,operator] spawn($file)>
|
|
281
|
|
282 Синоним для C<LoadXMLFile>, предполагается использование как оператора.
|
|
283
|
|
284 =item C<rawGet($propname,...)>
|
|
285
|
|
286 Метод для получения значений свойств приложения. Данный метод позволяет избежать
|
|
287 использование активации объектов через C<IMPL::Config::Activator>.
|
|
288
|
|
289 =back
|
|
290
|
|
291 =cut
|