annotate Lib/Schema/Form.pm @ 20:267460284fb3

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