Mercurial > pub > Impl
view Lib/Form.pm @ 126:c8dfbbdd8005
Several bug fixes
Forms support pre-alfa version
author | wizard |
---|---|
date | Fri, 11 Jun 2010 04:29:51 +0400 |
parents | 16ada169ca75 |
children |
line wrap: on
line source
package Form; use strict; use Common; use base qw(Form::Container); use Form::ItemId; use Form::ValueItem; BEGIN { DeclareProperty AutoCreate => ACCESS_ALL; DeclareProperty isValidated => ACCESS_READ; DeclareProperty isValid => ACCESS_READ; DeclareProperty ValidationErrors => ACCESS_READ; DeclareProperty MapFieldClasses => ACCESS_READ; DeclareProperty LoadedFiledClasses => ACCESS_NONE; DeclareProperty Bindings => ACCESS_READ; } sub CTOR { my ($this,$schema,$bind) = @_; $this->SUPER::CTOR( Schema => $schema->Body, Id => Form::ItemId->new('Form',undef,Form::ItemId::Root->new()), Form => $this ); $this->{$MapFieldClasses} = { SelectBox => 'Form::ValueItem::List', RadioSelect => 'Form::ValueItem::List', MultiCheckBox => 'Form::ValueItem::List' }; $this->{$LoadedFiledClasses} = { 'Form::ValueItem' => 1 }; $this->{$Bindings} = $bind || {}; $this->{$isValid} = 0; $this->{$isValidated} = 0; } sub NavigatePath { my ($this,$path) = @_; shift @$path if $path->[0]->Name eq 'Form'; # eat root node in Form/Item return $this->SUPER::NavigatePath($path); } sub Item { my ($this,$strId) = @_; return $this->Navigate($this->MakeItemId($strId,undef)); } sub MakeItemId { my ($this,$Name,$BaseObject) = @_; my $ItemId; if ($BaseObject and $BaseObject->isa('Form::Item')) { $ItemId = $BaseObject->Id; } else { $ItemId = new Form::ItemId::Root; } foreach my $item (split /\//,$Name) { if ($item =~ /^(\w+?)(\d+)?$/) { $ItemId = Form::ItemId->new($1,$2,$ItemId); } else { die new Exception('The invalid identifier',$Name); } } return $ItemId; } sub CreateInstance { my ($this,$schema,$ItemId,$parent) = @_; my $obj; if ($schema->isa('Schema::Form::Container')) { $obj = new Form::Container( Id => Form::ItemId->new($ItemId->Name,$ItemId->InstanceID,($parent ? $parent->Id : undef)), Form => $this, Parent => $parent, Schema => $schema, Attributes => {%{$schema->Attributes}} ); } elsif ($schema->isa('Schema::Form::Field')) { my $class = $this->{$MapFieldClasses}{$schema->Format->Name} || 'Form::ValueItem'; if (not $this->{$LoadedFiledClasses}{$class}) { eval "require $class;" or die new Exception('Failed to load a module',$class,$@); $this->{$LoadedFiledClasses}{$class} = 1; } $obj = $class->new( Id => Form::ItemId->new($ItemId->Name,$ItemId->InstanceID,($parent ? $parent->Id : undef)), Form => $this, Parent => $parent, Type => $schema->Format->Name, Schema => $schema, Attributes => {%{$schema->Attributes}} ); } else { die new Exception('Unexpected schema type', ref $schema); } return $obj; } sub Validate { my ($this) = @_; my @errors = $this->SUPER::Validate; $this->{$isValidated} = 1; if (@errors) { $this->{$isValid} = 0; $this->{$ValidationErrors} = \@errors; } else { $this->{$isValid} = 1; delete $this->{$ValidationErrors}; } return @errors; } sub SelectErrors { my ($this,$parentId) = @_; return [grep $_->Item->Parent->Id->Canonical eq $parentId, $this->ValidationErrors]; } sub LoadValues { my ($this,$rhValues) = @_; $this->{$isValidated} = 0; $this->{$isValid} = 0; foreach my $key (keys %$rhValues) { eval { $this->Item($key)->Value($rhValues->{$key}) }; undef $@; } } sub Dispose { my ($this) = @_; delete @$this{$ValidationErrors,$MapFieldClasses,$LoadedFiledClasses,$Bindings}; $this->SUPER::Dispose; } 1;