| 0 | 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; |