annotate Lib/Form.pm @ 31:d59526f6310e

Small fixes to Test framework (correct handlinf of the compilation errors in the test units) Imported and refactored SQL DB schema from the old project
author Sergey
date Mon, 09 Nov 2009 01:39:16 +0300
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;