view Lib/IMPL/DOM/Navigator/Builder.pm @ 245:7c517134c42f

Added Unsupported media type Web exception corrected resourceLocation setting in the resource Implemented localizable resources for text messages fixed TT view scopings, INIT block in controls now sets globals correctly.
author sergey
date Mon, 29 Oct 2012 03:15:22 +0400
parents b8c724f6de36
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