Mercurial > pub > Impl
annotate Lib/IMPL/Web/TT/Form.pm @ 149:b04e978d6d5a
minor changes
| author | wizard |
|---|---|
| date | Wed, 18 Aug 2010 03:14:57 +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 |
