annotate Lib/Schema/Form.pm @ 60:b0c068da93ac

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