annotate Lib/Form/Container.pm @ 7:94d47b388442

Улучшены тесты Исправлены ошибки Улучшена документация Работа над схемой DOM
author Sergey
date Mon, 24 Aug 2009 01:05:34 +0400
parents 03e58a454b20
children 16ada169ca75
Ignore whitespace changes - Everywhere: Within whitespace: At end of lines:
rev   line source
0
03e58a454b20 Создан репозитарий
Sergey
parents:
diff changeset
1 package Form::Container;
03e58a454b20 Создан репозитарий
Sergey
parents:
diff changeset
2 use strict;
03e58a454b20 Создан репозитарий
Sergey
parents:
diff changeset
3 use Common;
03e58a454b20 Создан репозитарий
Sergey
parents:
diff changeset
4 use Form::Filter;
03e58a454b20 Создан репозитарий
Sergey
parents:
diff changeset
5 use base qw(Form::Item);
03e58a454b20 Создан репозитарий
Sergey
parents:
diff changeset
6
03e58a454b20 Создан репозитарий
Sergey
parents:
diff changeset
7 BEGIN {
03e58a454b20 Создан репозитарий
Sergey
parents:
diff changeset
8 DeclareProperty Schema => ACCESS_READ;
03e58a454b20 Создан репозитарий
Sergey
parents:
diff changeset
9 DeclareProperty Children => ACCESS_READ;
03e58a454b20 Создан репозитарий
Sergey
parents:
diff changeset
10 }
03e58a454b20 Создан репозитарий
Sergey
parents:
diff changeset
11
03e58a454b20 Создан репозитарий
Sergey
parents:
diff changeset
12 sub CTOR {
03e58a454b20 Создан репозитарий
Sergey
parents:
diff changeset
13 my ($this,%args) = @_;
03e58a454b20 Создан репозитарий
Sergey
parents:
diff changeset
14 $args{Schema} or die new Exception('A schema is required');
03e58a454b20 Создан репозитарий
Sergey
parents:
diff changeset
15
03e58a454b20 Создан репозитарий
Sergey
parents:
diff changeset
16 $this->SUPER::CTOR(@args{qw(Id Form Parent Attributes)});
03e58a454b20 Создан репозитарий
Sergey
parents:
diff changeset
17 $this->{$Schema} = $args{Schema};
03e58a454b20 Создан репозитарий
Sergey
parents:
diff changeset
18 }
03e58a454b20 Создан репозитарий
Sergey
parents:
diff changeset
19
03e58a454b20 Создан репозитарий
Sergey
parents:
diff changeset
20 sub ResolveItem {
03e58a454b20 Создан репозитарий
Sergey
parents:
diff changeset
21 my ($this,$ItemId) = @_;
03e58a454b20 Создан репозитарий
Sergey
parents:
diff changeset
22
03e58a454b20 Создан репозитарий
Sergey
parents:
diff changeset
23 if (my $schemaChild = $this->{$Schema}->FindChild($ItemId->Name)) {
03e58a454b20 Создан репозитарий
Sergey
parents:
diff changeset
24 if ($schemaChild->isMulti) {
03e58a454b20 Создан репозитарий
Sergey
parents:
diff changeset
25 defined $ItemId->InstanceID or die new Exception('Instance id is required for a muti element');
03e58a454b20 Создан репозитарий
Sergey
parents:
diff changeset
26 if (my $child = $this->{$Children}{$ItemId->Name}[$ItemId->InstanceID]){
03e58a454b20 Создан репозитарий
Sergey
parents:
diff changeset
27 return $child;
03e58a454b20 Создан репозитарий
Sergey
parents:
diff changeset
28 } else {
03e58a454b20 Создан репозитарий
Sergey
parents:
diff changeset
29 return undef if not $this->Form->AutoCreate;
03e58a454b20 Создан репозитарий
Sergey
parents:
diff changeset
30 return $this->{$Children}{$ItemId->Name}[$ItemId->InstanceID] = $this->Form->CreateInstance($schemaChild,$ItemId,$this);
03e58a454b20 Создан репозитарий
Sergey
parents:
diff changeset
31 }
03e58a454b20 Создан репозитарий
Sergey
parents:
diff changeset
32
03e58a454b20 Создан репозитарий
Sergey
parents:
diff changeset
33 } else {
03e58a454b20 Создан репозитарий
Sergey
parents:
diff changeset
34 defined $ItemId->InstanceID and die new Exception('The child is a single element',$this->Id->Canonical,$ItemId->Name);
03e58a454b20 Создан репозитарий
Sergey
parents:
diff changeset
35 if(my $child = $this->{$Children}{$ItemId->Name}) {
03e58a454b20 Создан репозитарий
Sergey
parents:
diff changeset
36 return $child;
03e58a454b20 Создан репозитарий
Sergey
parents:
diff changeset
37 } else {
03e58a454b20 Создан репозитарий
Sergey
parents:
diff changeset
38 return undef if not $this->Form->AutoCreate;
03e58a454b20 Создан репозитарий
Sergey
parents:
diff changeset
39 return $this->{$Children}{$ItemId->Name} = $this->Form->CreateInstance($schemaChild,$ItemId,$this);
03e58a454b20 Создан репозитарий
Sergey
parents:
diff changeset
40 }
03e58a454b20 Создан репозитарий
Sergey
parents:
diff changeset
41 }
03e58a454b20 Создан репозитарий
Sergey
parents:
diff changeset
42 } else {
03e58a454b20 Создан репозитарий
Sergey
parents:
diff changeset
43 die new Exception('The requested item isn\'t exists in the schema', $this->Id->Canonical,$ItemId->Name);
03e58a454b20 Создан репозитарий
Sergey
parents:
diff changeset
44 }
03e58a454b20 Создан репозитарий
Sergey
parents:
diff changeset
45 }
03e58a454b20 Создан репозитарий
Sergey
parents:
diff changeset
46
03e58a454b20 Создан репозитарий
Sergey
parents:
diff changeset
47 sub isEmpty {
03e58a454b20 Создан репозитарий
Sergey
parents:
diff changeset
48 my ($this) = @_;
03e58a454b20 Создан репозитарий
Sergey
parents:
diff changeset
49
03e58a454b20 Создан репозитарий
Sergey
parents:
diff changeset
50 foreach my $child (values %{$this->{$Children} || {} }) {
03e58a454b20 Создан репозитарий
Sergey
parents:
diff changeset
51 if (ref $child eq 'ARRAY') {
03e58a454b20 Создан репозитарий
Sergey
parents:
diff changeset
52 foreach my $inst (@$child) {
03e58a454b20 Создан репозитарий
Sergey
parents:
diff changeset
53 return 0 if not $child->isEmpty;
03e58a454b20 Создан репозитарий
Sergey
parents:
diff changeset
54 }
03e58a454b20 Создан репозитарий
Sergey
parents:
diff changeset
55 } else {
03e58a454b20 Создан репозитарий
Sergey
parents:
diff changeset
56 return 0 if not $child->isEmpty;
03e58a454b20 Создан репозитарий
Sergey
parents:
diff changeset
57 }
03e58a454b20 Создан репозитарий
Sergey
parents:
diff changeset
58 }
03e58a454b20 Создан репозитарий
Sergey
parents:
diff changeset
59
03e58a454b20 Создан репозитарий
Sergey
parents:
diff changeset
60 return 1;
03e58a454b20 Создан репозитарий
Sergey
parents:
diff changeset
61 }
03e58a454b20 Создан репозитарий
Sergey
parents:
diff changeset
62
03e58a454b20 Создан репозитарий
Sergey
parents:
diff changeset
63 =pod
03e58a454b20 Создан репозитарий
Sergey
parents:
diff changeset
64 , .
03e58a454b20 Создан репозитарий
Sergey
parents:
diff changeset
65 , .
03e58a454b20 Создан репозитарий
Sergey
parents:
diff changeset
66 =cut
03e58a454b20 Создан репозитарий
Sergey
parents:
diff changeset
67 sub GetChild {
03e58a454b20 Создан репозитарий
Sergey
parents:
diff changeset
68 my ($this,$name) = @_;
03e58a454b20 Создан репозитарий
Sergey
parents:
diff changeset
69 return unless exists $this->{$Children}{$name};
03e58a454b20 Создан репозитарий
Sergey
parents:
diff changeset
70 return( grep $_, map { UNIVERSAL::isa($_,'ARRAY') ? @{$_} : $_ } $this->{$Children}{$name} );
03e58a454b20 Создан репозитарий
Sergey
parents:
diff changeset
71 }
03e58a454b20 Создан репозитарий
Sergey
parents:
diff changeset
72
03e58a454b20 Создан репозитарий
Sergey
parents:
diff changeset
73 =pod
03e58a454b20 Создан репозитарий
Sergey
parents:
diff changeset
74 .
03e58a454b20 Создан репозитарий
Sergey
parents:
diff changeset
75
03e58a454b20 Создан репозитарий
Sergey
parents:
diff changeset
76
03e58a454b20 Создан репозитарий
Sergey
parents:
diff changeset
77 * ,
03e58a454b20 Создан репозитарий
Sergey
parents:
diff changeset
78 * ,
03e58a454b20 Создан репозитарий
Sergey
parents:
diff changeset
79 * ,
03e58a454b20 Создан репозитарий
Sergey
parents:
diff changeset
80 * ,
03e58a454b20 Создан репозитарий
Sergey
parents:
diff changeset
81 *
03e58a454b20 Создан репозитарий
Sergey
parents:
diff changeset
82 =cut
03e58a454b20 Создан репозитарий
Sergey
parents:
diff changeset
83 sub Validate {
03e58a454b20 Создан репозитарий
Sergey
parents:
diff changeset
84 my ($this,$rhDisableFilters) = @_;
03e58a454b20 Создан репозитарий
Sergey
parents:
diff changeset
85
03e58a454b20 Создан репозитарий
Sergey
parents:
diff changeset
86 $rhDisableFilters ||= {};
03e58a454b20 Создан репозитарий
Sergey
parents:
diff changeset
87
03e58a454b20 Создан репозитарий
Sergey
parents:
diff changeset
88 my @errors;
03e58a454b20 Создан репозитарий
Sergey
parents:
diff changeset
89
03e58a454b20 Создан репозитарий
Sergey
parents:
diff changeset
90 foreach my $filter (grep {$_->SUPPORTED_CONTEXT & (Form::Filter::CTX_SINGLE) and not exists $rhDisableFilters->{$_}} map {$_->Instance} $this->{$Schema}->Filters) {
03e58a454b20 Создан репозитарий
Sergey
parents:
diff changeset
91 my $result = $filter->Invoke($this,Form::Filter::CTX_SINGLE | Form::Filter::CTX_EXISTENT,$this->{$Schema});
03e58a454b20 Создан репозитарий
Sergey
parents:
diff changeset
92 if ($result->State == Form::FilterResult::STATE_SUCCESS_STOP) {
03e58a454b20 Создан репозитарий
Sergey
parents:
diff changeset
93 return ();
03e58a454b20 Создан репозитарий
Sergey
parents:
diff changeset
94 } elsif ($result->State == Form::FilterResult::STATE_ERROR) {
03e58a454b20 Создан репозитарий
Sergey
parents:
diff changeset
95 push @errors,$result;
03e58a454b20 Создан репозитарий
Sergey
parents:
diff changeset
96 }
03e58a454b20 Создан репозитарий
Sergey
parents:
diff changeset
97 }
03e58a454b20 Создан репозитарий
Sergey
parents:
diff changeset
98
03e58a454b20 Создан репозитарий
Sergey
parents:
diff changeset
99 CHILD_LOOP: foreach my $schemaChild ($this->{$Schema}->Children) {
03e58a454b20 Создан репозитарий
Sergey
parents:
diff changeset
100
03e58a454b20 Создан репозитарий
Sergey
parents:
diff changeset
101 if ($schemaChild->isMulti) {
03e58a454b20 Создан репозитарий
Sergey
parents:
diff changeset
102 my %DisableFilters;
03e58a454b20 Создан репозитарий
Sergey
parents:
diff changeset
103 foreach my $filter (grep {$_->SUPPORTED_CONTEXT & Form::Filter::CTX_SET} map {$_->Instance} $schemaChild->Filters) {
03e58a454b20 Создан репозитарий
Sergey
parents:
diff changeset
104
03e58a454b20 Создан репозитарий
Sergey
parents:
diff changeset
105 my $result = $filter->Invoke($this->{$Children}{$schemaChild->Name},Form::Filter::CTX_SET,$schemaChild,$this);
03e58a454b20 Создан репозитарий
Sergey
parents:
diff changeset
106 if ($result->State == Form::FilterResult::STATE_ERROR) {
03e58a454b20 Создан репозитарий
Sergey
parents:
diff changeset
107 push @errors,$result;
03e58a454b20 Создан репозитарий
Sergey
parents:
diff changeset
108 #
03e58a454b20 Создан репозитарий
Sergey
parents:
diff changeset
109 next CHILD_LOOP;
03e58a454b20 Создан репозитарий
Sergey
parents:
diff changeset
110 } elsif ($result->State == Form::FilterResult::STATE_SUCCESS_STOP) {
03e58a454b20 Создан репозитарий
Sergey
parents:
diff changeset
111 #
03e58a454b20 Создан репозитарий
Sergey
parents:
diff changeset
112 next CHILD_LOOP;
03e58a454b20 Создан репозитарий
Sergey
parents:
diff changeset
113 } elsif ($result->State == Form::FilterResult::STATE_SUCCESS_STAY) {
03e58a454b20 Создан репозитарий
Sergey
parents:
diff changeset
114 #
03e58a454b20 Создан репозитарий
Sergey
parents:
diff changeset
115 $DisableFilters{$filter} = 1;
03e58a454b20 Создан репозитарий
Sergey
parents:
diff changeset
116 } else {
03e58a454b20 Создан репозитарий
Sergey
parents:
diff changeset
117 # STATE_SUCCESS -
03e58a454b20 Создан репозитарий
Sergey
parents:
diff changeset
118 }
03e58a454b20 Создан репозитарий
Sergey
parents:
diff changeset
119 }
03e58a454b20 Создан репозитарий
Sergey
parents:
diff changeset
120
03e58a454b20 Создан репозитарий
Sergey
parents:
diff changeset
121 $_ and push @errors,$_->Validate(\%DisableFilters) foreach grep !$_->isEmpty, $this->GetChild($schemaChild->Name);
03e58a454b20 Создан репозитарий
Sergey
parents:
diff changeset
122
03e58a454b20 Создан репозитарий
Sergey
parents:
diff changeset
123 } else {
03e58a454b20 Создан репозитарий
Sergey
parents:
diff changeset
124 my %DisableFilters;
03e58a454b20 Создан репозитарий
Sergey
parents:
diff changeset
125
03e58a454b20 Создан репозитарий
Sergey
parents:
diff changeset
126 # ,
03e58a454b20 Создан репозитарий
Sergey
parents:
diff changeset
127 foreach my $filter (grep { $_->SUPPORTED_CONTEXT & Form::Filter::CTX_SINGLE and not $_->SUPPORTED_CONTEXT & Form::Filter::CTX_EXISTENT} map {$_->Instance} $schemaChild->Filters) {
03e58a454b20 Создан репозитарий
Sergey
parents:
diff changeset
128 my $result = $filter->Invoke($this->{$Children}{$schemaChild->Name},Form::Filter::CTX_SINGLE,$schemaChild,$this);
03e58a454b20 Создан репозитарий
Sergey
parents:
diff changeset
129
03e58a454b20 Создан репозитарий
Sergey
parents:
diff changeset
130 if ($result->State == Form::FilterResult::STATE_ERROR) {
03e58a454b20 Создан репозитарий
Sergey
parents:
diff changeset
131 push @errors,$result;
03e58a454b20 Создан репозитарий
Sergey
parents:
diff changeset
132 #
03e58a454b20 Создан репозитарий
Sergey
parents:
diff changeset
133 next CHILD_LOOP;
03e58a454b20 Создан репозитарий
Sergey
parents:
diff changeset
134 } elsif ($result->State == Form::FilterResult::STATE_SUCCESS_STOP) {
03e58a454b20 Создан репозитарий
Sergey
parents:
diff changeset
135 #
03e58a454b20 Создан репозитарий
Sergey
parents:
diff changeset
136 next CHILD_LOOP;
03e58a454b20 Создан репозитарий
Sergey
parents:
diff changeset
137 } else {
03e58a454b20 Создан репозитарий
Sergey
parents:
diff changeset
138 # STATE_SUCCESS(_STAY) -
03e58a454b20 Создан репозитарий
Sergey
parents:
diff changeset
139 $DisableFilters{$filter} = 1;
03e58a454b20 Создан репозитарий
Sergey
parents:
diff changeset
140 }
03e58a454b20 Создан репозитарий
Sergey
parents:
diff changeset
141 }
03e58a454b20 Создан репозитарий
Sergey
parents:
diff changeset
142
03e58a454b20 Создан репозитарий
Sergey
parents:
diff changeset
143 # ,
03e58a454b20 Создан репозитарий
Sergey
parents:
diff changeset
144 push @errors,$this->{$Children}{$schemaChild->Name}->Validate(\%DisableFilters) if $this->{$Children}{$schemaChild->Name};
03e58a454b20 Создан репозитарий
Sergey
parents:
diff changeset
145 }
03e58a454b20 Создан репозитарий
Sergey
parents:
diff changeset
146
03e58a454b20 Создан репозитарий
Sergey
parents:
diff changeset
147 }
03e58a454b20 Создан репозитарий
Sergey
parents:
diff changeset
148
03e58a454b20 Создан репозитарий
Sergey
parents:
diff changeset
149 return @errors;
03e58a454b20 Создан репозитарий
Sergey
parents:
diff changeset
150 }
03e58a454b20 Создан репозитарий
Sergey
parents:
diff changeset
151
03e58a454b20 Создан репозитарий
Sergey
parents:
diff changeset
152 sub Dispose {
03e58a454b20 Создан репозитарий
Sergey
parents:
diff changeset
153 my ($this) = @_;
03e58a454b20 Создан репозитарий
Sergey
parents:
diff changeset
154
03e58a454b20 Создан репозитарий
Sergey
parents:
diff changeset
155 foreach my $child (values %{ $this->{$Children} || {} }) {
03e58a454b20 Создан репозитарий
Sergey
parents:
diff changeset
156 if (ref $child eq 'ARRAY') {
03e58a454b20 Создан репозитарий
Sergey
parents:
diff changeset
157 foreach my $inst (@$child) {
03e58a454b20 Создан репозитарий
Sergey
parents:
diff changeset
158 $inst->Dispose;
03e58a454b20 Создан репозитарий
Sergey
parents:
diff changeset
159 }
03e58a454b20 Создан репозитарий
Sergey
parents:
diff changeset
160 } else {
03e58a454b20 Создан репозитарий
Sergey
parents:
diff changeset
161 die new IMPL::Exception("Child is null",%{ $this->{$Children} }) if not $child;
03e58a454b20 Создан репозитарий
Sergey
parents:
diff changeset
162 $child->Dispose;
03e58a454b20 Создан репозитарий
Sergey
parents:
diff changeset
163 }
03e58a454b20 Создан репозитарий
Sergey
parents:
diff changeset
164 }
03e58a454b20 Создан репозитарий
Sergey
parents:
diff changeset
165
03e58a454b20 Создан репозитарий
Sergey
parents:
diff changeset
166 delete @$this{$Schema,$Children};
03e58a454b20 Создан репозитарий
Sergey
parents:
diff changeset
167
03e58a454b20 Создан репозитарий
Sergey
parents:
diff changeset
168 $this->SUPER::Dispose;
03e58a454b20 Создан репозитарий
Sergey
parents:
diff changeset
169 }
03e58a454b20 Создан репозитарий
Sergey
parents:
diff changeset
170 1;