Mercurial > pub > Impl
changeset 236:2904da230022
DOM refactoring
author | sergey |
---|---|
date | Mon, 15 Oct 2012 04:23:01 +0400 |
parents | a4d9126edcbb |
children | 61db68166c37 |
files | Lib/IMPL/Class/MemberInfo.pm Lib/IMPL/DOM/Navigator/Builder.pm Lib/IMPL/DOM/Navigator/SchemaNavigator.pm Lib/IMPL/DOM/Schema/AnyNode.pm Lib/IMPL/DOM/Schema/ComplexType.pm Lib/IMPL/DOM/Schema/NodeList.pm Lib/IMPL/DOM/Schema/NodeSet.pm Lib/IMPL/DOM/Schema/Property.pm Lib/IMPL/DOM/Schema/SimpleType.pm Lib/IMPL/DOM/Schema/SwitchNode.pm Lib/IMPL/DOM/Schema/ValidationError.pm Lib/IMPL/DOM/Schema/Validator/Compare.pm Lib/IMPL/DOM/Schema/Validator/RegExp.pm Lib/IMPL/DOM/Transform/ObjectToDOM.pm Lib/IMPL/Transform.pm Lib/IMPL/Web/View/TTControl.pm Lib/IMPL/Web/View/TTDocument.pm |
diffstat | 17 files changed, 289 insertions(+), 126 deletions(-) [+] |
line wrap: on
line diff
--- a/Lib/IMPL/Class/MemberInfo.pm Fri Oct 12 02:08:51 2012 +0400 +++ b/Lib/IMPL/Class/MemberInfo.pm Mon Oct 15 04:23:01 2012 +0400 @@ -35,6 +35,14 @@ return; } +sub access { + goto &Access; +} + +sub name { + goto &Name; +} + 1; __END__
--- a/Lib/IMPL/DOM/Navigator/Builder.pm Fri Oct 12 02:08:51 2012 +0400 +++ b/Lib/IMPL/DOM/Navigator/Builder.pm Mon Oct 15 04:23:01 2012 +0400 @@ -2,6 +2,8 @@ use strict; use warnings; +use IMPL::Const qw(:prop); + use parent qw(IMPL::DOM::Navigator); use IMPL::Class::Property; use IMPL::Class::Property::Direct; @@ -10,10 +12,11 @@ use IMPL::DOM::Document; BEGIN { - private _direct property _schemaNavi => prop_all; - private _direct property _docClass => prop_all; - public _direct property BuildErrors => prop_get | prop_list; - public _direct property Document => prop_get | owner_set; + 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 = ( @@ -21,10 +24,12 @@ ); sub CTOR { - my ($this,$docClass,$schema) = @_; + 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 { @@ -54,11 +59,11 @@ $this->BuildErrors->Append( map { IMPL::DOM::Schema::ValidationError->new( - Node => $node, - Source => $schemaSource, - Schema => $schemaNode, - Message => $schemaNode->messageInflateError, - Error => $_ + node => $node, + source => $schemaSource, + schema => $schemaNode, + message => $schemaNode->messageInflateError, + error => $_ ) } @errors ); @@ -66,7 +71,9 @@ return $node; } else { - die new IMPL::InvalidOperationException("The specified node is undefined", $nodeName); + die new IMPL::InvalidOperationException("The specified node is undefined", $nodeName) + if !$this->ingnoreUndefiend; + return; } } @@ -128,6 +135,11 @@ $this->SUPER::restoreState; } +#compatibility +sub buildErrors { + goto &BuildErrors; +} + 1; __END__
--- a/Lib/IMPL/DOM/Navigator/SchemaNavigator.pm Fri Oct 12 02:08:51 2012 +0400 +++ b/Lib/IMPL/DOM/Navigator/SchemaNavigator.pm Mon Oct 15 04:23:01 2012 +0400 @@ -22,7 +22,7 @@ $this->{$Schema} = $schema; - die new IMPL::InvalidArgumentException("A schema object is required") unless $schema->isa('IMPL::DOM::Schema'); + die new IMPL::InvalidArgumentException("A schema object is required") unless $schema->isa('IMPL::DOM::Schema') || $schema->isa('IMPL::DOM::Schema::ComplexNode'); } my $schemaAnyNode = IMPL::DOM::Schema::ComplexType->new(type => '::AnyNodeType', nativeType => 'IMPL::DOM::ComplexNode')->appendRange(
--- a/Lib/IMPL/DOM/Schema/AnyNode.pm Fri Oct 12 02:08:51 2012 +0400 +++ b/Lib/IMPL/DOM/Schema/AnyNode.pm Mon Oct 15 04:23:01 2012 +0400 @@ -29,7 +29,7 @@ причем его использование исключает использование узла C<IMPL::DOM::Schema::SwitchNode>. В контейнерах типа С<IMPL::DOM::Schema::NodeList> данный узел может применяться несколько раз -для решения таких задачь как последовательности разноименных узлов с одним типом. +для решения таких задач как последовательности разноименных узлов с одним типом. <NodeList> <SimpleNode name="firstName"/>
--- a/Lib/IMPL/DOM/Schema/ComplexType.pm Fri Oct 12 02:08:51 2012 +0400 +++ b/Lib/IMPL/DOM/Schema/ComplexType.pm Mon Oct 15 04:23:01 2012 +0400 @@ -36,10 +36,10 @@ if ($this->{$nativeType}) { return new IMPL::DOM::Schema::ValidationError( - Node => $node, - Source => $ctx->{Source} || $this, - Schema => $this, - Message => $this->messageWrongType + node => $node, + source => $ctx->{Source} || $this, + schema => $this, + message => $this->messageWrongType ) unless $node->isa($this->{$nativeType}); } return $this->SUPER::Validate($node,$ctx);
--- a/Lib/IMPL/DOM/Schema/NodeList.pm Fri Oct 12 02:08:51 2012 +0400 +++ b/Lib/IMPL/DOM/Schema/NodeList.pm Mon Oct 15 04:23:01 2012 +0400 @@ -38,11 +38,11 @@ while ($info and not $info->{anyNode} and $info->{nodeName} ne $child->nodeName) { # if possible of course :) return new IMPL::DOM::Schema::ValidationError ( - Message => $this->messageUnexpected, - Node => $child, - Parent => $node, - Schema => $info->{Schema}, - Source => $sourceSchema + message => $this->messageUnexpected, + node => $child, + parent => $node, + schema => $info->{Schema}, + source => $sourceSchema ) if $info->{Min} > $info->{Seen}; $info = shift @nodes; @@ -50,10 +50,10 @@ # return error if no more children allowed return new IMPL::DOM::Schema::ValidationError ( - Message => $this->messageUnexpected, - Node => $child, - Parent => $node, - Source => $sourceSchema + message => $this->messageUnexpected, + node => $child, + parent => $node, + source => $sourceSchema ) unless $info; # it's ok, we found schema element for child @@ -72,22 +72,21 @@ # check count limits return new IMPL::DOM::Schema::ValidationError ( - Error => 1, - Message => $this->messageUnexpected, - Node => $child, - Parent => $node, - Source => $sourceSchema, + message => $this->messageUnexpected, + node => $child, + parent => $node, + source => $sourceSchema, ) if $info->{Max} and $info->{Seen} > $info->{Max}; } # no more children left (but may be should :) while ($info) { return new IMPL::DOM::Schema::ValidationError ( - Error => 1, - Message => $this->messageNodesRequired, - Source => $sourceSchema, - Parent => $node, - Schema => $info->{Schema} + error => 1, + message => $this->messageNodesRequired, + source => $sourceSchema, + parent => $node, + schema => $info->{Schema} ) if $info->{Seen} < $info->{Min}; $info = shift @nodes;
--- a/Lib/IMPL/DOM/Schema/NodeSet.pm Fri Oct 12 02:08:51 2012 +0400 +++ b/Lib/IMPL/DOM/Schema/NodeSet.pm Mon Oct 15 04:23:01 2012 +0400 @@ -45,11 +45,11 @@ if (my $info = $nodes{$child->nodeName} || $anyNode) { $info->{Seen}++; push @errors,new IMPL::DOM::Schema::ValidationError ( - Source => $sourceSchema, - Node => $child, - Parent => $node, - Schema => $info->{Schema}, - Message => $this->messageMax + source => $sourceSchema, + node => $child, + parent => $node, + schema => $info->{Schema}, + message => $this->messageMax ) if ($info->{Max} and $info->{Seen} > $info->{Max}); if (my @localErrors = $info->{Schema}->Validate($child)) { @@ -57,20 +57,20 @@ } } else { push @errors, new IMPL::DOM::Schema::ValidationError ( - Source => $sourceSchema, - Node => $child, - Parent => $node, - Message => $this->messageUnexpected + source => $sourceSchema, + node => $child, + parent => $node, + message => $this->messageUnexpected ) } } foreach my $info (values %nodes) { push @errors, new IMPL::DOM::Schema::ValidationError ( - Source => $sourceSchema, - Schema => $info->{Schema}, - Parent => $node, - Message => $this->messageMin + source => $sourceSchema, + schema => $info->{Schema}, + parent => $node, + message => $this->messageMin ) if $info->{Min} > $info->{Seen}; }
--- a/Lib/IMPL/DOM/Schema/Property.pm Fri Oct 12 02:08:51 2012 +0400 +++ b/Lib/IMPL/DOM/Schema/Property.pm Mon Oct 15 04:23:01 2012 +0400 @@ -47,10 +47,10 @@ } elsif($this->minOccur) { # we don't have a value but it's a mandatory property return new IMPL::DOM::Schema::ValidationError( - Message => $this->messageRequired, - Node => $node, - Schema => $this, - Source => $ctx && $ctx->{Source} || $this + message => $this->messageRequired, + node => $node, + schema => $this, + source => $ctx && $ctx->{Source} || $this ); } return ();
--- a/Lib/IMPL/DOM/Schema/SimpleType.pm Fri Oct 12 02:08:51 2012 +0400 +++ b/Lib/IMPL/DOM/Schema/SimpleType.pm Mon Oct 15 04:23:01 2012 +0400 @@ -36,10 +36,10 @@ if ($this->{$nativeType}) { return new IMPL::DOM::Schema::ValidationError( - Node => $node, - Source => $ctx && $ctx->{Source} || $this, - Schema => $this, - Message => $this->messageWrongType + node => $node, + source => $ctx && $ctx->{Source} || $this, + schema => $this, + message => $this->messageWrongType ) unless $node->isa($this->{$nativeType}); } return $this->SUPER::Validate($node,$ctx);
--- a/Lib/IMPL/DOM/Schema/SwitchNode.pm Fri Oct 12 02:08:51 2012 +0400 +++ b/Lib/IMPL/DOM/Schema/SwitchNode.pm Mon Oct 15 04:23:01 2012 +0400 @@ -34,9 +34,9 @@ return $schema->Validate($node); } else { return new IMPL::DOM::Schema::ValidationError( - Node => $node, - Source => $this, - Message => $this->messageNoMatch + node => $node, + source => $this, + message => $this->messageNoMatch ); } }
--- a/Lib/IMPL/DOM/Schema/ValidationError.pm Fri Oct 12 02:08:51 2012 +0400 +++ b/Lib/IMPL/DOM/Schema/ValidationError.pm Mon Oct 15 04:23:01 2012 +0400 @@ -12,32 +12,32 @@ use IMPL::Resources::Format qw(FormatMessage); BEGIN { - public _direct property Node => prop_get; # target document node (if exists) - public _direct property Schema => prop_get; # a schema for the target node (if exists) - public _direct property Source => prop_get; # a schema which triggered this error (can be equal to the Schema) - public _direct property Parent => prop_get; - public _direct property Message => prop_get; # displayable message + public _direct property node => prop_get; # target document node (if exists) + public _direct property schema => prop_get; # a schema for the target node (if exists) + public _direct property source => prop_get; # a schema which triggered this error (can be equal to the Schema) + public _direct property parent => prop_get; + public _direct property message => prop_get; # displayable message } sub CTOR { my ($this,%args) = @_; - $this->{$Node} = $args{Node}; - $this->{$Schema} = $args{Schema} if $args{Schema}; - $this->{$Source} = $args{Source} if $args{Source}; - if ($args{Parent}) { - $this->{$Parent} = $args{Parent}; - } elsif ($args{Node}) { - $this->{$Parent} = $args{Node}->parentNode; + $this->{$node} = $args{node}; + $this->{$schema} = $args{schema} if $args{schema}; + $this->{$source} = $args{source} if $args{source}; + if ($args{parent}) { + $this->{$parent} = $args{parent}; + } elsif ($args{node}) { + $this->{$parent} = $args{node}->parentNode; } else { - die new IMPL::InvalidArgumentException("A 'Parent' or a 'Node' parameter is required"); + die new IMPL::InvalidArgumentException("A 'parent' or a 'node' parameter is required"); } - $this->{$Message} = FormatMessage(delete $args{Message}, \%args) if $args{Message}; + $this->{$message} = FormatMessage(delete $args{message}, \%args) if $args{message}; } sub toString { (my $this) = @_; - return $this->Message; + return $this->message; } 1; @@ -59,6 +59,12 @@ С помощью данного объекта осущетсвляется привязка элемента схемы, элемента документа и сообщения о причине возникновения ошибки. +Часть ошибок, таких как проверка содержимого на регулярные выражения, привязаны +непосредственно к элементу. Но есть ошибки которые привязываются к родительскому +контейнеру, например отсутсвие обязательного элемента. В таком случае ошибка +содержит свойство C<parent> и по свойству C<source> можно определить элемент +(например его имя), к которому относится ошибка. + =head1 MEMBERS =over
--- a/Lib/IMPL/DOM/Schema/Validator/Compare.pm Fri Oct 12 02:08:51 2012 +0400 +++ b/Lib/IMPL/DOM/Schema/Validator/Compare.pm Mon Oct 15 04:23:01 2012 +0400 @@ -129,20 +129,20 @@ } push @result, new IMPL::DOM::Schema::ValidationError( - Node => $node, - ForeignNode => $foreignNode, - Value => $value, - Source => $Source, - Schema => $this->parentNode, - Message => $this->message + node => $node, + foreignNode => $foreignNode, + value => $value, + source => $Source, + schema => $this->parentNode, + message => $this->message ) unless $this->op->(_resovleProperty($node,$this->targetProperty),$value); } elsif (not $this->optional) { push @result, new IMPL::DOM::Schema::ValidationError( - Node => $node, - Value => '', - Source => $Source, - Schema => $this->parentNode, - Message => $this->message + node => $node, + value => '', + source => $Source, + schema => $this->parentNode, + message => $this->message ); }
--- a/Lib/IMPL/DOM/Schema/Validator/RegExp.pm Fri Oct 12 02:08:51 2012 +0400 +++ b/Lib/IMPL/DOM/Schema/Validator/RegExp.pm Mon Oct 15 04:23:01 2012 +0400 @@ -1,5 +1,5 @@ package IMPL::DOM::Schema::Validator::RegExp; - +use strict; use parent qw(IMPL::DOM::Schema::Validator); our %CTOR = (
--- /dev/null Thu Jan 01 00:00:00 1970 +0000 +++ b/Lib/IMPL/DOM/Transform/ObjectToDOM.pm Mon Oct 15 04:23:01 2012 +0400 @@ -0,0 +1,134 @@ +package IMPL::DOM::Transform::ObjectToDOM; +use strict; + +use IMPL::Const qw(:prop :access); +use IMPL::declare { + require => { + PropertyInfo => 'IMPL::Class::PropertyInfo', + Builder => 'IMPL::DOM::Navigator::Builder', + Exception => 'IMPL::Exception', + ArgumentException => '-IMPL::InvalidArgumentException', + OperationException => '-IMPL::InvalidOperationException' + }, + base => [ + 'IMPL::Transform' => sub { + -plain => \&TransformPlain, + HASH => \&TransformHash, + -default => \&TransformDefault + } + ], + props => [ + documentSchema => PROP_RO, + _schema => PROP_RW, + _navi => PROP_RW + ] +}; + +sub CTOR { + my ($this,$docName,$docSchema) = @_; + + my $docNodeSchema = $docSchema->selectSingleNode(sub { $_->name eq $docName }) + or die OperationException->new("Can't find a node schema for the document '$docName'"); + + my $docClass = ($docNodeSchema->can('nativeType') ? $docNodeSchema->nativeType : undef) || 'IMPL::DOM::Document'; + + $this->documentSchema($docNodeSchema); + + $this->_navi( + Builder->new( + $docClass, + $docSchema, + ignoreUndefined => 1 + ) + ); + $this->_schema($docSchema); + + $this->_navi->NavigateCreate($docName); +} + +sub TransformPlain { + my ($this,$data) = @_; + + $this->_navi->Current->nodeValue( $this->_navi->inflateValue($data) ); + return $this->_navi->Current; +} + +sub TransformHash { + my ($this,$data) = @_; + + die ArgumentException->new(data => 'A HASH reference is required') + unless ref $data eq 'HASH'; + + KEYLOOP: foreach my $key (keys %$data) { + my $value = $data->{$key}; + + if (ref $value eq 'ARRAY') { + foreach my $subval (@$value) { + + my $node = $this->_navi->NavigateCreate($key); + + unless(defined $node) { + $this->_navi->Back(); + next KEYLOOP; + } + + $this->Transform($subval); + + $this->_navi->Back(); + } + } else { + my $node = $this->_navi->NavigateCreate($key); + + unless(defined $node) { + $this->_navi->Back(); + next KEYLOOP; + } + + $this->Transform($value); + + $this->_navi->Back(); + } + } + return $this->_navi->Current; +} + +sub TransformDefault { + my ($this,$data) = @_; + + if ( ref $data and eval { $data->can('GetMeta') } ) { + my %props = map { + $_->name, 1 + } $data->GetMeta(PropertyInfo, sub { $_->access == ACCESS_PUBLIC }, 1 ); + + my %values = map { + $_, + $data->$_(); + } keys %props; + + return $this->Transform(\%values); + } else { + die OperationException->new("Don't know how to transform $data"); + } + + return $this->_navi->Current; +} + +sub buildErrors { + my ($this) = @_; + + return $this->_navi->buildErrors; +} + +1; + +__END__ + +=pod + +=head1 NAME + +C<IMPL::DOM::Transform::ObjectToDOM> -преобразование объекта + +=head1 SYNOPSIS + +=cut \ No newline at end of file
--- a/Lib/IMPL/Transform.pm Fri Oct 12 02:08:51 2012 +0400 +++ b/Lib/IMPL/Transform.pm Mon Oct 15 04:23:01 2012 +0400 @@ -3,7 +3,7 @@ use parent qw(IMPL::Object); -use IMPL::lang qw(:declare :constants); +use IMPL::lang qw(:declare); use IMPL::Class::Property::Direct;
--- a/Lib/IMPL/Web/View/TTControl.pm Fri Oct 12 02:08:51 2012 +0400 +++ b/Lib/IMPL/Web/View/TTControl.pm Mon Oct 15 04:23:01 2012 +0400 @@ -41,10 +41,11 @@ $this->id($name . "-" . _GetNextId()) unless $this->id; - weaken($this); # prevent cyclic references produced by the code below + #TODO: deprecated, cleanup + #weaken($this); # prevent cyclic references produced by the code below - $context->stash->set('append', sub { $this->appendChild(@_); undef; } ); - $context->stash->set('select', sub { $this->selectNodes(@_); } ); + #$context->stash->set('append', sub { $this->appendChild(@_); undef; } ); + #$context->stash->set('select', sub { $this->selectNodes(@_); } ); } sub InitInstance {
--- a/Lib/IMPL/Web/View/TTDocument.pm Fri Oct 12 02:08:51 2012 +0400 +++ b/Lib/IMPL/Web/View/TTDocument.pm Mon Oct 15 04:23:01 2012 +0400 @@ -1,28 +1,40 @@ package IMPL::Web::View::TTDocument; use strict; -use IMPL::lang qw(:declare ); -use IMPL::DOM::Property qw(_dom); -use IMPL::Web::View::TTFactory(); -use IMPL::Web::View::TTControl(); +use Scalar::Util qw(weaken); +use IMPL::Const qw(:prop); -use Scalar::Util qw(weaken); - - -use parent qw( - IMPL::DOM::Document - IMPL::Web::View::TTControl -); +use IMPL::declare { + require => { + TTFactory => 'IMPL::Web::View::TTFactory', + TTControl => 'IMPL::Web::View::TTControl', + Loader => 'IMPL::Code::Loader' + }, + base => [ + 'IMPL::Web::View::TTControl' => sub { + my ($template,$contextOpts) = @_; + 'document', + $_[0], # template + new Template::Context($_[1]) # context + }, + 'IMPL::DOM::Document' => sub { + nodeName => 'document' + } + ], + props => [ + layout => PROP_RW, + opts => PROP_RO, + loader => PROP_RW, + controls => PROP_RO, + + # store the stash separately to make require() method to work correctly + # even when a stash of the context is modified during the processing + stash => PROP_RO + ] +}; BEGIN { - public _dom property layout => PROP_ALL; - public property opts => PROP_GET | PROP_OWNERSET; - public property loader => PROP_ALL; - public property controls => PROP_GET | PROP_OWNERSET; - - # store the stash separately to make require() method to work correctly - # even when a stash of the context is modified during the processing - public property stash => PROP_GET | PROP_OWNERSET; + } sub CTOR { @@ -42,25 +54,13 @@ $this->templateVars('require', sub { my $doc = $self; die new IMPL::Exception("A document is destroyed or invalid") unless $doc; - $doc->require(@_); + $doc->RequireControl(@_); }); $this->templateVars('document', sub { $self } ); $this->InitInstance($vars); } -our %CTOR = ( - 'IMPL::Web::View::TTControl' => sub { - my ($template,$contextOpts) = @_; - 'document', - $_[0], # template - new Template::Context($_[1]) # context - }, - 'IMPL::DOM::Document' => sub { - nodeName => 'document' - } -); - sub templateVars { my $this = shift; my $name = shift; @@ -72,7 +72,7 @@ } } -sub require { +sub RequireControl { my ($this, $control, $nodeProps) = @_; $nodeProps ||= {}; @@ -98,6 +98,10 @@ $opts ); + if ($template->class) { + Loader->safe->Require($template->class); + } + my @parts = split(/\/+/,$control); $this->controls->{$control} = $factory; @@ -137,7 +141,6 @@ return $this->SUPER::Render(@_); } - 1; __END__ @@ -286,7 +289,7 @@ Получает или задает переменную для шаблона документа. Имя переменнной может быть составным, например C<'my.var.name'>, см. C<Template::Stash::set()>. -=item C<require($controlName)> +=item C<RequireControl($controlName)> Загружает фабрику элемента управления, если она уже была загружена, возвращает на нее ссылку. При загрузки фабрики для нее создается собственный контекст на основе параметров из свойства