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