|
0
|
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;
|
