view Lib/Form.pm @ 25:9dd67fa91ee3

small fix in the dom schema works under text schema
author Sergey
date Tue, 13 Oct 2009 17:51:25 +0400
parents 03e58a454b20
children 16ada169ca75
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;