view Lib/Form.pm @ 134:44977efed303

Significant performance optimizations Fixed recursion problems due converting objects to JSON Added cache support for the templates Added discovery feature for the web methods
author wizard
date Mon, 21 Jun 2010 02:39:53 +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;