Mercurial > pub > Impl

comparison Lib/IMPL/Config.pm @ 395:212cc86e470b

Find changesets by keywords (author, files, the commit message), revision number or hash, or revset expression.
Code cleanup DateTime locale support for HTTP requests
author sergey
date Thu, 20 Feb 2014 01:33:03 +0400
parents 4ddb27ff4a0b
children
comparison
equal deleted inserted replaced
394:2c14f66efa08 395:212cc86e470b
1 package IMPL::Config; 1 package IMPL::Config;
2 use strict; 2 use strict;
3 use warnings; 3 use warnings;
4 4 use mro;
5
6 use Carp qw(carp);
7
8 use IMPL::lang qw(is);
9 use IMPL::Exception;
5 use IMPL::Const qw(:access); 10 use IMPL::Const qw(:access);
6 use IMPL::declare { 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 },
7 base => [ 21 base => [
8 'IMPL::Object::Accessor' => undef, 22 'IMPL::Object::Accessor' => undef,
9 'IMPL::Object::Serializable' => undef, 23 'IMPL::Object::Serializable' => undef,
10 'IMPL::Object::Autofill' => '@_' 24 'IMPL::Object::Autofill' => '@_'
11 ] 25 ]
12 }; 26 };
13 27
14 use File::Spec(); 28 use File::Spec();
15 29
16 use IMPL::Class::Member;
17 use IMPL::Class::PropertyInfo;
18 use IMPL::Exception;
19
20 use IMPL::Serialization;
21 use IMPL::Serialization::XmlFormatter;
22 30
23 our $ConfigBase ||= ''; 31 our $ConfigBase ||= '';
24 our $AppBase; 32 our $AppBase;
25 33
26 sub LoadXMLFile { 34 sub LoadXMLFile {
27 my ($self,$file) = @_; 35 my ($self,$file) = @_;
28 36
29 my $class = ref $self || $self; 37 my $class = ref $self || $self;
30 38
31 my $serializer = new IMPL::Serializer( 39 my $serializer = Serializer->new(
32 formatter => new IMPL::Serialization::XmlFormatter( 40 formatter => XmlFormatter->new(
33 IdentOutput => 1, 41 IdentOutput => 1,
34 SkipWhitespace => 1 42 SkipWhitespace => 1
35 ) 43 )
36 ); 44 );
37 45
38 open my $hFile,'<',$file or die new IMPL::Exception("Failed to open file",$file,$!); 46 open my $hFile,'<',$file or die IOException->new("Failed to open file",$file,$!);
39 47
40 my $obj; 48 my $obj;
41 eval { 49 eval {
42 $obj = $serializer->Deserialize($hFile); 50 $obj = $serializer->Deserialize($hFile);
43 }; 51 };
44 52
45 if ($@) { 53 if ($@) {
46 my $e=$@; 54 my $e=$@;
47 die new IMPL::Exception("Can't load the configuration file",$file,$e); 55 die Exception->new("Can't load the configuration file",$file,$e);
48 } 56 }
49 return $obj; 57 return $obj;
50 } 58 }
51 59
52 sub SaveXMLFile { 60 sub SaveXMLFile {
53 my ($this,$file) = @_; 61 my ($this,$file) = @_;
54 62
55 my $serializer = new IMPL::Serializer( 63 my $serializer = Serializer->new(
56 formatter => new IMPL::Serialization::XmlFormatter( 64 formatter => XmlFormatter->new(
57 IdentOutput => 1, 65 IdentOutput => 1,
58 SkipWhitespace => 1 66 SkipWhitespace => 1
59 ) 67 )
60 ); 68 );
61 69
62 open my $hFile,'>',$file or die new IMPL::Exception("Failed to open file",$file,$!); 70 open my $hFile,'>',$file or die IOException->new("Failed to open file",$file,$!);
63 71
64 $serializer->Serialize($hFile, $this); 72 $serializer->Serialize($hFile, $this);
65 } 73 }
66 74
67 sub xml { 75 sub xml {
68 my $this = shift; 76 my $this = shift;
69 my $serializer = new IMPL::Serializer( 77 my $serializer = Serializer->new(
70 formatter => new IMPL::Serialization::XmlFormatter( 78 formatter => XmlFormatter->new(
71 IdentOutput => 1, 79 IdentOutput => 1,
72 SkipWhitespace => 1 80 SkipWhitespace => 1
73 ) 81 )
74 ); 82 );
75 my $str = ''; 83 my $str = '';
76 open my $hFile,'>',\$str or die new IMPL::Exception("Failed to open stream",$!); 84 open my $hFile,'>',\$str or die IOException->new("Failed to open stream",$!);
77 85
78 $serializer->Serialize($hFile, $this); 86 $serializer->Serialize($hFile, $this);
79 87
80 undef $hFile; 88 undef $hFile;
81 89
86 my ($this,$ctx) = @_; 94 my ($this,$ctx) = @_;
87 95
88 my $val; 96 my $val;
89 97
90 $val = $this->rawGet($_) and $ctx->AddVar($_ => $val) foreach map $_->Name, $this->get_meta( 98 $val = $this->rawGet($_) and $ctx->AddVar($_ => $val) foreach map $_->Name, $this->get_meta(
91 'IMPL::Class::PropertyInfo', 99 PropertyInfo,
92 sub { 100 sub {
93 $_->access == ACCESS_PUBLIC and 101 $_->access == ACCESS_PUBLIC and
94 $_->setter; 102 $_->setter;
95 }, 103 },
96 1); 104 1);
108 sub get { 116 sub get {
109 my $this = shift; 117 my $this = shift;
110 118
111 if (@_ == 1) { 119 if (@_ == 1) {
112 my $obj = $this->SUPER::get(@_); 120 my $obj = $this->SUPER::get(@_);
113 return UNIVERSAL::isa($obj,'IMPL::Config::Activator') ? $obj->activate : $obj; 121 return is($obj,Activator) ? $obj->activate : $obj;
114 } else { 122 } else {
115 my @objs = $this->SUPER::get(@_); 123 my @objs = $this->SUPER::get(@_);
116 return map UNIVERSAL::isa($_,'IMPL::Config::Activator') ? $_->activate : $_, @objs ; 124 return map is($_,Activator) ? $_->activate : $_, @objs ;
117 } 125 }
118 } 126 }
119 127
120 sub rawGet { 128 sub rawGet {
121 my $this = shift; 129 my $this = shift;
125 sub Exists { 133 sub Exists {
126 $_[0]->SUPER::get($_[1]) ? 1 : 0; 134 $_[0]->SUPER::get($_[1]) ? 1 : 0;
127 } 135 }
128 136
129 sub AppBase { 137 sub AppBase {
138 carp "obsolete";
130 shift; 139 shift;
131 File::Spec->catdir($AppBase,@_); 140 File::Spec->catdir($AppBase,@_);
132 } 141 }
133 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
134 sub ConfigBase { 153 sub ConfigBase {
154 carp "obsolete";
135 shift; 155 shift;
136 File::Spec->catdir($ConfigBase,@_); 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,@_);
137 } 167 }
138 168
139 1; 169 1;
140 __END__ 170 __END__
141 171