diff Lib/Form.pm @ 0:03e58a454b20

Создан репозитарий
author Sergey
date Tue, 14 Jul 2009 12:54:37 +0400
parents
children 16ada169ca75
line wrap: on
line diff
--- /dev/null	Thu Jan 01 00:00:00 1970 +0000
+++ b/Lib/Form.pm	Tue Jul 14 12:54:37 2009 +0400
@@ -0,0 +1,147 @@
+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;
\ No newline at end of file