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