49
|
1 package Form;
|
|
2 use strict;
|
|
3 use Common;
|
|
4 use base qw(Form::Container);
|
|
5 use Form::ItemId;
|
|
6 use Form::ValueItem;
|
|
7
|
|
8 BEGIN {
|
|
9 DeclareProperty AutoCreate => ACCESS_ALL;
|
|
10 DeclareProperty isValidated => ACCESS_READ;
|
|
11 DeclareProperty isValid => ACCESS_READ;
|
|
12 DeclareProperty ValidationErrors => ACCESS_READ;
|
|
13 DeclareProperty MapFieldClasses => ACCESS_READ;
|
|
14 DeclareProperty LoadedFiledClasses => ACCESS_NONE;
|
|
15 DeclareProperty Bindings => ACCESS_READ;
|
|
16 }
|
|
17
|
|
18 sub CTOR {
|
|
19 my ($this,$schema,$bind) = @_;
|
|
20
|
|
21 $this->SUPER::CTOR(
|
|
22 Schema => $schema->Body,
|
|
23 Id => Form::ItemId->new('Form',undef,Form::ItemId::Root->new()),
|
|
24 Form => $this
|
|
25 );
|
|
26 $this->{$MapFieldClasses} = {
|
|
27 SelectBox => 'Form::ValueItem::List',
|
|
28 RadioSelect => 'Form::ValueItem::List',
|
|
29 MultiCheckBox => 'Form::ValueItem::List'
|
|
30 };
|
|
31 $this->{$LoadedFiledClasses} = { 'Form::ValueItem' => 1 };
|
|
32 $this->{$Bindings} = $bind || {};
|
|
33 $this->{$isValid} = 0;
|
|
34 $this->{$isValidated} = 0;
|
|
35 }
|
|
36
|
|
37 sub NavigatePath {
|
|
38 my ($this,$path) = @_;
|
|
39
|
|
40 shift @$path if $path->[0]->Name eq 'Form'; # eat root node in Form/Item
|
|
41
|
|
42 return $this->SUPER::NavigatePath($path);
|
|
43 }
|
|
44
|
|
45 sub Item {
|
|
46 my ($this,$strId) = @_;
|
|
47
|
|
48 return $this->Navigate($this->MakeItemId($strId,undef));
|
|
49 }
|
|
50
|
|
51 sub MakeItemId {
|
|
52 my ($this,$Name,$BaseObject) = @_;
|
|
53
|
|
54 my $ItemId;
|
|
55 if ($BaseObject and $BaseObject->isa('Form::Item')) {
|
|
56 $ItemId = $BaseObject->Id;
|
|
57 } else {
|
|
58 $ItemId = new Form::ItemId::Root;
|
|
59 }
|
|
60
|
|
61 foreach my $item (split /\//,$Name) {
|
|
62 if ($item =~ /^(\w+?)(\d+)?$/) {
|
|
63 $ItemId = Form::ItemId->new($1,$2,$ItemId);
|
|
64 } else {
|
|
65 die new Exception('The invalid identifier',$Name);
|
|
66 }
|
|
67 }
|
|
68 return $ItemId;
|
|
69 }
|
|
70
|
|
71 sub CreateInstance {
|
|
72 my ($this,$schema,$ItemId,$parent) = @_;
|
|
73
|
|
74 my $obj;
|
|
75 if ($schema->isa('Schema::Form::Container')) {
|
|
76 $obj = new Form::Container(
|
|
77 Id => Form::ItemId->new($ItemId->Name,$ItemId->InstanceID,($parent ? $parent->Id : undef)),
|
|
78 Form => $this,
|
|
79 Parent => $parent,
|
|
80 Schema => $schema,
|
|
81 Attributes => {%{$schema->Attributes}}
|
|
82 );
|
|
83 } elsif ($schema->isa('Schema::Form::Field')) {
|
|
84 my $class = $this->{$MapFieldClasses}{$schema->Format->Name} || 'Form::ValueItem';
|
|
85 if (not $this->{$LoadedFiledClasses}{$class}) {
|
|
86 eval "require $class;" or die new Exception('Failed to load a module',$class,$@);
|
|
87 $this->{$LoadedFiledClasses}{$class} = 1;
|
|
88 }
|
|
89 $obj = $class->new(
|
|
90 Id => Form::ItemId->new($ItemId->Name,$ItemId->InstanceID,($parent ? $parent->Id : undef)),
|
|
91 Form => $this,
|
|
92 Parent => $parent,
|
|
93 Type => $schema->Format->Name,
|
|
94 Schema => $schema,
|
|
95 Attributes => {%{$schema->Attributes}}
|
|
96 );
|
|
97 } else {
|
|
98 die new Exception('Unexpected schema type', ref $schema);
|
|
99 }
|
|
100
|
|
101 return $obj;
|
|
102 }
|
|
103
|
|
104 sub Validate {
|
|
105 my ($this) = @_;
|
|
106
|
|
107 my @errors = $this->SUPER::Validate;
|
|
108 $this->{$isValidated} = 1;
|
|
109 if (@errors) {
|
|
110 $this->{$isValid} = 0;
|
|
111 $this->{$ValidationErrors} = \@errors;
|
|
112 } else {
|
|
113 $this->{$isValid} = 1;
|
|
114 delete $this->{$ValidationErrors};
|
|
115 }
|
|
116
|
|
117 return @errors;
|
|
118 }
|
|
119
|
|
120 sub SelectErrors {
|
|
121 my ($this,$parentId) = @_;
|
|
122
|
|
123 return [grep $_->Item->Parent->Id->Canonical eq $parentId, $this->ValidationErrors];
|
|
124 }
|
|
125
|
|
126 sub LoadValues {
|
|
127 my ($this,$rhValues) = @_;
|
|
128
|
|
129 $this->{$isValidated} = 0;
|
|
130 $this->{$isValid} = 0;
|
|
131
|
|
132 foreach my $key (keys %$rhValues) {
|
|
133 eval { $this->Item($key)->Value($rhValues->{$key}) };
|
|
134 undef $@;
|
|
135 }
|
|
136 }
|
|
137
|
|
138
|
|
139 sub Dispose {
|
|
140 my ($this) = @_;
|
|
141
|
|
142 delete @$this{$ValidationErrors,$MapFieldClasses,$LoadedFiledClasses,$Bindings};
|
|
143
|
|
144 $this->SUPER::Dispose;
|
|
145 }
|
|
146
|
|
147 1;
|