view Lib/IMPL/DOM/Navigator/Builder.pm @ 238:b8c724f6de36

DOM model refactoring TT view refactoring, controls are no longer derived from DOM nodes bugfixes
author sergey
date Tue, 16 Oct 2012 01:33:06 +0400
parents 2904da230022
children 2746a8e5a6c4
line wrap: on
line source

package IMPL::DOM::Navigator::Builder;
use strict;
use warnings;

use IMPL::Const qw(:prop);

use parent qw(IMPL::DOM::Navigator);
use IMPL::Class::Property;
use IMPL::Class::Property::Direct;
require IMPL::DOM::Navigator::SchemaNavigator;
require IMPL::DOM::Schema::ValidationError;
use IMPL::DOM::Document;

BEGIN {
    private _direct property _schemaNavi => PROP_RW;
    private _direct property _docClass => PROP_RW;
    public _direct property BuildErrors => PROP_RO | PROP_LIST;
    public _direct property Document => PROP_RO;
    public _direct property ignoreUndefined => PROP_RO;
}

our %CTOR = (
    'IMPL::DOM::Navigator' => sub { IMPL::DOM::Document->Empty; }
);

sub CTOR {
    my ($this,$docClass,$schema,%opts) = @_;
    
    $this->{$_docClass} = $docClass;
    $this->{$_schemaNavi} = $schema ? IMPL::DOM::Navigator::SchemaNavigator->new($schema) : undef;
    
    $this->{$ignoreUndefined} = $opts{ignoreUndefined} if $opts{ignoreUndefined}; 
}

sub NavigateCreate {
    my ($this,$nodeName,%props) = @_;
    
    if (my $schemaNode = $this->{$_schemaNavi}->NavigateName($nodeName)) {
        my $class = $schemaNode->can('nativeType') ? $schemaNode->nativeType || 'IMPL::DOM::Node' : 'IMPL::DOM::Node';
        
        my $schemaSource = $this->{$_schemaNavi}->SourceSchemaNode;
        
        my @errors = $this->inflateProperties($schemaNode,\%props);
        $props{schema} = $schemaNode;
        $props{schemaSource} = $schemaSource;
        
        my $node;
        if (! $this->{$Document}) {
            $node = $this->{$Document} = $this->{$_docClass}->new(nodeName => $nodeName,%props);
            $this->_initNavigator($node);
        } else {
            die new IMPL::InvalidOperationException('Can     create a second top level element') unless $this->Current;
            $node = $this->{$Document}->Create($nodeName,$class,\%props);
            $this->Current->appendChild($node);
            $this->internalNavigateNodeSet($node);
        }
        
        if (@errors) {
            $this->BuildErrors->Append(
                map {
                    IMPL::DOM::Schema::ValidationError->new(
                        node => $node,
                        source => $schemaSource,
                        schema => $schemaNode,
                        message => $schemaNode->messageInflateError,
                        error => $_
                    )                    
                } @errors
            );
        }
        
        return $node;
    } else {
        die new IMPL::InvalidOperationException("The specified node is undefined", $nodeName)
            if !$this->ignoreUndefined;
        return;
    }
}

sub inflateProperties {
    my ($this,$schemaNode,$refProps) = @_;
    my @errors;
    foreach my $schemaProp ( $schemaNode->selectNodes('Property') ) {
        next if not exists $refProps->{$schemaProp->name};
        my $result = eval {$schemaProp->inflateValue($refProps->{$schemaProp->name}) };
        if (my $e = $@) {
            push @errors, $e;
        } else {
            $refProps->{$schemaProp->name} = $result;
        }        
    }
    return @errors;
}

sub inflateValue {
    my ($this,$value,$node) = @_;
    
    $node ||= $this->Current;
    
    my $nodeSchema = $this->{$_schemaNavi}->Current;
    
    my $result = eval { $nodeSchema->inflateValue($value) };
    if (my $e=$@) {
        $this->BuildErrors->Append(new IMPL::DOM::Schema::ValidationError(
            Schema =>  $nodeSchema,
            Node => $node,
            Error => $e,
            Message => $nodeSchema->messageInflateError,
            Source => $this->{$_schemaNavi}->SourceSchemaNode
        ));
        return $value;
    } else {
        return $result;
    }
}

sub Back {
    my ($this) = @_;
    
    $this->{$_schemaNavi}->SchemaBack();
    $this->SUPER::Back();
}

sub saveState {
    my ($this) = @_;
    
    $this->{$_schemaNavi}->saveState;
    $this->SUPER::saveState;
}

sub restoreState {
    my ($this) = @_;
    
    $this->{$_schemaNavi}->restoreState;
    $this->SUPER::restoreState;
}

#compatibility
sub buildErrors {
    goto &BuildErrors;
}

1;

__END__

=pod

=head1 NAME

C< IMPL::DOM::Navigator::Builder > - Навигатор, строящий документ по указанной схеме.

=head1 SYNOPSIS

=begin code

my $builder = new IMPL::DOM::Navigator::Builder(new MyApp::Document,$schema);
my $reader = new IMPL::DOM::XMLReader(Navigator => $builder);

$reader->ParseFile("document.xml");

my @errors = $schema->Validate($builder->Document);

=end code

=head1 DESCRIPTION

Построитель DOM документов по указанной схеме. Обычно используется в связке
с объектами для чтения такими как C<IMPL::DOM::XMLReader>.

=head1 METHODS

=over

=item C< CTOR($classDocument,$schema) >

Создает новый объект, принимает на вход класс документа (или фабрику, например
L<IMPL::Object::Factory>) и схему. В процессе процедуры построения документа
будет создан объект документа.

=item C< NavigateCreate($nodeName,\%props) >

Создает новый узел с указанным именем и переходит в него. В случае если в схеме
подходящий узел не найден, то вызывается исключение.

При этом по имени узла ищется его схема, после чего определяется класс для
создания экземпляра и созданный узел доавляется в документ. При создании
нового узла используется метод документа C<< IMPL::DOM::Document->Create >>

Свойства узла передаются при создании через параметр C<%props>, но имя создаваемого
узла НЕ может быть переопределено свойством C<nodeName>, оно будет проигнорировано.

=item C< Document >

Свойство, которое содержит документ по окончании процедуры построения.

=back

=cut