Mercurial > pub > Impl
annotate Lib/IMPL/Web/TT/Form.pm @ 154:eb478083f72b
Url support
author | wizard |
---|---|
date | Thu, 30 Sep 2010 02:13:05 +0400 |
parents | e6447ad85cb4 |
children | a9f4ba4783eb |
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, |
e6447ad85cb4
DOM objects now have a schema and schemaSource properties
wizard
parents:
145
diff
changeset
|
102 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
|
103 queryParameter => $this->makeParameterName([@$path,{ node => $node, schemaSource => $schemaSource}]) |
e6447ad85cb4
DOM objects now have a schema and schemaSource properties
wizard
parents:
145
diff
changeset
|
104 } |
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 sub mapType { |
e6447ad85cb4
DOM objects now have a schema and schemaSource properties
wizard
parents:
145
diff
changeset
|
109 my ($this,$schema) = @_; |
e6447ad85cb4
DOM objects now have a schema and schemaSource properties
wizard
parents:
145
diff
changeset
|
110 |
e6447ad85cb4
DOM objects now have a schema and schemaSource properties
wizard
parents:
145
diff
changeset
|
111 $schema->nodeProperty('control') || |
e6447ad85cb4
DOM objects now have a schema and schemaSource properties
wizard
parents:
145
diff
changeset
|
112 ( $schema->type && $this->schema->resolveType($schema->type)->nodeProperty('control') ) |
e6447ad85cb4
DOM objects now have a schema and schemaSource properties
wizard
parents:
145
diff
changeset
|
113 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
|
114 } |
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 sub makeParameterName { |
e6447ad85cb4
DOM objects now have a schema and schemaSource properties
wizard
parents:
145
diff
changeset
|
117 my ($this,$path) = @_; |
e6447ad85cb4
DOM objects now have a schema and schemaSource properties
wizard
parents:
145
diff
changeset
|
118 |
e6447ad85cb4
DOM objects now have a schema and schemaSource properties
wizard
parents:
145
diff
changeset
|
119 join '/', map { |
e6447ad85cb4
DOM objects now have a schema and schemaSource properties
wizard
parents:
145
diff
changeset
|
120 $_->{node} ? |
e6447ad85cb4
DOM objects now have a schema and schemaSource properties
wizard
parents:
145
diff
changeset
|
121 ( |
e6447ad85cb4
DOM objects now have a schema and schemaSource properties
wizard
parents:
145
diff
changeset
|
122 $_->{node}->nodeProperty('instanceId') ? |
e6447ad85cb4
DOM objects now have a schema and schemaSource properties
wizard
parents:
145
diff
changeset
|
123 $_->{node}->nodeName . '['. ']' : |
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 ) : |
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 $_->{schemaSource}->maxOccur eq 'unbounded' || $_->{schemaSource}->maxOccur > 1 ? |
e6447ad85cb4
DOM objects now have a schema and schemaSource properties
wizard
parents:
145
diff
changeset
|
128 $_->{schemaSource}->name . '[0]' : |
e6447ad85cb4
DOM objects now have a schema and schemaSource properties
wizard
parents:
145
diff
changeset
|
129 $_->{schemaSource}->name |
e6447ad85cb4
DOM objects now have a schema and schemaSource properties
wizard
parents:
145
diff
changeset
|
130 ) |
e6447ad85cb4
DOM objects now have a schema and schemaSource properties
wizard
parents:
145
diff
changeset
|
131 } @$path; |
e6447ad85cb4
DOM objects now have a schema and schemaSource properties
wizard
parents:
145
diff
changeset
|
132 } |
e6447ad85cb4
DOM objects now have a schema and schemaSource properties
wizard
parents:
145
diff
changeset
|
133 |
126 | 134 sub makeControlArgs{ |
135 my ($this,$path) = @_; | |
124 | 136 |
137 my $navi = new IMPL::DOM::Navigator::SchemaNavigator($this->schema); | |
126 | 138 my @path = ($this->base, split /\./,$path); |
124 | 139 |
126 | 140 $navi->NavigateName($_) or die new IMPL::InvalidArgumentException( |
124 | 141 "Can't find a definition for an element", |
142 $_, | |
143 $path, | |
126 | 144 $this->element, |
145 ) foreach @path; | |
124 | 146 |
147 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
|
148 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
|
149 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
|
150 shift @path; |
138 | 151 my $node = $this->data ? $this->data->selectSingleNode(@path) : undef; |
126 | 152 |
153 my @errors; | |
154 | |
155 if ($node) { | |
144
b56ebc31bf18
Empty nodes no more created while transforming a post request to the DOM document
wizard
parents:
138
diff
changeset
|
156 @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
|
157 } else { |
b56ebc31bf18
Empty nodes no more created while transforming a post request to the DOM document
wizard
parents:
138
diff
changeset
|
158 @errors = grep $_->Schema == $sourceSchema, @{$this->errors}; |
126 | 159 } |
160 | |
161 return { | |
162 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
|
163 sourceSchema => $sourceSchema, |
126 | 164 errors => \@errors, |
165 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
|
166 nodeValue => $node && $node->nodeValue, # small hack set a non dom class property through |
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 queryParameter => $queryParameter |
126 | 168 }; |
169 } | |
170 | |
145 | 171 sub makeContent { |
172 my ($this,$mappings) = @_; | |
173 | |
174 my $formSchema = $this->schema->selectSingleNode(sub { $_->nodeName eq 'ComplexNode' and $_->name eq $this->base } ) | |
175 or die new Exception("Cant find a schema element for the specified form", $this->base); | |
176 | |
177 my $doc = $this->document; | |
178 foreach my $itemSchema ( $formSchema->content->childNodes ) { | |
179 my $itemName = $itemSchema->name; | |
180 if (my $controlClass = $mappings->{$itemName} ) { | |
181 my $contorl = $doc->CreateControl($itemName,$controlClass,$this->makeControlArgs($itemName)); | |
182 $this->appendChild($contorl); | |
183 } | |
184 } | |
185 return; | |
186 } | |
187 | |
126 | 188 sub formErrors { |
189 my ($this) = @_; | |
190 | |
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
|
191 if (my $node = $this->data ) { |
126 | 192 return [ |
193 grep { | |
194 ( $_->Node || $_->Parent) == $node | |
195 } @{$this->errors} | |
196 ]; | |
197 } else { | |
198 return []; | |
199 } | |
124 | 200 } |
201 | |
122 | 202 1; |
203 __END__ | |
204 | |
205 =pod | |
206 | |
207 =head1 NAME | |
208 | |
209 C<IMPL::Web::TT::Form> - Форма с элементами | |
210 | |
211 =head1 DESCRIPTION | |
212 | |
213 Является элементом управления, тоесть для своего преобразования ипользует | |
214 шаблон | |
215 | |
216 =cut |