view Lib/Form/Container.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::Container;
use strict;
use Common;
use Form::Filter;
use base qw(Form::Item);

BEGIN {
    DeclareProperty Schema => ACCESS_READ;
    DeclareProperty Children => ACCESS_READ;
}

sub CTOR {
    my ($this,%args) = @_;
    $args{Schema} or die new Exception('A schema is required');
    
    $this->SUPER::CTOR(@args{qw(Id Form Parent Attributes)});
    $this->{$Schema} = $args{Schema};
}

sub ResolveItem {
    my ($this,$ItemId) = @_;
    
    if (my $schemaChild = $this->{$Schema}->FindChild($ItemId->Name)) {
        if ($schemaChild->isMulti) {
            defined $ItemId->InstanceID or die new Exception('Instance id is required for a muti element');
            if (my $child = $this->{$Children}{$ItemId->Name}[$ItemId->InstanceID]){
                return $child;
            } else {
                return undef if not $this->Form->AutoCreate;
                return $this->{$Children}{$ItemId->Name}[$ItemId->InstanceID] = $this->Form->CreateInstance($schemaChild,$ItemId,$this);
            }
            
        } else {
            defined $ItemId->InstanceID and die new Exception('The child is a single element',$this->Id->Canonical,$ItemId->Name);
            if(my $child = $this->{$Children}{$ItemId->Name}) {
                return $child;
            } else {
                return undef if not $this->Form->AutoCreate;
                return $this->{$Children}{$ItemId->Name} = $this->Form->CreateInstance($schemaChild,$ItemId,$this);
            }
        }
    } else {
        die new Exception('The requested item isn\'t exists in the schema', $this->Id->Canonical,$ItemId->Name);
    }
}

sub isEmpty {
    my ($this) = @_;

    foreach my $child (values %{$this->{$Children} || {} }) {
        if (ref $child eq 'ARRAY') {
            foreach my $inst (@$child) {
                return 0 if not $child->isEmpty;
            }
        } else {
            return 0 if not $child->isEmpty;
        }
    }

    return 1;
}

=pod
Получает дочерние контенеры в виде списка, при том только не пустые контейнеры.
Если дочернний контейнер не множественный, то список будет состоять из одного элемента.
=cut
sub GetChild {
    my ($this,$name) = @_;
    return unless exists $this->{$Children}{$name};
    return( grep $_, map { UNIVERSAL::isa($_,'ARRAY') ? @{$_} : $_ } $this->{$Children}{$name} );
}

=pod
Выполняет фильтры по схеме для себя и всех детей.
Фильтры определяются по схеме и вызываются в различнх контекстах

* сначала для группы,
* потом для детишек, причем если
    * детишки множественные, то
        * снсчала для набора детишек, а потом
        * для каждого в отдельности
=cut
sub Validate {
    my ($this,$rhDisableFilters) = @_;
    
    $rhDisableFilters ||= {};

    my @errors;

    foreach my $filter (grep {$_->SUPPORTED_CONTEXT & (Form::Filter::CTX_SINGLE) and not exists $rhDisableFilters->{$_}} map {$_->Instance} $this->{$Schema}->Filters) {
        my $result = $filter->Invoke($this,Form::Filter::CTX_SINGLE | Form::Filter::CTX_EXISTENT,$this->{$Schema});
        if ($result->State == Form::FilterResult::STATE_SUCCESS_STOP) {
            return ();
        } elsif ($result->State == Form::FilterResult::STATE_ERROR) {
            push @errors,$result;
        }
    }

    CHILD_LOOP: foreach my $schemaChild ($this->{$Schema}->Children) {
        
        if ($schemaChild->isMulti) {
            my %DisableFilters;
            foreach my $filter (grep {$_->SUPPORTED_CONTEXT & Form::Filter::CTX_SET} map {$_->Instance} $schemaChild->Filters) {
                
                my $result = $filter->Invoke($this->{$Children}{$schemaChild->Name},Form::Filter::CTX_SET,$schemaChild,$this);
                if ($result->State == Form::FilterResult::STATE_ERROR) {
                    push @errors,$result;
                    # не проверять другие фильтры вообще
                    next CHILD_LOOP;
                } elsif ($result->State == Form::FilterResult::STATE_SUCCESS_STOP) {
                    # не проверять другие фильтры вообще
                    next CHILD_LOOP;
                } elsif ($result->State == Form::FilterResult::STATE_SUCCESS_STAY) {
                    # не проверять данный фильтр на каждом экземпляре
                    $DisableFilters{$filter} = 1;
                } else {
                    # STATE_SUCCESS - все ок
                }
            }
            
            $_ and push @errors,$_->Validate(\%DisableFilters) foreach grep !$_->isEmpty, $this->GetChild($schemaChild->Name);
            
        } else {
            my %DisableFilters;
            
            # проверяем фильтры, которые могут применяться на несуществующем значении
            foreach my $filter (grep { $_->SUPPORTED_CONTEXT & Form::Filter::CTX_SINGLE and not $_->SUPPORTED_CONTEXT & Form::Filter::CTX_EXISTENT} map {$_->Instance} $schemaChild->Filters) {
                my $result = $filter->Invoke($this->{$Children}{$schemaChild->Name},Form::Filter::CTX_SINGLE,$schemaChild,$this);
                
                if ($result->State == Form::FilterResult::STATE_ERROR) {
                    push @errors,$result;
                    # не проверять другие фильтры вообще
                    next CHILD_LOOP;
                } elsif ($result->State == Form::FilterResult::STATE_SUCCESS_STOP) {
                    # не проверять другие фильтры вообще
                    next CHILD_LOOP;
                } else {
                    # STATE_SUCCESS(_STAY) - все ок
                    $DisableFilters{$filter} = 1;
                }
            }
            
            # если значение существует, то применяем оставшиеся фильтры
            push @errors,$this->{$Children}{$schemaChild->Name}->Validate(\%DisableFilters) if $this->{$Children}{$schemaChild->Name};
        }
        
    }
    
    return @errors;
}

sub Dispose {
    my ($this) = @_;
    
    foreach my $child (values %{ $this->{$Children} || {} }) {
        if (ref $child eq 'ARRAY') {
            foreach my $inst (@$child) {
                $inst->Dispose;
            }
        } else {
            die new IMPL::Exception("Child is null",%{ $this->{$Children} }) if not $child;
            $child->Dispose;
        }
    }
    
    delete @$this{$Schema,$Children};
    
    $this->SUPER::Dispose;
}
1;