Mercurial > pub > Impl
annotate Lib/IMPL/Web/TT/Form.pm @ 174:d920d2b70230
minor changes
| author | sergey |
|---|---|
| date | Tue, 04 Oct 2011 17:55:38 +0400 |
| parents | aaab45153411 |
| children | d1676be8afcc |
| rev | line source |
|---|---|
| 122 | 1 use strict; |
| 2 package IMPL::Web::TT::Form; | |
| 3 | |
| 166 | 4 use parent qw(IMPL::Web::TT::Control); |
| 122 | 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); | |
| 173 | 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 |
