Mercurial > pub > Impl
annotate Lib/IMPL/Web/TT/Form.pm @ 201:0c018a247c8a
Reworked REST resource classes to be more transparent and intuitive
| author | sergey |
|---|---|
| date | Tue, 24 Apr 2012 19:52:07 +0400 |
| parents | 4d0e1962161c |
| children |
| 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 { | |
| 194 | 12 public property base => prop_all; |
| 13 public property schema => prop_all; | |
| 14 public property errors => prop_all; | |
| 15 public property data => prop_all; | |
| 16 public property state => prop_all; | |
| 17 public property formResult => prop_all; | |
| 124 | 18 } |
| 19 | |
| 20 sub CTOR { | |
| 194 | 21 my ($this) = @_; |
| 22 | |
| 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 { | |
| 30 | |
| 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 ) }; | |
| 35 | |
| 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 | |
| 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 { |
| 194 | 44 my ($this) = @_; |
| 45 | |
| 46 my $schema = $this->schema->selectSingleNode(sub { $_->nodeName eq 'ComplexNode' and $_->name eq $this->base }); | |
| 47 | |
| 48 $this->buildContainer( | |
| 49 $schema, | |
| 50 $schema, | |
| 51 $this->data->isComplex ? $this->data : undef, | |
| 52 $this | |
| 53 ); | |
|
148
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 { |
| 194 | 57 my ($this,$schemaSource,$schema,$domNode,$container,$path) = @_; |
| 58 | |
| 59 $path = [@{$path || []},{node => $domNode, schemaSource => $schemaSource}]; | |
| 60 | |
| 61 $container ||= $this->document->Create($schemaSource->name,'IMPL::Web::TT::Collection'); | |
| 62 | |
| 63 foreach my $schemaItem ( $schema->content->childNodes ) { | |
| 64 my $schemaItemSource = $schemaItem; | |
| 65 | |
| 66 $schemaItem = $this->schema->resolveType($schemaItem->type) | |
| 67 if typeof $schemaItem eq typeof IMPL::DOM::Schema::Node; | |
| 68 | |
| 69 my @nodesData = $domNode->selectNodes(sub { $_->schemaSource == $schemaItemSource } ) if $domNode; | |
| 70 | |
| 71 push @nodesData, undef unless @nodesData; | |
| 72 | |
| 73 if ($schemaItem->isa(typeof IMPL::DOM::Schema::ComplexNode) ) { | |
| 74 $this->appendChild( $this->buildContainer($schemaItemSource,$schemaItem,$_,undef,$path) ) foreach @nodesData; | |
| 75 } elsif ($schemaItem->isa(typeof IMPL::DOM::Schema::SimpleNode)) { | |
| 76 $this->appendChild( $this->buildControl($schemaItemSource,$schemaItem,$_,$path) ) foreach @nodesData; | |
| 77 } | |
| 78 } | |
| 79 | |
| 80 return $container; | |
|
148
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 { |
| 194 | 84 my ($this,$schemaSource,$schema,$node,$path) = @_; |
| 85 | |
| 86 my @errors; | |
| 87 | |
| 88 if ($node) { | |
| 89 @errors = grep { ($_->Node || $_->Parent) == $node } @{$this->errors}; | |
| 90 } else { | |
| 91 @errors = grep $_->Schema == $schemaSource, @{$this->errors}; | |
| 92 } | |
| 93 | |
| 94 return $this->document->CreateControl( | |
| 95 $schemaSource->name, | |
| 96 $this->mapType($schemaSource), | |
| 97 { | |
| 98 schema => $schema, | |
| 99 sourceSchema => $schemaSource, | |
| 100 errors => \@errors, | |
| 101 data => $node, | |
| 102 inputType => $schemaSource->nodeProperty('inputType') || $schema->nodeProperty('inputType'), | |
| 103 nodeValue => $node && $node->nodeValue, # small hack set a non dom class property through | |
| 104 queryParameter => $this->makeParameterName([@$path,{ node => $node, schemaSource => $schemaSource}]) | |
| 105 } | |
| 106 ); | |
|
148
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 { |
| 194 | 110 my ($this,$schema) = @_; |
| 111 | |
| 112 $schema->nodeProperty('control') || | |
| 113 ( $schema->type && $this->schema->resolveType($schema->type)->nodeProperty('control') ) | |
| 114 or die new IMPL::Exception("Unable to get control class for the form element",$schema->path); | |
|
148
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 { |
| 194 | 118 my ($this,$path) = @_; |
| 119 | |
| 120 join '/', map { | |
| 121 $_->{node} ? | |
| 122 ( | |
| 123 $_->{node}->nodeProperty('instanceId') ? | |
| 124 $_->{node}->nodeName . '['. ']' : | |
| 125 $_->{node}->nodeName | |
| 126 ) : | |
| 127 ( | |
| 128 $_->{schemaSource}->maxOccur eq 'unbounded' || $_->{schemaSource}->maxOccur > 1 ? | |
| 129 $_->{schemaSource}->name . '[0]' : | |
| 130 $_->{schemaSource}->name | |
| 131 ) | |
| 132 } @$path; | |
|
148
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{ |
| 194 | 136 my ($this,$path) = @_; |
| 137 | |
| 138 my $navi = new IMPL::DOM::Navigator::SchemaNavigator($this->schema); | |
| 139 my @path = ($this->base, split(/\./,$path) ); | |
| 140 | |
| 141 $navi->NavigateName($_) or die new IMPL::InvalidArgumentException( | |
| 142 "Can't find a definition for an element", | |
| 143 $_, | |
| 144 $path, | |
| 145 $this->element, | |
| 146 ) foreach @path; | |
| 147 | |
| 148 my $schema = $navi->Current; | |
| 149 my $sourceSchema = $navi->SourceSchemaNode; | |
| 150 my $queryParameter = join '/', @path; | |
| 151 shift @path; | |
| 152 my $node = $this->data ? $this->data->selectSingleNode(@path) : undef; | |
| 153 | |
| 154 my @errors; | |
| 155 | |
| 156 if ($node) { | |
| 157 @errors = grep { ($_->Node || $_->Parent) == $node } @{$this->errors}; | |
| 158 } else { | |
| 159 @errors = grep $_->Schema == $sourceSchema, @{$this->errors}; | |
| 160 } | |
| 161 | |
| 162 return { | |
| 163 schema => $schema, | |
| 164 sourceSchema => $sourceSchema, | |
| 165 errors => \@errors, | |
| 166 data => $node, | |
| 167 nodeValue => $node && $node->nodeValue, # small hack set a non dom class property through | |
| 168 queryParameter => $queryParameter, | |
| 169 inputType => $sourceSchema->nodeProperty('inputType') || $schema->nodeProperty('inputType') | |
| 170 }; | |
| 126 | 171 } |
| 172 | |
| 145 | 173 sub makeContent { |
| 194 | 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); | |
| 145 | 178 |
| 194 | 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; | |
| 145 | 188 } |
| 189 | |
| 126 | 190 sub formErrors { |
| 194 | 191 my ($this) = @_; |
| 192 | |
| 193 if (my $node = $this->data ) { | |
| 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 | |
| 180 | 211 C<IMPL::Web::TT::Form> - Форма с элементами |
| 122 | 212 |
| 213 =head1 DESCRIPTION | |
| 214 | |
| 180 | 215 Является элементом управления, тоесть для своего преобразования ипользует |
| 216 шаблон | |
| 122 | 217 |
| 180 | 218 =cut |