Mercurial > pub > Impl
annotate Lib/IMPL/Web/TT/Form.pm @ 138:c5bc900eefd3
IMPL::Web::Application: Fixed file uploading
Minor improvements in the IMPL::Web::TT::Form
author | wizard |
---|---|
date | Thu, 01 Jul 2010 04:25:07 +0400 |
parents | 0dce0470a3d8 |
children | b56ebc31bf18 |
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; |
7 use IMPL::DOM::Navigator::SchemaNavigator; | |
126 | 8 __PACKAGE__->PassThroughArgs; |
124 | 9 |
10 BEGIN { | |
11 public property base => prop_all; | |
12 public property schema => prop_all; | |
13 public property errors => prop_all; | |
14 public property data => prop_all; | |
138 | 15 public property state => prop_all; |
16 public property formResult => prop_all; | |
124 | 17 } |
18 | |
19 sub CTOR { | |
20 my ($this) = @_; | |
21 | |
138 | 22 if (my $form = $this->formResult) { |
23 $this->base($form->{formName}); | |
24 $this->errors($form->{formErrors}); | |
25 $this->data($form->{formData}); | |
26 $this->schema($form->{formSchema}); | |
27 $this->state($form->{state}); | |
28 } else { | |
124 | 29 |
138 | 30 $this->base($this->nodeName) unless $this->base; |
31 | |
32 die new IMPL::InvalidArgumentException('A schema is required for a form',$this->nodeName) | |
33 unless eval { $this->schema->isa( typeof IMPL::DOM::Schema ) }; | |
126 | 34 |
138 | 35 die new IMPL::InvalidOperationException('Can\'t find a form definition in a schema',$this->nodeName,$this->base) |
36 unless $this->schema->selectNodes(sub { $_->nodeName eq 'ComplexNode' and $_->name eq $this->base }); | |
37 } | |
38 | |
126 | 39 $this->errors([]) unless $this->errors; |
124 | 40 } |
41 | |
126 | 42 sub makeControlArgs{ |
43 my ($this,$path) = @_; | |
124 | 44 |
45 my $navi = new IMPL::DOM::Navigator::SchemaNavigator($this->schema); | |
126 | 46 my @path = ($this->base, split /\./,$path); |
124 | 47 |
126 | 48 $navi->NavigateName($_) or die new IMPL::InvalidArgumentException( |
124 | 49 "Can't find a definition for an element", |
50 $_, | |
51 $path, | |
126 | 52 $this->element, |
53 ) foreach @path; | |
124 | 54 |
55 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
|
56 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
|
57 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
|
58 shift @path; |
138 | 59 my $node = $this->data ? $this->data->selectSingleNode(@path) : undef; |
126 | 60 |
61 my @errors; | |
62 | |
63 if ($node) { | |
64 @errors = grep { ( $_->Node || $_->Parent) == $node } @{$this->errors}; | |
65 } | |
66 | |
67 return { | |
68 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
|
69 sourceSchema => $sourceSchema, |
126 | 70 errors => \@errors, |
71 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
|
72 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
|
73 queryParameter => $queryParameter |
126 | 74 }; |
75 } | |
76 | |
77 sub formErrors { | |
78 my ($this) = @_; | |
79 | |
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
|
80 if (my $node = $this->data ) { |
126 | 81 return [ |
82 grep { | |
83 ( $_->Node || $_->Parent) == $node | |
84 } @{$this->errors} | |
85 ]; | |
86 } else { | |
87 return []; | |
88 } | |
124 | 89 } |
90 | |
122 | 91 |
92 1; | |
93 | |
94 __END__ | |
95 | |
96 =pod | |
97 | |
98 =head1 NAME | |
99 | |
100 C<IMPL::Web::TT::Form> - Форма с элементами | |
101 | |
102 =head1 DESCRIPTION | |
103 | |
104 Является элементом управления, тоесть для своего преобразования ипользует | |
105 шаблон | |
106 | |
107 =cut |