Mercurial > pub > Impl
annotate Lib/IMPL/Config.pm @ 63:76b878ad6596
Added serialization support for the IMPL::Object::List
More intelligent Exception message
Fixed encoding support in the actions
Improoved tests
Minor fixes
author | wizard |
---|---|
date | Mon, 15 Mar 2010 02:38:09 +0300 |
parents | b0c068da93ac |
children | 2f31ecabe9ea |
rev | line source |
---|---|
49 | 1 package IMPL::Config; |
2 use strict; | |
3 use warnings; | |
4 | |
60
b0c068da93ac
Lazy activation for the configuration objects (final concept)
wizard
parents:
58
diff
changeset
|
5 use base qw(IMPL::Object::Accessor IMPL::Object::Serializable IMPL::Object::Autofill); |
49 | 6 |
7 __PACKAGE__->PassThroughArgs; | |
8 | |
9 use IMPL::Class::Member; | |
10 use IMPL::Class::PropertyInfo; | |
11 use IMPL::Exception; | |
12 | |
13 use IMPL::Serialization; | |
14 use IMPL::Serialization::XmlFormatter; | |
15 | |
60
b0c068da93ac
Lazy activation for the configuration objects (final concept)
wizard
parents:
58
diff
changeset
|
16 |
b0c068da93ac
Lazy activation for the configuration objects (final concept)
wizard
parents:
58
diff
changeset
|
17 |
49 | 18 sub LoadXMLFile { |
19 my ($self,$file) = @_; | |
20 | |
21 my $class = ref $self || $self; | |
22 | |
23 my $serializer = new IMPL::Serializer( | |
24 Formatter => new IMPL::Serialization::XmlFormatter( | |
25 IdentOutput => 1, | |
26 SkipWhitespace => 1 | |
27 ) | |
28 ); | |
29 | |
30 open my $hFile,'<',$file or die new IMPL::Exception("Failed to open file",$file,$!); | |
31 | |
32 my $obj; | |
33 eval { | |
34 $obj = $serializer->Deserialize($hFile); | |
35 }; | |
36 | |
37 if ($@) { | |
38 my $e=$@; | |
39 die new IMPL::Exception("Can't load the configuration file",$file,$e); | |
40 } | |
41 return $obj; | |
42 } | |
43 | |
44 sub SaveXMLFile { | |
45 my ($this,$file) = @_; | |
46 | |
47 my $serializer = new IMPL::Serializer( | |
48 Formatter => new IMPL::Serialization::XmlFormatter( | |
49 IdentOutput => 1, | |
50 SkipWhitespace => 1 | |
51 ) | |
52 ); | |
53 | |
54 open my $hFile,'>',$file or die new IMPL::Exception("Failed to open file",$file,$!); | |
55 | |
56 $serializer->Serialize($hFile, $this); | |
57 } | |
58 | |
59 sub xml { | |
60 my $this = shift; | |
61 my $serializer = new IMPL::Serializer( | |
62 Formatter => new IMPL::Serialization::XmlFormatter( | |
63 IdentOutput => 1, | |
64 SkipWhitespace => 1 | |
65 ) | |
66 ); | |
67 my $str = ''; | |
68 open my $hFile,'>',\$str or die new IMPL::Exception("Failed to open stream",$!); | |
69 | |
70 $serializer->Serialize($hFile, $this); | |
71 | |
72 undef $hFile; | |
73 | |
74 return $str; | |
75 } | |
76 | |
77 sub save { | |
78 my ($this,$ctx) = @_; | |
63
76b878ad6596
Added serialization support for the IMPL::Object::List
wizard
parents:
60
diff
changeset
|
79 |
76b878ad6596
Added serialization support for the IMPL::Object::List
wizard
parents:
60
diff
changeset
|
80 my $val; |
49 | 81 |
63
76b878ad6596
Added serialization support for the IMPL::Object::List
wizard
parents:
60
diff
changeset
|
82 $val = $this->rawGet($_) and $ctx->AddVar($_ => $val) foreach map $_->Name, $this->get_meta( |
76b878ad6596
Added serialization support for the IMPL::Object::List
wizard
parents:
60
diff
changeset
|
83 'IMPL::Class::PropertyInfo', |
76b878ad6596
Added serialization support for the IMPL::Object::List
wizard
parents:
60
diff
changeset
|
84 sub { |
76b878ad6596
Added serialization support for the IMPL::Object::List
wizard
parents:
60
diff
changeset
|
85 $_->Access == IMPL::Class::Member::MOD_PUBLIC and |
76b878ad6596
Added serialization support for the IMPL::Object::List
wizard
parents:
60
diff
changeset
|
86 $_->canGet; |
76b878ad6596
Added serialization support for the IMPL::Object::List
wizard
parents:
60
diff
changeset
|
87 }, |
76b878ad6596
Added serialization support for the IMPL::Object::List
wizard
parents:
60
diff
changeset
|
88 1); |
49 | 89 } |
90 | |
58 | 91 sub spawn { |
92 goto &LoadXMLFile; | |
93 } | |
94 | |
60
b0c068da93ac
Lazy activation for the configuration objects (final concept)
wizard
parents:
58
diff
changeset
|
95 sub get { |
b0c068da93ac
Lazy activation for the configuration objects (final concept)
wizard
parents:
58
diff
changeset
|
96 my $this = shift; |
b0c068da93ac
Lazy activation for the configuration objects (final concept)
wizard
parents:
58
diff
changeset
|
97 |
b0c068da93ac
Lazy activation for the configuration objects (final concept)
wizard
parents:
58
diff
changeset
|
98 if (@_ == 1) { |
b0c068da93ac
Lazy activation for the configuration objects (final concept)
wizard
parents:
58
diff
changeset
|
99 my $obj = $this->SUPER::get(@_); |
b0c068da93ac
Lazy activation for the configuration objects (final concept)
wizard
parents:
58
diff
changeset
|
100 return UNIVERSAL::isa($obj,'IMPL::Config::Activator') ? $obj->activate : $obj; |
b0c068da93ac
Lazy activation for the configuration objects (final concept)
wizard
parents:
58
diff
changeset
|
101 } else { |
b0c068da93ac
Lazy activation for the configuration objects (final concept)
wizard
parents:
58
diff
changeset
|
102 my @objs = $this->SUPER::get(@_); |
b0c068da93ac
Lazy activation for the configuration objects (final concept)
wizard
parents:
58
diff
changeset
|
103 return map UNIVERSAL::isa($_,'IMPL::Config::Activator') ? $_->activate : $_, @objs ; |
b0c068da93ac
Lazy activation for the configuration objects (final concept)
wizard
parents:
58
diff
changeset
|
104 } |
b0c068da93ac
Lazy activation for the configuration objects (final concept)
wizard
parents:
58
diff
changeset
|
105 } |
b0c068da93ac
Lazy activation for the configuration objects (final concept)
wizard
parents:
58
diff
changeset
|
106 |
b0c068da93ac
Lazy activation for the configuration objects (final concept)
wizard
parents:
58
diff
changeset
|
107 sub rawGet { |
b0c068da93ac
Lazy activation for the configuration objects (final concept)
wizard
parents:
58
diff
changeset
|
108 my $this = shift; |
b0c068da93ac
Lazy activation for the configuration objects (final concept)
wizard
parents:
58
diff
changeset
|
109 return $this->SUPER::get(@_); |
b0c068da93ac
Lazy activation for the configuration objects (final concept)
wizard
parents:
58
diff
changeset
|
110 } |
b0c068da93ac
Lazy activation for the configuration objects (final concept)
wizard
parents:
58
diff
changeset
|
111 |
b0c068da93ac
Lazy activation for the configuration objects (final concept)
wizard
parents:
58
diff
changeset
|
112 sub Exists { |
b0c068da93ac
Lazy activation for the configuration objects (final concept)
wizard
parents:
58
diff
changeset
|
113 $_[0]->SUPER::get($_[1]) ? 1 : 0; |
b0c068da93ac
Lazy activation for the configuration objects (final concept)
wizard
parents:
58
diff
changeset
|
114 } |
b0c068da93ac
Lazy activation for the configuration objects (final concept)
wizard
parents:
58
diff
changeset
|
115 |
49 | 116 1; |
117 __END__ | |
118 | |
119 =pod | |
120 | |
121 =h1 SYNOPSIS | |
122 | |
123 package App::Config | |
124 use base qw(IMPL::Config) | |
125 | |
126 use IMPL::Class::Property; | |
127 use IMPL::Config::Class; | |
128 | |
129 BEGIN { | |
130 public property SimpleString => prop_all; | |
131 public property MyClass => prop_all; | |
60
b0c068da93ac
Lazy activation for the configuration objects (final concept)
wizard
parents:
58
diff
changeset
|
132 public property DataSource => prop_all; |
49 | 133 } |
134 | |
135 sub CTOR { | |
136 my $this = shift; | |
137 | |
60
b0c068da93ac
Lazy activation for the configuration objects (final concept)
wizard
parents:
58
diff
changeset
|
138 $this->MyClass(new IMPL::Config::Class(Type => 'MyClass'')) unless $this->MyClass; |
b0c068da93ac
Lazy activation for the configuration objects (final concept)
wizard
parents:
58
diff
changeset
|
139 $this->DataSource( |
b0c068da93ac
Lazy activation for the configuration objects (final concept)
wizard
parents:
58
diff
changeset
|
140 new IMPL::Config::Activator( |
b0c068da93ac
Lazy activation for the configuration objects (final concept)
wizard
parents:
58
diff
changeset
|
141 type => 'MyDataSource', |
b0c068da93ac
Lazy activation for the configuration objects (final concept)
wizard
parents:
58
diff
changeset
|
142 args=>{ |
b0c068da93ac
Lazy activation for the configuration objects (final concept)
wizard
parents:
58
diff
changeset
|
143 host => 'localhost', |
b0c068da93ac
Lazy activation for the configuration objects (final concept)
wizard
parents:
58
diff
changeset
|
144 user => 'dbuser' |
b0c068da93ac
Lazy activation for the configuration objects (final concept)
wizard
parents:
58
diff
changeset
|
145 } |
b0c068da93ac
Lazy activation for the configuration objects (final concept)
wizard
parents:
58
diff
changeset
|
146 ) |
b0c068da93ac
Lazy activation for the configuration objects (final concept)
wizard
parents:
58
diff
changeset
|
147 ) unless $this->Exists('DataSource'); |
49 | 148 } |
149 | |
58 | 150 # in some script |
151 | |
152 my $app = spawn App::Config('default.xml'); | |
153 | |
154 $app->Run(); | |
155 | |
49 | 156 =head1 DESCRIPTION |
157 | |
158 Позволяет сохранить/загрузить конфигурацию. Также все классы конфигурации | |
159 должны наследоваться от данного класса, и все Public свойства будут | |
160 автоматически сохраняться и восстанавливаться. | |
161 | |
162 =head1 MEMBERS | |
163 | |
164 =over | |
165 | |
60
b0c068da93ac
Lazy activation for the configuration objects (final concept)
wizard
parents:
58
diff
changeset
|
166 =item C<< IMPL::Config->LoadXMLFile($fileName) >> |
b0c068da93ac
Lazy activation for the configuration objects (final concept)
wizard
parents:
58
diff
changeset
|
167 |
49 | 168 Создает из XML файла экземпляр приложения |
169 | |
60
b0c068da93ac
Lazy activation for the configuration objects (final concept)
wizard
parents:
58
diff
changeset
|
170 =item C<< $instance->SaveXMLFile($fileName) >> |
b0c068da93ac
Lazy activation for the configuration objects (final concept)
wizard
parents:
58
diff
changeset
|
171 |
49 | 172 Сохраняет приложение в файл |
173 | |
60
b0c068da93ac
Lazy activation for the configuration objects (final concept)
wizard
parents:
58
diff
changeset
|
174 =item C<< xml >> |
b0c068da93ac
Lazy activation for the configuration objects (final concept)
wizard
parents:
58
diff
changeset
|
175 |
49 | 176 Сохраняет конфигурацию приложения в XML строку |
177 | |
60
b0c068da93ac
Lazy activation for the configuration objects (final concept)
wizard
parents:
58
diff
changeset
|
178 =item C<< IMPL::Config->spawn($file) >> |
b0c068da93ac
Lazy activation for the configuration objects (final concept)
wizard
parents:
58
diff
changeset
|
179 |
b0c068da93ac
Lazy activation for the configuration objects (final concept)
wizard
parents:
58
diff
changeset
|
180 Синоним для C<LoadXMLFile> |
b0c068da93ac
Lazy activation for the configuration objects (final concept)
wizard
parents:
58
diff
changeset
|
181 |
49 | 182 =back |
183 | |
184 =cut |