Mercurial > pub > Impl
annotate Lib/IMPL/Web/TT/Form.pm @ 159:f8de52d3c112
IMPL::Test::Unit minor changes
author | wizard |
---|---|
date | Mon, 27 Dec 2010 01:37:44 +0300 |
parents | a9f4ba4783eb |
children | 4267a2ac3d46 |
rev | line source |
---|---|
122 | 1 use strict; |
2 package IMPL::Web::TT::Form; | |
3 | |
4 use base qw(IMPL::Web::TT::Control); | |
5 | |
124 | 6 use IMPL::Class::Property; |
148
e6447ad85cb4
DOM objects now have a schema and schemaSource properties
wizard
parents:
145
diff
changeset
|
7 use IMPL::DOM::Navigator::SchemaNavigator(); |
e6447ad85cb4
DOM objects now have a schema and schemaSource properties
wizard
parents:
145
diff
changeset
|
8 |
126 | 9 __PACKAGE__->PassThroughArgs; |
124 | 10 |
11 BEGIN { | |
12 public property base => prop_all; | |
13 public property schema => prop_all; | |
14 public property errors => prop_all; | |
15 public property data => prop_all; | |
138 | 16 public property state => prop_all; |
17 public property formResult => prop_all; | |
124 | 18 } |
19 | |
20 sub CTOR { | |
21 my ($this) = @_; | |
22 | |
138 | 23 if (my $form = $this->formResult) { |
24 $this->base($form->{formName}); | |
25 $this->errors($form->{formErrors}); | |
26 $this->data($form->{formData}); | |
27 $this->schema($form->{formSchema}); | |
28 $this->state($form->{state}); | |
29 } else { | |
124 | 30 |
138 | 31 $this->base($this->nodeName) unless $this->base; |
32 | |
33 die new IMPL::InvalidArgumentException('A schema is required for a form',$this->nodeName) | |
34 unless eval { $this->schema->isa( typeof IMPL::DOM::Schema ) }; | |
126 | 35 |
138 | 36 die new IMPL::InvalidOperationException('Can\'t find a form definition in a schema',$this->nodeName,$this->base) |
37 unless $this->schema->selectNodes(sub { $_->nodeName eq 'ComplexNode' and $_->name eq $this->base }); | |
38 } | |
39 | |
126 | 40 $this->errors([]) unless $this->errors; |
124 | 41 } |
42 | |
148
e6447ad85cb4
DOM objects now have a schema and schemaSource properties
wizard
parents:
145
diff
changeset
|
43 sub fillContents { |
e6447ad85cb4
DOM objects now have a schema and schemaSource properties
wizard
parents:
145
diff
changeset
|
44 my ($this) = @_; |
e6447ad85cb4
DOM objects now have a schema and schemaSource properties
wizard
parents:
145
diff
changeset
|
45 |
e6447ad85cb4
DOM objects now have a schema and schemaSource properties
wizard
parents:
145
diff
changeset
|
46 my $schema = $this->schema->selectSingleNode(sub { $_->nodeName eq 'ComplexNode' and $_->name eq $this->base }); |
e6447ad85cb4
DOM objects now have a schema and schemaSource properties
wizard
parents:
145
diff
changeset
|
47 |
e6447ad85cb4
DOM objects now have a schema and schemaSource properties
wizard
parents:
145
diff
changeset
|
48 $this->buildContainer( |
e6447ad85cb4
DOM objects now have a schema and schemaSource properties
wizard
parents:
145
diff
changeset
|
49 $schema, |
e6447ad85cb4
DOM objects now have a schema and schemaSource properties
wizard
parents:
145
diff
changeset
|
50 $schema, |
e6447ad85cb4
DOM objects now have a schema and schemaSource properties
wizard
parents:
145
diff
changeset
|
51 $this->data->isComplex ? $this->data : undef, |
e6447ad85cb4
DOM objects now have a schema and schemaSource properties
wizard
parents:
145
diff
changeset
|
52 $this |
e6447ad85cb4
DOM objects now have a schema and schemaSource properties
wizard
parents:
145
diff
changeset
|
53 ); |
e6447ad85cb4
DOM objects now have a schema and schemaSource properties
wizard
parents:
145
diff
changeset
|
54 } |
e6447ad85cb4
DOM objects now have a schema and schemaSource properties
wizard
parents:
145
diff
changeset
|
55 |
e6447ad85cb4
DOM objects now have a schema and schemaSource properties
wizard
parents:
145
diff
changeset
|
56 sub buildContainer { |
e6447ad85cb4
DOM objects now have a schema and schemaSource properties
wizard
parents:
145
diff
changeset
|
57 my ($this,$schemaSource,$schema,$domNode,$container,$path) = @_; |
e6447ad85cb4
DOM objects now have a schema and schemaSource properties
wizard
parents:
145
diff
changeset
|
58 |
e6447ad85cb4
DOM objects now have a schema and schemaSource properties
wizard
parents:
145
diff
changeset
|
59 $path = [@{$path || []},{node => $domNode, schemaSource => $schemaSource}]; |
e6447ad85cb4
DOM objects now have a schema and schemaSource properties
wizard
parents:
145
diff
changeset
|
60 |
e6447ad85cb4
DOM objects now have a schema and schemaSource properties
wizard
parents:
145
diff
changeset
|
61 $container ||= $this->document->Create($schemaSource->name,'IMPL::Web::TT::Collection'); |
e6447ad85cb4
DOM objects now have a schema and schemaSource properties
wizard
parents:
145
diff
changeset
|
62 |
e6447ad85cb4
DOM objects now have a schema and schemaSource properties
wizard
parents:
145
diff
changeset
|
63 foreach my $schemaItem ( $schema->content->childNodes ) { |
e6447ad85cb4
DOM objects now have a schema and schemaSource properties
wizard
parents:
145
diff
changeset
|
64 my $schemaItemSource = $schemaItem; |
e6447ad85cb4
DOM objects now have a schema and schemaSource properties
wizard
parents:
145
diff
changeset
|
65 |
e6447ad85cb4
DOM objects now have a schema and schemaSource properties
wizard
parents:
145
diff
changeset
|
66 $schemaItem = $this->schema->resolveType($schemaItem->type) |
e6447ad85cb4
DOM objects now have a schema and schemaSource properties
wizard
parents:
145
diff
changeset
|
67 if typeof $schemaItem eq typeof IMPL::DOM::Schema::Node; |
e6447ad85cb4
DOM objects now have a schema and schemaSource properties
wizard
parents:
145
diff
changeset
|
68 |
e6447ad85cb4
DOM objects now have a schema and schemaSource properties
wizard
parents:
145
diff
changeset
|
69 my @nodesData = $domNode->selectNodes(sub { $_->schemaSource == $schemaItemSource } ) if $domNode; |
e6447ad85cb4
DOM objects now have a schema and schemaSource properties
wizard
parents:
145
diff
changeset
|
70 |
e6447ad85cb4
DOM objects now have a schema and schemaSource properties
wizard
parents:
145
diff
changeset
|
71 push @nodesData, undef unless @nodesData; |
e6447ad85cb4
DOM objects now have a schema and schemaSource properties
wizard
parents:
145
diff
changeset
|
72 |
e6447ad85cb4
DOM objects now have a schema and schemaSource properties
wizard
parents:
145
diff
changeset
|
73 if ($schemaItem->isa(typeof IMPL::DOM::Schema::ComplexNode) ) { |
e6447ad85cb4
DOM objects now have a schema and schemaSource properties
wizard
parents:
145
diff
changeset
|
74 $this->appendChild( $this->buildContainer($schemaItemSource,$schemaItem,$_,undef,$path) ) foreach @nodesData; |
e6447ad85cb4
DOM objects now have a schema and schemaSource properties
wizard
parents:
145
diff
changeset
|
75 } elsif ($schemaItem->isa(typeof IMPL::DOM::Schema::SimpleNode)) { |
e6447ad85cb4
DOM objects now have a schema and schemaSource properties
wizard
parents:
145
diff
changeset
|
76 $this->appendChild( $this->buildControl($schemaItemSource,$schemaItem,$_,$path) ) foreach @nodesData; |
e6447ad85cb4
DOM objects now have a schema and schemaSource properties
wizard
parents:
145
diff
changeset
|
77 } |
e6447ad85cb4
DOM objects now have a schema and schemaSource properties
wizard
parents:
145
diff
changeset
|
78 } |
e6447ad85cb4
DOM objects now have a schema and schemaSource properties
wizard
parents:
145
diff
changeset
|
79 |
e6447ad85cb4
DOM objects now have a schema and schemaSource properties
wizard
parents:
145
diff
changeset
|
80 return $container; |
e6447ad85cb4
DOM objects now have a schema and schemaSource properties
wizard
parents:
145
diff
changeset
|
81 } |
e6447ad85cb4
DOM objects now have a schema and schemaSource properties
wizard
parents:
145
diff
changeset
|
82 |
e6447ad85cb4
DOM objects now have a schema and schemaSource properties
wizard
parents:
145
diff
changeset
|
83 sub buildControl { |
e6447ad85cb4
DOM objects now have a schema and schemaSource properties
wizard
parents:
145
diff
changeset
|
84 my ($this,$schemaSource,$schema,$node,$path) = @_; |
e6447ad85cb4
DOM objects now have a schema and schemaSource properties
wizard
parents:
145
diff
changeset
|
85 |
e6447ad85cb4
DOM objects now have a schema and schemaSource properties
wizard
parents:
145
diff
changeset
|
86 my @errors; |
e6447ad85cb4
DOM objects now have a schema and schemaSource properties
wizard
parents:
145
diff
changeset
|
87 |
e6447ad85cb4
DOM objects now have a schema and schemaSource properties
wizard
parents:
145
diff
changeset
|
88 if ($node) { |
e6447ad85cb4
DOM objects now have a schema and schemaSource properties
wizard
parents:
145
diff
changeset
|
89 @errors = grep { ($_->Node || $_->Parent) == $node } @{$this->errors}; |
e6447ad85cb4
DOM objects now have a schema and schemaSource properties
wizard
parents:
145
diff
changeset
|
90 } else { |
e6447ad85cb4
DOM objects now have a schema and schemaSource properties
wizard
parents:
145
diff
changeset
|
91 @errors = grep $_->Schema == $schemaSource, @{$this->errors}; |
e6447ad85cb4
DOM objects now have a schema and schemaSource properties
wizard
parents:
145
diff
changeset
|
92 } |
e6447ad85cb4
DOM objects now have a schema and schemaSource properties
wizard
parents:
145
diff
changeset
|
93 |
e6447ad85cb4
DOM objects now have a schema and schemaSource properties
wizard
parents:
145
diff
changeset
|
94 return $this->document->CreateControl( |
e6447ad85cb4
DOM objects now have a schema and schemaSource properties
wizard
parents:
145
diff
changeset
|
95 $schemaSource->name, |
e6447ad85cb4
DOM objects now have a schema and schemaSource properties
wizard
parents:
145
diff
changeset
|
96 $this->mapType($schemaSource), |
e6447ad85cb4
DOM objects now have a schema and schemaSource properties
wizard
parents:
145
diff
changeset
|
97 { |
e6447ad85cb4
DOM objects now have a schema and schemaSource properties
wizard
parents:
145
diff
changeset
|
98 schema => $schema, |
e6447ad85cb4
DOM objects now have a schema and schemaSource properties
wizard
parents:
145
diff
changeset
|
99 sourceSchema => $schemaSource, |
e6447ad85cb4
DOM objects now have a schema and schemaSource properties
wizard
parents:
145
diff
changeset
|
100 errors => \@errors, |
e6447ad85cb4
DOM objects now have a schema and schemaSource properties
wizard
parents:
145
diff
changeset
|
101 data => $node, |
158 | 102 inputType => $schemaSource->nodeProperty('inputType') || $schema->nodeProperty('inputType'), |
148
e6447ad85cb4
DOM objects now have a schema and schemaSource properties
wizard
parents:
145
diff
changeset
|
103 nodeValue => $node && $node->nodeValue, # small hack set a non dom class property through |
e6447ad85cb4
DOM objects now have a schema and schemaSource properties
wizard
parents:
145
diff
changeset
|
104 queryParameter => $this->makeParameterName([@$path,{ node => $node, schemaSource => $schemaSource}]) |
e6447ad85cb4
DOM objects now have a schema and schemaSource properties
wizard
parents:
145
diff
changeset
|
105 } |
e6447ad85cb4
DOM objects now have a schema and schemaSource properties
wizard
parents:
145
diff
changeset
|
106 ); |
e6447ad85cb4
DOM objects now have a schema and schemaSource properties
wizard
parents:
145
diff
changeset
|
107 } |
e6447ad85cb4
DOM objects now have a schema and schemaSource properties
wizard
parents:
145
diff
changeset
|
108 |
e6447ad85cb4
DOM objects now have a schema and schemaSource properties
wizard
parents:
145
diff
changeset
|
109 sub mapType { |
e6447ad85cb4
DOM objects now have a schema and schemaSource properties
wizard
parents:
145
diff
changeset
|
110 my ($this,$schema) = @_; |
e6447ad85cb4
DOM objects now have a schema and schemaSource properties
wizard
parents:
145
diff
changeset
|
111 |
e6447ad85cb4
DOM objects now have a schema and schemaSource properties
wizard
parents:
145
diff
changeset
|
112 $schema->nodeProperty('control') || |
e6447ad85cb4
DOM objects now have a schema and schemaSource properties
wizard
parents:
145
diff
changeset
|
113 ( $schema->type && $this->schema->resolveType($schema->type)->nodeProperty('control') ) |
e6447ad85cb4
DOM objects now have a schema and schemaSource properties
wizard
parents:
145
diff
changeset
|
114 or die new IMPL::Exception("Unable to get control class for the form element",$schema->path); |
e6447ad85cb4
DOM objects now have a schema and schemaSource properties
wizard
parents:
145
diff
changeset
|
115 } |
e6447ad85cb4
DOM objects now have a schema and schemaSource properties
wizard
parents:
145
diff
changeset
|
116 |
e6447ad85cb4
DOM objects now have a schema and schemaSource properties
wizard
parents:
145
diff
changeset
|
117 sub makeParameterName { |
e6447ad85cb4
DOM objects now have a schema and schemaSource properties
wizard
parents:
145
diff
changeset
|
118 my ($this,$path) = @_; |
e6447ad85cb4
DOM objects now have a schema and schemaSource properties
wizard
parents:
145
diff
changeset
|
119 |
e6447ad85cb4
DOM objects now have a schema and schemaSource properties
wizard
parents:
145
diff
changeset
|
120 join '/', map { |
e6447ad85cb4
DOM objects now have a schema and schemaSource properties
wizard
parents:
145
diff
changeset
|
121 $_->{node} ? |
e6447ad85cb4
DOM objects now have a schema and schemaSource properties
wizard
parents:
145
diff
changeset
|
122 ( |
e6447ad85cb4
DOM objects now have a schema and schemaSource properties
wizard
parents:
145
diff
changeset
|
123 $_->{node}->nodeProperty('instanceId') ? |
e6447ad85cb4
DOM objects now have a schema and schemaSource properties
wizard
parents:
145
diff
changeset
|
124 $_->{node}->nodeName . '['. ']' : |
e6447ad85cb4
DOM objects now have a schema and schemaSource properties
wizard
parents:
145
diff
changeset
|
125 $_->{node}->nodeName |
e6447ad85cb4
DOM objects now have a schema and schemaSource properties
wizard
parents:
145
diff
changeset
|
126 ) : |
e6447ad85cb4
DOM objects now have a schema and schemaSource properties
wizard
parents:
145
diff
changeset
|
127 ( |
e6447ad85cb4
DOM objects now have a schema and schemaSource properties
wizard
parents:
145
diff
changeset
|
128 $_->{schemaSource}->maxOccur eq 'unbounded' || $_->{schemaSource}->maxOccur > 1 ? |
e6447ad85cb4
DOM objects now have a schema and schemaSource properties
wizard
parents:
145
diff
changeset
|
129 $_->{schemaSource}->name . '[0]' : |
e6447ad85cb4
DOM objects now have a schema and schemaSource properties
wizard
parents:
145
diff
changeset
|
130 $_->{schemaSource}->name |
e6447ad85cb4
DOM objects now have a schema and schemaSource properties
wizard
parents:
145
diff
changeset
|
131 ) |
e6447ad85cb4
DOM objects now have a schema and schemaSource properties
wizard
parents:
145
diff
changeset
|
132 } @$path; |
e6447ad85cb4
DOM objects now have a schema and schemaSource properties
wizard
parents:
145
diff
changeset
|
133 } |
e6447ad85cb4
DOM objects now have a schema and schemaSource properties
wizard
parents:
145
diff
changeset
|
134 |
126 | 135 sub makeControlArgs{ |
136 my ($this,$path) = @_; | |
124 | 137 |
138 my $navi = new IMPL::DOM::Navigator::SchemaNavigator($this->schema); | |
126 | 139 my @path = ($this->base, split /\./,$path); |
124 | 140 |
126 | 141 $navi->NavigateName($_) or die new IMPL::InvalidArgumentException( |
124 | 142 "Can't find a definition for an element", |
143 $_, | |
144 $path, | |
126 | 145 $this->element, |
146 ) foreach @path; | |
124 | 147 |
148 my $schema = $navi->Current; | |
127
0dce0470a3d8
In the IMPL::Web::ControllerUnit added the ability to notify a form about a wrong data from a transaction
wizard
parents:
126
diff
changeset
|
149 my $sourceSchema = $navi->SourceSchemaNode; |
0dce0470a3d8
In the IMPL::Web::ControllerUnit added the ability to notify a form about a wrong data from a transaction
wizard
parents:
126
diff
changeset
|
150 my $queryParameter = join '/', @path; |
0dce0470a3d8
In the IMPL::Web::ControllerUnit added the ability to notify a form about a wrong data from a transaction
wizard
parents:
126
diff
changeset
|
151 shift @path; |
138 | 152 my $node = $this->data ? $this->data->selectSingleNode(@path) : undef; |
126 | 153 |
154 my @errors; | |
155 | |
156 if ($node) { | |
144
b56ebc31bf18
Empty nodes no more created while transforming a post request to the DOM document
wizard
parents:
138
diff
changeset
|
157 @errors = grep { ($_->Node || $_->Parent) == $node } @{$this->errors}; |
b56ebc31bf18
Empty nodes no more created while transforming a post request to the DOM document
wizard
parents:
138
diff
changeset
|
158 } else { |
b56ebc31bf18
Empty nodes no more created while transforming a post request to the DOM document
wizard
parents:
138
diff
changeset
|
159 @errors = grep $_->Schema == $sourceSchema, @{$this->errors}; |
126 | 160 } |
161 | |
162 return { | |
163 schema => $schema, | |
127
0dce0470a3d8
In the IMPL::Web::ControllerUnit added the ability to notify a form about a wrong data from a transaction
wizard
parents:
126
diff
changeset
|
164 sourceSchema => $sourceSchema, |
126 | 165 errors => \@errors, |
166 data => $node, | |
127
0dce0470a3d8
In the IMPL::Web::ControllerUnit added the ability to notify a form about a wrong data from a transaction
wizard
parents:
126
diff
changeset
|
167 nodeValue => $node && $node->nodeValue, # small hack set a non dom class property through |
158 | 168 queryParameter => $queryParameter, |
169 inputType => $sourceSchema->nodeProperty('inputType') || $schema->nodeProperty('inputType') | |
126 | 170 }; |
171 } | |
172 | |
145 | 173 sub makeContent { |
174 my ($this,$mappings) = @_; | |
175 | |
176 my $formSchema = $this->schema->selectSingleNode(sub { $_->nodeName eq 'ComplexNode' and $_->name eq $this->base } ) | |
177 or die new Exception("Cant find a schema element for the specified form", $this->base); | |
178 | |
179 my $doc = $this->document; | |
180 foreach my $itemSchema ( $formSchema->content->childNodes ) { | |
181 my $itemName = $itemSchema->name; | |
182 if (my $controlClass = $mappings->{$itemName} ) { | |
183 my $contorl = $doc->CreateControl($itemName,$controlClass,$this->makeControlArgs($itemName)); | |
184 $this->appendChild($contorl); | |
185 } | |
186 } | |
187 return; | |
188 } | |
189 | |
126 | 190 sub formErrors { |
191 my ($this) = @_; | |
192 | |
127
0dce0470a3d8
In the IMPL::Web::ControllerUnit added the ability to notify a form about a wrong data from a transaction
wizard
parents:
126
diff
changeset
|
193 if (my $node = $this->data ) { |
126 | 194 return [ |
195 grep { | |
196 ( $_->Node || $_->Parent) == $node | |
197 } @{$this->errors} | |
198 ]; | |
199 } else { | |
200 return []; | |
201 } | |
124 | 202 } |
203 | |
122 | 204 1; |
205 __END__ | |
206 | |
207 =pod | |
208 | |
209 =head1 NAME | |
210 | |
211 C<IMPL::Web::TT::Form> - Форма с элементами | |
212 | |
213 =head1 DESCRIPTION | |
214 | |
215 Является элементом управления, тоесть для своего преобразования ипользует | |
216 шаблон | |
217 | |
218 =cut |