Mercurial > pub > Impl

comparison Lib/Schema/Form.pm @ 0:03e58a454b20

Find changesets by keywords (author, files, the commit message), revision number or hash, or revset expression.
Создан репозитарий
author Sergey
date Tue, 14 Jul 2009 12:54:37 +0400
parents
children 16ada169ca75
comparison
equal deleted inserted replaced
-1:000000000000 0:03e58a454b20
1 package Configuration;
2 our $DataDir;
3 package Schema::Form;
4 use strict;
5 use Storable;
6 use Common;
7 use URI::file;
8 use BNFCompiler;
9 use Schema::Form::Container;
10 use Schema::Form::Field;
11 use Schema::Form::Filter;
12 use Schema::Form::Format;
13 our @ISA = qw(Object);
14
15 BEGIN {
16 DeclareProperty Name => ACCESS_READ;
17 DeclareProperty Body => ACCESS_READ;
18 }
19
20 sub CTOR {
21 my ($this,%args) = @_;
22
23 $this->{$Name} = $args{Name};
24
25 }
26
27 sub SetBody {
28 my ($this, $containerBody) = @_;
29 $this->{$Body} = $containerBody;
30 }
31
32 sub list {
33 return( map { UNIVERSAL::isa($_,'ARRAY') ? @{$_} : defined $_ ? $_ : () } @_ );
34 }
35
36 sub LoadForms {
37 my ($class,$File,$CacheDir,$Encoding) = @_;
38
39 $Encoding or die new Exception('An encoding must be specified for forms');
40
41 my $Compiler = new BNFCompiler(SchemaCache => "${DataDir}Cache/",Transform => sub { BNFCompiler::DOM::TransformDOMToHash(@_,{skip_spaces => 1})} );
42 $Compiler->LoadBNFSchema(file => 'Schema/form.def');
43
44 my %Context = (Compiler => $Compiler, Encoding => $Encoding);
45
46 $class->ProcessFile(URI::file->new_abs($File),URI::file->new_abs($CacheDir),\%Context);
47
48 $Compiler->Dispose;
49
50 return $Context{Forms};
51 }
52
53 sub ProcessFile {
54 my ($class,$uriFile,$uriCacheDir,$refContext) = @_;
55
56 return 1 if $refContext->{'Processed'}{$uriFile->as_string};
57 $refContext->{'Processed'}{$uriFile->as_string} = 1;
58
59 my $Data;
60 my $file = $uriFile->file;
61 my $fnameCached = $file;
62 $fnameCached =~ s/[\\\/:]+/_/g;
63 $fnameCached .= '.cfm';
64 $fnameCached = URI::file->new($fnameCached)->abs($uriCacheDir)->file;
65
66 if ( -e $fnameCached && -f $fnameCached && ( -M $file >= -M $fnameCached ) ) {
67 $Data = retrieve($fnameCached);
68 } else {
69 my $Compiler = $refContext->{'Compiler'};
70 local $/ = undef;
71 open my $hfile,"<:encoding($refContext->{Encoding})",$file or die new Exception('Failed to open file',$file);
72 $Data = $Compiler->Parse(<$hfile>);
73 store($Data,$fnameCached);
74 }
75
76
77 my $uriDir = URI::file->new('./')->abs($uriFile);
78
79 my $needRebuild = 0;
80
81 foreach my $inc (list $Data->{_include}) {
82 $needRebuild ||= $class->ProcessFile(URI::file->new($inc->{file_name})->abs($uriDir),$uriCacheDir,$refContext);
83 }
84
85 foreach my $use (list $Data->{_use}) {
86 $refContext->{Filters}{$use->{alias}} = { Class => join '', list $use->{mod_name} };
87 $refContext->{Require}{$use->{mod_name}} = 1;
88 }
89
90 foreach my $container (list $Data->{container}) {
91 if ($container->{type} eq 'Form') {
92 $class->ConstructForm($container,$refContext);
93 } elsif ($container->{type} eq 'Format') {
94 $class->ConstructFormat($container,$refContext);
95 } elsif ($container->{type} eq 'Filter') {
96 $class->ConstructFilter($container,$refContext);
97 }
98 }
99 }
100
101 sub ProcessContainer {
102 my ($class,$container,$refContext) = @_;
103 }
104
105 sub ConstructForm {
106 my ($class,$container,$refContext) = @_;
107
108 $container->{type} eq 'Form' or die new Exception("Unexpected container type");
109
110 not $refContext->{Forms}{$container->{name}} or die new Exception('The form is already exists',$container->{name});
111
112 my $Form = new Schema::Form(Name => $container->{name});
113
114 $Form->SetBody($class->ConstructGroup($container,$refContext));
115
116 $refContext->{Forms}{$Form->Name} = $Form;
117 }
118
119 sub ConstructGroup {
120 my($class,$container,$refContext) = @_;
121
122 my $Group = new Schema::Form::Container(
123 Name => $container->{name},
124 isMulti => ($container->{multi} ? 1 : 0)
125 );
126
127 foreach my $child (list $container->{body}{container}) {
128 my $obj;
129 if ($child->{type} eq 'Group') {
130 $obj = $class->ConstructGroup($child,$refContext);
131 } else {
132 $obj = $class->ConstructField($child,$refContext);
133 }
134 $Group->AddChild($obj);
135 }
136
137 foreach my $filter (list $container->{expression}) {
138 $Group->AddFilter($class->FilterInstance($filter,$refContext,$container->{name}));
139 }
140
141 foreach my $attr (list $container->{body}{body_property}) {
142 $Group->Attributes->{$attr->{complex_name}} = $class->ScalarExpression($attr->{expression},$container->{name});
143 }
144
145 return $Group;
146 }
147
148 sub ConstructField {
149 my ($class,$container,$refContext) = @_;
150
151 my $Format = $refContext->{Formats}{$container->{type}} or die new Exception('An undefined format name', $container->{type});
152
153 my $Field = Schema::Form::Field->new(
154 Name => $container->{name},
155 isMulti => ($container->{multi} ? 1 : 0),
156 Format => $Format
157 );
158
159 foreach my $filter (list $container->{expression}) {
160 $Field->AddFilter($class->FilterInstance($filter,$refContext,$container->{name}));
161 }
162
163 foreach my $attr (list $container->{body}{body_property}) {
164 $Field->Attributes->{ref $attr->{complex_name} ? join '', @{$attr->{complex_name}} : $attr->{complex_name}} = $class->ScalarExpression($attr->{expression},$container->{name});
165 }
166
167 return $Field;
168 }
169
170 sub FilterInstance {
171 my ($class,$expr,$refContext,$where) = @_;
172
173 my $filter = $expr->{instance} or die new Exception('Invalid filter syntax',$where);
174
175 my $filterClass = $refContext->{Filters}{$filter->{name}}{Class} or die new Exception('Using undefined filter name',$filter->{name},$where);
176
177 my @Args = map { $class->ScalarExpression($_,$where) } list $filter->{expression};
178
179 my $Filter = Schema::Form::Filter->new(
180 Name => $filter->{name},
181 Class => $filterClass,
182 Args => \@Args
183 );
184
185 if ($refContext->{Filters}{$filter->{name}}{Attributes}) {
186 while (my ($name,$value) = each %{$refContext->{Filters}{$filter->{name}}{Attributes}}) {
187 $Filter->Attributes->{$name} = $value;
188 }
189 }
190
191 return $Filter;
192 }
193
194 sub ScalarExpression {
195 my ($class,$expr,$where) = @_;
196
197 my $val;
198 if ($expr->{instance}) {
199 $val = $expr->{instance}{name};
200 } elsif ($expr->{string}) {
201 $val = join '', list $expr->{string};
202 $val =~ s/\\(.)/
203 if ($1 eq '"' or $1 eq '\\') {
204 $1;
205 } else {
206 "\\$1";
207 }
208 /ge;
209 } elsif ($expr->{number}) {
210 $val = join '', list $expr->{number};
211 } else {
212 die new Exception('Scalar expression required');
213 }
214
215 return $val;
216 }
217
218 sub ConstructFormat {
219 my ($class,$container,$refContext) = @_;
220
221 my $Format = Schema::Form::Format->new (
222 Name => $container->{name}
223 );
224
225 foreach my $filter (list $container->{expression}) {
226 $Format->AddFilter($class->FilterInstance($filter,$refContext,$container->{name}));
227 }
228
229 foreach my $attr (list $container->{body}{body_property}) {
230 $Format->Attributes->{ref $attr->{complex_name} ? join '', @{$attr->{complex_name}} : $attr->{complex_name}} = $class->ScalarExpression($attr->{expression},$container->{name});
231 }
232
233 $refContext->{Formats}{$Format->Name} = $Format;
234 }
235
236 sub ConstructFilter {
237 my ($class,$container,$refContext) = @_;
238
239 foreach my $attr (list $container->{body}{body_property}) {
240 $refContext->{Filters}{$container->{name}}{Attributes}{ref $attr->{complex_name} ? join '', @{$attr->{complex_name}} : $attr->{complex_name}} = $class->ScalarExpression($attr->{expression},$container->{name});
241 }
242 }
243
244 =pod
245 Form schema - îïèñàíèå ôîðìû ââîäà è ïðàâèëà êîíòðîëÿ
246
247 Form instance - çíà÷åíèÿ ýëåìåíòîâ ôîðìû
248
249 =cut
250
251
252 1;