changeset 24:7f00786f8210

Первая рабочая реазизация схемы и навигаторов
author Sergey
date Mon, 05 Oct 2009 00:48:49 +0400
parents 716b287d4795
children 9dd67fa91ee3
files Lib/IMPL/DOM/Document.pm Lib/IMPL/DOM/Navigator.pm Lib/IMPL/DOM/Navigator/Builder.pm Lib/IMPL/DOM/Navigator/SchemaNavigator.pm Lib/IMPL/DOM/Node.pm Lib/IMPL/DOM/Schema.pm Lib/IMPL/DOM/Schema/AnyNode.pm Lib/IMPL/DOM/Schema/Node.pm Lib/IMPL/DOM/Schema/NodeList.pm Lib/IMPL/DOM/Schema/NodeSet.pm Lib/IMPL/DOM/Schema/Property.pm Lib/IMPL/DOM/Schema/SwitchNode.pm Lib/IMPL/DOM/Schema/ValidationError.pm Lib/IMPL/Object/Abstract.pm _test/Test/DOM/Navigator.pm _test/Test/DOM/Node.pm _test/Test/DOM/Schema.pm
diffstat 17 files changed, 616 insertions(+), 98 deletions(-) [+]
line wrap: on
line diff
--- a/Lib/IMPL/DOM/Document.pm	Wed Sep 30 17:43:52 2009 +0400
+++ b/Lib/IMPL/DOM/Document.pm	Mon Oct 05 00:48:49 2009 +0400
@@ -11,6 +11,8 @@
     
     $refProps ||= {};
     
+    delete $refProps->{nodeName};
+    
     return $class->new(
         nodeName => $nodeName,
         %$refProps
--- a/Lib/IMPL/DOM/Navigator.pm	Wed Sep 30 17:43:52 2009 +0400
+++ b/Lib/IMPL/DOM/Navigator.pm	Mon Oct 05 00:48:49 2009 +0400
@@ -6,55 +6,206 @@
 use IMPL::Class::Property;
 use IMPL::Class::Property::Direct;
 BEGIN {
-    public _direct property Path => prop_get | owner_set;
-    public _direct property Current => prop_get | owner_set;
+    private _direct property _path => prop_all;
+    private _direct property _state => prop_all;
+    private _direct property _savedstates => prop_all;
+    public property Current => {get => \&_getCurrent};
 }
 
 sub CTOR {
     my ($this,$CurrentNode) = @_;
     
-    $this->{$Current} = $CurrentNode or die IMPL::InvalidArgumentException("A starting node is a required paramater");
+    die IMPL::InvalidArgumentException("A starting node is a required paramater") unless $CurrentNode;
+    
+    $this->{$_state} = { alternatives => [ $CurrentNode ], current => 0 };
+}
+
+sub _getCurrent {
+    $_[0]->{$_state}{alternatives}[$_[0]->{$_state}{current}]
 }
 
 sub Navigate {
-    my ($this,$query) = @_;
+    my ($this,@path) = @_;
+    
+    return unless @path;
     
-    if ( my ($newNode) = $this->{$Current}->selectNodes($query) ) {
-        push @{$this->{$Path}}, $this->{$Current};
-        return $this->{$Current} = $newNode;
+    foreach my $query (@path) {
+        if (my $current = $this->Current) {
+            
+            my @alternatives = $this->Current->selectNodes($query);
+            
+            unless (@alternatives) {
+                $this->advanceNavigator or return undef;
+                @alternatives = $this->Current->selectNodes($query);
+            }
+            
+            push @{$this->{$_path}},$this->{$_state};
+            $this->{$_state} = {
+                alternatives => \@alternatives,
+                current => 0,
+                query => $query
+            }
+        } else {
+            return undef;
+        }
+    }
+    
+    return $this->Current;
+}
+
+sub selectNodes {
+    my ($this,@path) = @_;
+    
+    return internalSelectNodes($this->Current,@path);
+}
+
+sub internalSelectNodes {
+    my $node = shift;
+    my $query = shift;
+    
+    if (@_) {
+        return map internalSelectNodes($_,@_), $node->selectNodes($query);
     } else {
-        return undef;
+        return $node->selectNodes($query);
     }
 }
 
-sub _NavigateNode {
-    my ($this,$newNode) = @_;
-    push @{$this->{$Path}}, $this->{$Current};
-    return $this->{$Current} = $newNode;
+sub internalNavigateNodeSet {
+    my ($this,@nodeSet) = @_;
+    
+    push @{$this->{$_path}}, $this->{$_state};
+    
+    $this->{$_state} = {
+        alternatives => \@nodeSet,
+        current => 0
+    };
+    
+    return $this->Current;
+}
+
+sub fetch {
+    my ($this) = @_;
+    
+    my $result = $this->Current;
+    $this->advanceNavigator;
+    return $result;
 }
 
-sub _NavigateNodeStirct {
-    my ($this,$newNode) = @_;
+sub advanceNavigator {
+    my ($this) = @_;
+    
+    $this->{$_state}{current}++;
     
-    die new IMPL::InvalidOperationException("A newNode doesn't belongs to the current") unless $newNode->parentNode == $this->{$Current};
-    push @{$this->{$Path}}, $this->{$Current};
-    return $this->{$Current} = $newNode;
+    if (@{$this->{$_state}{alternatives}} <= $this->{$_state}{current}) {
+        if ( exists $this->{$_state}{query} ) {
+            my $query = $this->{$_state}{query};
+  
+            $this->Back or return 0; # that meams the end of the history
+
+            undef while ( $this->advanceNavigator and not $this->Navigate($query));
+
+            return $this->Current ? 1 : 0;
+        }
+        return 0;
+    }
+    
+    return 1;
+}
+
+sub doeach {
+    my ($this,$code) = @_;
+    local $_;
+    
+    do {
+        for (my $i = $this->{$_state}{current}; $i < @{$this->{$_state}{alternatives}}; $i++) {
+            $_ = $this->{$_state}{alternatives}[$i];
+            $code->();
+        }
+         $this->{$_state}{current} = @{$this->{$_state}{alternatives}};
+    } while ($this->advanceNavigator);
 }
 
 sub Back {
-    my ($this) = @_;
+    my ($this,$steps) = @_;
+    
+    $steps ||= 1;
     
-    if ( my $newNode = $this->{$Path} ? pop @{$this->{$Path}} : undef ) {
-        return $this->{$Current} = $newNode;
+    if ($this->{$_path} and @{$this->{$_path}}) {
+        
+        $steps = @{$this->{$_path}} - 1 if $steps >= @{$this->{$_path}};
+        
+        ($this->{$_state}) = splice @{$this->{$_path}},-$steps;
+        
+        $this->Current;
     } else {
         return undef;
     }
 }
 
 sub PathToString {
-    my $this = shift;
+    my ($this,$delim) = @_;
+    
+    $delim ||= '/';
+    
+    join($delim,map $_->{alternatives}[$_->{current}]->nodeName, $this->{$_path} ? (@{$this->{$_path}}, $this->{$_state}) : $this->{$_state});
+}
+
+sub clone {
+    my ($this) = @_;
+    
+    my $newNavi = __PACKAGE__->surrogate;
+    
+    $newNavi->{$_path} = [ map { { %{ $_ } }  } @{$this->{$_path}} ] if $this->{$_path};
+    $newNavi->{$_state} = { %{$this->{$_state}} };
+    
+    return $newNavi;
+    
+}
+
+sub saveState {
+    my ($this) = @_;
+    
+    my %state;
+    
+    $state{path} = [ map { { %{ $_ } }  } @{$this->{$_path}} ] if $this->{$_path};
+    $state{state} = { %{$this->{$_state}} };
     
-    join('/',map $_->nodeName, $this->{$Path} ? (@{$this->{$Path}}, $this->{$Current}) : $this->{$Current});
+    push @{$this->{$_savedstates}}, \%state;
+}
+
+sub restoreState {
+    my ($this) = @_;
+    
+    if ( my $state = pop @{$this->{$_savedstates}||[]} ) {
+        $this->{$_path} = $state->{path};
+        $this->{$_state} = $state->{state};
+    }
+}
+
+sub applyState {
+    my ($this) = @_;
+    
+    pop @{$this->{$_savedstates}||[]};
+}
+
+sub dosafe {
+    my ($this,$transaction) = @_;
+    
+    $this->saveState();
+    
+    my $result;
+    
+    eval {
+        $result = $transaction->();
+    };
+    
+    if ($@) {
+        $this->restoreState();
+        return undef;
+    } else {
+        $this->applyState();
+        return $result;
+    }
 }
 
 1;
@@ -66,6 +217,11 @@
 
      DOM .
 
+     ().
+
+     ,    ,
+        .
+
 =head1 METHODS
 
 =over
@@ -74,7 +230,7 @@
 
       .
 
-=item C<$obj->Navigate($query)>
+=item C<$obj->Navigate([$query,...])>
 
       C<$query>.     
          .     
--- a/Lib/IMPL/DOM/Navigator/Builder.pm	Wed Sep 30 17:43:52 2009 +0400
+++ b/Lib/IMPL/DOM/Navigator/Builder.pm	Mon Oct 05 00:48:49 2009 +0400
@@ -5,9 +5,10 @@
 use base qw(IMPL::DOM::Navigator);
 use IMPL::Class::Property;
 use IMPL::Class::Property::Direct;
+require IMPL::DOM::Navigator::SchemaNavigator;
 
 BEGIN {
-    protected _direct property _navigatorSchema => prop_all;
+    protected _direct property _schemaNavi => prop_all;
     public _direct property Document => prop_get | owner_set;
 }
 
@@ -19,30 +20,18 @@
     my ($this,$domDocument,$schema) = @_;
     
     $this->{$Document} = $domDocument;
-    $this->{$_navigatorSchema} = new IMPL::DOM::Navigator($schema);
+    $this->{$_schemaNavi} = $schema;
 }
 
 sub NavigateCreate {
     my ($this,$nodeName,%props) = @_;
     
-    if ( my $nodeSchema = $this->{$_navigatorSchema}->Navigate(sub { $_[0]->nodeName eq $nodeName or $_[0]->isa('IMPL::DOM::Schema::AnyNode') }) ) {
-        my $class = delete $props{type} || $nodeSchema->type || $nodeName;
-        
-        my $node = $this->{$Document}->Create(delete $props{nodeName} || $nodeName, $class, \%props);
-        
-        $this->Current()->appendNode($node);
-        $this->Current($node);
-        
-    } else {
-        die new IMPL::InvalidOperationException("Requested elemnt not found in the schema");
-    }
+    
 }
 
 sub Back {
     my ($this) = @_;
     
-    $this->{$_navigatorSchema}->Back;
-    return $this->SUPER::Back();
 }
 
 1;
--- a/Lib/IMPL/DOM/Navigator/SchemaNavigator.pm	Wed Sep 30 17:43:52 2009 +0400
+++ b/Lib/IMPL/DOM/Navigator/SchemaNavigator.pm	Mon Oct 05 00:48:49 2009 +0400
@@ -6,10 +6,15 @@
 use IMPL::Class::Property;
 use IMPL::Class::Property::Direct;
 
+require IMPL::DOM::Schema::ComplexType;
+require IMPL::DOM::Schema::NodeSet;
+require IMPL::DOM::Schema::AnyNode;
+
 __PACKAGE__->PassThroughArgs;
 
 BEGIN {
     public _direct property Schema => prop_get;
+    private _direct property _historySteps => prop_all;
 }
 
 sub CTOR {
@@ -20,19 +25,72 @@
     die new IMPL::InvalidArgumentException("A schema object is required") unless $schema->isa('IMPL::DOM::Schema');
 }
 
-sub Navigate {
-    my ($this,$query) = @_;
+my $schemaAnyNode = IMPL::DOM::Schema::ComplexType->new(type => '::AnyNodeType', nativeType => 'IMPL::DOM::ComplexNode')->appendRange(
+    IMPL::DOM::Schema::NodeSet->new()->appendRange(
+        IMPL::DOM::Schema::AnyNode->new()
+    )
+);
+
+sub NavigateName {
+    my ($this,$name) = @_;
     
-    if (my ($newNode) = $this->Current->selectNodes($query)) {
-        if (ref $newNode eq 'IMPL::DOM::Schema::Node') {
-            $newNode = $this->{$Schema}->ResolveType($newNode->type) || $newNode;
+    # perform a safe navigation
+    return dosafe $this sub {
+        my $steps = 1;
+        # navigate to node
+        if (
+            my $node = $this->Navigate( sub {
+                $_->isa('IMPL::DOM::Schema::Node') and (
+                    $_->name eq $name
+                    or
+                    $_->nodeName eq 'AnyNode'
+                    or
+                    ( $_->nodeName eq 'SwitchNode' and $_->selectNodes( sub { $_->name eq $name } ) )
+                )
+            })
+        ) {
+            if ($node->nodeName eq 'AnyNode') {
+                # if we navigate to the anynode
+                # assume it to be ComplexType by default
+                $node = $node->type ? $this->{$Schema}->resolveType($node->type) : $schemaAnyNode;
+            } elsif ($node->nodeName eq 'SwitchNode') {
+                # if we are in the switchnode
+                # navigate to the target node
+                $node = $this->Navigate(sub { $_->name eq $name });
+                $steps ++;
+            }
+            
+            if ($node->nodeName eq 'Node') {
+                # if we navigate to a reference
+                # resolve it
+                $node = $this->{$Schema}->resolveType($node->type);
+                $this->internalNavigateNodeSet($node);
+                $steps++;
+            } 
+            
+            # if target node is a complex node
+            if ($node->isa('IMPL::DOM::Schema::ComplexNode')) {
+                # navigate to it's content
+                $this->internalNavigateNodeSet($node->content);
+                $steps ++;
+            }
+            
+            push @{$this->{$_historySteps}},$steps;
+            
+            # return found node schema
+            return $node;
+        } else {
+            die; # abort navigation
         }
-        return $this->_NavigateNode($newNode);
-    } else {
-        return undef;
     }
 }
 
+sub SchemaBack {
+    my ($this) = @_;
+    
+    $this->Back(pop @{$this->{$_historySteps}}) if $this->{$_historySteps};
+}
+
 1;
 __END__
 
@@ -40,7 +98,23 @@
 
 =head1 DESCRIPTION
 
-  ,    ,      <Node nodeName="SomeName" type="ReferencedType"/>.
-             .
+        ,
+   .
+
+=head1 METHODS
+
+=over
+
+=item C<< $navi->NavigateName($name) >>
+
+      .    C<name>
+
+=item C<< $navi->SchemaBack >>
+
+      C<NavigateName>.   
+         
+     .
+
+=back
 
 =cut
\ No newline at end of file
--- a/Lib/IMPL/DOM/Node.pm	Wed Sep 30 17:43:52 2009 +0400
+++ b/Lib/IMPL/DOM/Node.pm	Mon Oct 05 00:48:49 2009 +0400
@@ -167,6 +167,9 @@
     
     if (ref $query eq 'CODE') {
         @result = grep &$query($_), @{$this->childNodes};
+    } elsif (ref $query eq 'ARRAY' ) {
+        my %keys = map (($_,1),@$query);
+        @result = grep $keys{$_->nodeName}, @{$this->childNodes};
     } elsif (defined $query) {
         @result = grep $_->nodeName eq $query, @{$this->childNodes};
     } else {
@@ -246,4 +249,18 @@
     }
 }
 
+sub qname {
+    $_[0]->{$nodeName};
+}
+
+sub path {
+    my ($this) = @_;
+    
+    if ($this->parentNode) {
+        return $this->parentNode->path.'.'.$this->qname;
+    } else {
+        return $this->qname;
+    }
+}
+
 1;
--- a/Lib/IMPL/DOM/Schema.pm	Wed Sep 30 17:43:52 2009 +0400
+++ b/Lib/IMPL/DOM/Schema.pm	Mon Oct 05 00:48:49 2009 +0400
@@ -10,12 +10,16 @@
 require IMPL::DOM::Schema::AnyNode;
 require IMPL::DOM::Schema::NodeList;
 require IMPL::DOM::Schema::NodeSet;
+require IMPL::DOM::Schema::Property;
+require IMPL::DOM::Schema::SwitchNode;
 
 use base qw(IMPL::DOM::Document);
 use IMPL::Class::Property;
 use IMPL::Class::Property::Direct;
 
-__PACKAGE__->PassThroughArgs;
+our %CTOR = (
+    'IMPL::DOM::Document' => sub { nodeName => 'schema' }
+);
 
 BEGIN {
     private _direct property _TypesMap => prop_all;
@@ -28,7 +32,7 @@
 sub Process {
     my ($this) = @_;
     
-    $this->{$_TypesMap} = { map { $_->type, $_ } grep {$_->isa('IMPL::DOM::Schema::Type')} @{$this->childNodes} };
+    $this->{$_TypesMap} = { map { $_->type, $_ } $this->selectNodes(sub { $_[0]->nodeName eq 'ComplexType' || $_[0]->nodeName eq 'SimpleType' } ) };
 }
 
 sub Validate {
@@ -37,7 +41,7 @@
     if ( my ($schemaNode) = $this->selectNodes(sub { $_[0]->name eq $node->nodeName })) {
         $schemaNode->Validate($node);
     } else {
-        return IMPL::DOM::Schema::VaidationError(Message=> "A specified document doesn't match the schema");
+        return IMPL::DOM::Schema::ValidationError(Message=> "A specified document doesn't match the schema");
     }
 }
 
@@ -47,7 +51,7 @@
     
     return $schema if $schema;
     
-    $schema = new IMPL::DOM::Schema(nodeName => 'schema');
+    $schema = new IMPL::DOM::Schema;
     
     $schema->appendRange(
         IMPL::DOM::Schema::ComplexNode->new(name => 'schema')->appendRange(
@@ -57,7 +61,9 @@
                 IMPL::DOM::Schema::Node->new(name => 'SimpleNode', type => 'SimpleNode', minOccur => 0, maxOccur=>'unbounded'),
                 IMPL::DOM::Schema::Node->new(name => 'SimpleType', type => 'SimpleType', minOccur => 0, maxOccur=>'unbounded'),
                 IMPL::DOM::Schema::SimpleNode->new(name => 'Node', minOccur => 0, maxOccur=>'unbounded'),
-                IMPL::DOM::Schema::SimpleNode->new(name => 'Include', minOccur => 0, maxOccur=>'unbounded')
+                IMPL::DOM::Schema::SimpleNode->new(name => 'Include', minOccur => 0, maxOccur=>'unbounded')->appendRange(
+                    IMPL::DOM::Schema::Property->new(name => 'source')
+                )
             ),
         ),
         IMPL::DOM::Schema::ComplexType->new(type => 'NodeSet', nativeType => 'IMPL::DOM::Schema::NodeSet')->appendRange(
@@ -65,28 +71,45 @@
                 IMPL::DOM::Schema::Node->new(name => 'ComplexNode', type => 'ComplexNode', minOccur => 0, maxOccur=>'unbounded'),
                 IMPL::DOM::Schema::Node->new(name => 'SimpleNode', type => 'SimpleNode', minOccur => 0, maxOccur=>'unbounded'),
                 IMPL::DOM::Schema::SimpleNode->new(name => 'Node', minOccur => 0, maxOccur=>'unbounded'),
+                IMPL::DOM::Schema::SwitchNode->new(minOccur => 0, maxOccur => 1)->appendRange(
+                    IMPL::DOM::Schema::SimpleNode->new(name => 'AnyNode'),
+                    IMPL::DOM::Schema::Node->new(name => 'SwitchNode',type => 'SwitchNode')
+                )
+            )
+        ),
+        IMPL::DOM::Schema::ComplexType->new(type => 'SwitchNode', nativeType => 'IMPL::DOM::Schema::SwitchNode')->appendRange(
+            IMPL::DOM::Schema::NodeSet->new()->appendRange(
+                IMPL::DOM::Schema::Node->new(name => 'ComplexNode', type=>'ComplexNode', minOccur => 0, maxOccur=>'unbounded'),
+                IMPL::DOM::Schema::Node->new(name => 'SimpleNode', type=>'SimpleNode', minOccur => 0, maxOccur=>'unbounded'),
+                IMPL::DOM::Schema::SimpleNode->new(name => 'Node', minOccur => 0, maxOccur=>'unbounded'),
             )
         ),
         IMPL::DOM::Schema::ComplexType->new(type => 'NodeList', nativeType => 'IMPL::DOM::Schema::NodeList')->appendRange(
             IMPL::DOM::Schema::NodeSet->new()->appendRange(
                 IMPL::DOM::Schema::Node->new(name => 'ComplexNode', type => 'ComplexNode', minOccur => 0, maxOccur=>'unbounded'),
                 IMPL::DOM::Schema::Node->new(name => 'SimpleNode', type => 'SimpleNode', minOccur => 0, maxOccur=>'unbounded'),
+                IMPL::DOM::Schema::Node->new(name => 'SwitchNode',type => 'SwitchNode', minOccur => 0, maxOccur=>'unbounded'),
                 IMPL::DOM::Schema::SimpleNode->new(name => 'Node', minOccur => 0, maxOccur=>'unbounded'),
+                IMPL::DOM::Schema::SimpleNode->new(name => 'AnyNode', minOccur => 0, maxOccur=>'unbounded'),
             )
         ),
         IMPL::DOM::Schema::ComplexType->new(type => 'ComplexType', nativeType => 'IMPL::DOM::Schema::ComplexType')->appendRange(
             IMPL::DOM::Schema::NodeList->new()->appendRange(
-                IMPL::DOM::Schema::Node->new(name => 'NodeSet', minOccur => 0, type => 'NodeSet'),
-                IMPL::DOM::Schema::Node->new(name => 'NodeList', minOccur => 0, type => 'NodeSet'),
-                IMPL::DOM::Schema::SimpleNode->new(name => 'Node', minOccur => 0, maxOccur => 'unbounded')
+                IMPL::DOM::Schema::SwitchNode->new()->appendRange(
+                    IMPL::DOM::Schema::Node->new(name => 'NodeSet', type => 'NodeSet'),
+                    IMPL::DOM::Schema::Node->new(name => 'NodeList',type => 'NodeList'),
+                ),
+                IMPL::DOM::Schema::AnyNode->new(maxOccur => 'unbounded', minOccur => 0)
             ),
             new IMPL::DOM::Schema::Property(name => 'type')
         ),
         IMPL::DOM::Schema::ComplexType->new(type => 'ComplexNode', nativeType => 'IMPL::DOM::Schema::ComplexNode')->appendRange(
             IMPL::DOM::Schema::NodeList->new()->appendRange(
-                IMPL::DOM::Schema::Node->new(name => 'NodeSet', minOccur => 0, type => 'NodeSet'),
-                IMPL::DOM::Schema::Node->new(name => 'NodeList', minOccur => 0, type => 'NodeSet'),
-                IMPL::DOM::Schema::SimpleNode->new(name => 'Node', minOccur => 0, maxOccur => 'unbounded')
+                IMPL::DOM::Schema::SwitchNode->new()->appendRange(
+                    IMPL::DOM::Schema::Node->new(name => 'NodeSet', type => 'NodeSet'),
+                    IMPL::DOM::Schema::Node->new(name => 'NodeList',type => 'NodeList'),
+                ),
+                IMPL::DOM::Schema::AnyNode->new(maxOccur => 'unbounded', minOccur => 0)
             ),
             new IMPL::DOM::Schema::Property(name => 'name')
         ),
--- a/Lib/IMPL/DOM/Schema/AnyNode.pm	Wed Sep 30 17:43:52 2009 +0400
+++ b/Lib/IMPL/DOM/Schema/AnyNode.pm	Mon Oct 05 00:48:49 2009 +0400
@@ -5,7 +5,13 @@
 use base qw(IMPL::DOM::Schema::Node);
 
 our %CTOR = (
-    'IMPL::DOM::Schema::Node' => sub { nodeName => 'AnyNode', name=> 'AnyNode'}
+    'IMPL::DOM::Schema::Node' => sub {
+        my %args = @_;
+        $args{nodeName} ||= 'AnyNode';
+        $args{name} = '::any';
+        
+        %args;
+    }
 );
 
 1;
@@ -17,9 +23,20 @@
 =head1 DESCRIPTION
 
    ,      
- .  ,       
-     ,     
-      ,     
- .
+ .
+
+   C<IMPL::DOM::Schema::NodeSet>       
+      C<IMPL::DOM::Schema::SwitchNode>.
+
+   <IMPL::DOM::Schema::NodeList>      
+          .
+
+<NodeList>
+    <SimpleNode name="firstName"/>
+    <SimpleNode name="age"/>
+    <AnyNode type="Notes" minOccur="0" maxOccur="unbounded"/>
+    <Node name="primaryAddress" type="Address"/>
+    <AnyNode/>
+</NodeList>
 
 =cut
\ No newline at end of file
--- a/Lib/IMPL/DOM/Schema/Node.pm	Wed Sep 30 17:43:52 2009 +0400
+++ b/Lib/IMPL/DOM/Schema/Node.pm	Mon Oct 05 00:48:49 2009 +0400
@@ -8,10 +8,10 @@
 use IMPL::Class::Property::Direct;
 
 BEGIN {
-    public property minOccur => prop_all;
-    public property maxOccur => prop_all;
-    public property type => prop_all;
-    public property name => prop_all;
+    public _direct property minOccur => prop_all;
+    public _direct property maxOccur => prop_all;
+    public _direct property type => prop_all;
+    public _direct property name => prop_all;
 }
 
 our %CTOR = (
@@ -21,22 +21,26 @@
 sub CTOR {
     my ($this,%args) = @_;
     
-    $this->minOccur(defined $args{minOccur} ? $args{minOccur} : 1);
-    $this->maxOccur(defined $args{maxOccur} ? $args{maxOccur} : 1);
-    $this->type($args{type});
-    $this->name($args{name}) or die new IMPL::InvalidArgumentException('Argument is required','name');
+    $this->{$minOccur} = defined $args{minOccur} ? $args{minOccur} : 1;
+    $this->{$maxOccur} = defined $args{maxOccur} ? $args{maxOccur} : 1;
+    $this->{$type} = $args{type};
+    $this->{$name} = $args{name} or die new IMPL::InvalidArgumentException('Argument is required','name');
 }
 
 sub Validate {
     my ($this,$node) = @_;
     
-    if (my $schemaType = $this->type ? $this->rootNode->resolveType($this->type) : undef ) {
+    if (my $schemaType = $this->{$type} ? $this->rootNode->resolveType($this->{$type}) : undef ) {
         return $schemaType->Validate($node);
     } else {
         return ();
     }
 }
 
+sub qname {
+    $_[0]->nodeName.'[name='.$_[0]->{$name}.']';
+}
+
 1;
 
 __END__
--- a/Lib/IMPL/DOM/Schema/NodeList.pm	Wed Sep 30 17:43:52 2009 +0400
+++ b/Lib/IMPL/DOM/Schema/NodeList.pm	Mon Oct 05 00:48:49 2009 +0400
@@ -18,15 +18,15 @@
 sub CTOR {
     my ($this,%args) = @_;
     
-    $this->messageUnexpected($args{messageUnexpected} || 'A %Node.nodeName% isn\'t allowed here');
-    $this->messageNodesRequired($args{messageNodesRequired} || 'A content of the node %Node.nodeName% is incomplete');
+    $this->messageUnexpected($args{messageUnexpected} || 'A %Node.nodeName% isn\'t allowed in %Node.parentNode.path%');
+    $this->messageNodesRequired($args{messageNodesRequired} || 'A %Schema.name% is required in the node %Node.path%');
 }
 
 sub Validate {
     my ($this,$node) = @_;
     
     my @nodes = map {
-        {nodeName => $_->name, anyNode => $_->isa('IMPL::DOM::Schema::AnyNode') , Schema => $_, Min => $_->minOccur eq 'unbounded' ? undef : $_->maxOccur, Max => $_->maxOccur, Seen => 0 }
+        {nodeName => $_->name, anyNode => $_->isa('IMPL::DOM::Schema::AnyNode') , Schema => $_, Max => $_->maxOccur eq 'unbounded' ? undef : $_->maxOccur, Min => $_->minOccur, Seen => 0 }
     } @{$this->childNodes};
     
     my $info = shift @nodes;
@@ -35,7 +35,7 @@
         #skip schema elements
         while ($info and not $info->{anyNode} and $info->{nodeName} ne $child->nodeName) {
             # if possible of course :)
-            return new IMPL::DOM::Schema::VaidationError (
+            return new IMPL::DOM::Schema::ValidationError (
                 Message => $this->messageUnexpected,
                 Node => $child,
                 Schema => $info->{Schema},
@@ -46,40 +46,48 @@
         }
         
         # return error if no more children allowed
-        return new IMPL::DOM::Schema::VaidationError (
+        return new IMPL::DOM::Schema::ValidationError (
             Message => $this->messageUnexpected,
             Node => $child,
             Source => $this
         ) unless $info;
         
-        # it's ok, we found schema element for him
+        # it's ok, we found schema element for child
+        # but it may be any node or switching node wich would not satisfy current child
+
+        # validate
+        while (my @errors = $info->{Schema}->Validate($child)) {
+            if( $info->{anyNode} and $info->{Seen} >= $info->{Min} ) {
+                # in case of any or switch node, skip it if possible
+                next if $info = shift @nodes;
+            }
+            return @errors;
+        }
+        
         $info->{Seen}++;
         
         # check count limits
-        return new IMPL::DOM::Schema::VaidationError (
+        return new IMPL::DOM::Schema::ValidationError (
             Error => 1,
             Message => $this->messageUnexpected,
             Node => $child,
             Source => $this,
         ) if $info->{Max} and $info->{Seen} > $info->{Max};
-        
-        # validate
-        if (my @errors = $info->{Schema}->Validate($child)) {
-            return @errors;
-        }
     }
     
     # no more children left (but may be should :)
     while ($info) {
-        return new IMPL::DOM::Schema::VaidationError (
+        return new IMPL::DOM::Schema::ValidationError (
             Error => 1,
             Message => $this->messageNodesRequired,
             Node => $node,
-            Source => $this
+            Source => $this,
+            Schema => $info->{Schema}
         ) if $info->{Seen} < $info->{Min};
         
         $info = shift @nodes;
     }
+    return;
 }
 
 1;
--- a/Lib/IMPL/DOM/Schema/NodeSet.pm	Wed Sep 30 17:43:52 2009 +0400
+++ b/Lib/IMPL/DOM/Schema/NodeSet.pm	Mon Oct 05 00:48:49 2009 +0400
@@ -20,7 +20,7 @@
     
     $this->messageMax( $args{messageMax} || 'Too many %Node.nodeName% nodes');
     $this->messageMin( $args{messageMin} || '%Schema.name% nodes expected');
-    $this->messageUnexpected( $args{messageUnexpected} || 'A %Node.nodeName% isn\'t allowed here');
+    $this->messageUnexpected( $args{messageUnexpected} || 'A %Node.nodeName% isn\'t allowed in %Node.parentNode.path%');
 }
 
 sub Validate {
@@ -41,7 +41,7 @@
     foreach my $child ( @{$node->childNodes} ) {
         if (my $info = $nodes{$child->nodeName} || $anyNode) {
             $info->{Seen}++;
-            push @errors,new IMPL::DOM::Schema::VaidationError (
+            push @errors,new IMPL::DOM::Schema::ValidationError (
                 Source => $this,
                 Node => $child,
                 Schema => $info->{Schema},
@@ -52,7 +52,7 @@
                 push @errors,@localErrors;
             }
         } else {
-            push @errors, new IMPL::DOM::Schema::VaidationError (
+            push @errors, new IMPL::DOM::Schema::ValidationError (
                 Source => $this,
                 Node => $child,
                 Schema => $info->{Schema},
@@ -62,7 +62,7 @@
     }
     
     foreach my $info (values %nodes) {
-        push @errors, new IMPL::DOM::Schema::VaidationError (
+        push @errors, new IMPL::DOM::Schema::ValidationError (
             Source => $this,
             Schema => $info->{Schema},
             Node => $node,
--- a/Lib/IMPL/DOM/Schema/Property.pm	Wed Sep 30 17:43:52 2009 +0400
+++ b/Lib/IMPL/DOM/Schema/Property.pm	Mon Oct 05 00:48:49 2009 +0400
@@ -13,8 +13,8 @@
     public property RequiredMessage => prop_all;
 }
 
-our %CTOR = {
-    'IMPL::DOM::Schema::SimleNode' => sub {
+our %CTOR = (
+    'IMPL::DOM::Schema::SimpleNode' => sub {
         my %args = @_;
         
         $args{maxOccur} = 1;
@@ -23,7 +23,7 @@
         
         return %args;
     }
-};
+);
 
 sub CTOR {
     my ($this,%args) = @_;
@@ -39,7 +39,7 @@
         my $nodeProp = new IMPL::DOM::Node(nodeName => '::property', nodeValue => $node->$prop() || $node->nodePropety($prop));
         
         if (! $nodeProp->nodeValue) {
-            return new IMPL::DOM::Schema::VaidationError(
+            return new IMPL::DOM::Schema::ValidationError(
                 Message => 
             );
         }
--- /dev/null	Thu Jan 01 00:00:00 1970 +0000
+++ b/Lib/IMPL/DOM/Schema/SwitchNode.pm	Mon Oct 05 00:48:49 2009 +0400
@@ -0,0 +1,54 @@
+package IMPL::DOM::Schema::SwitchNode;
+use strict;
+use warnings;
+
+use base qw(IMPL::DOM::Schema::AnyNode);
+use IMPL::Class::Property;
+require IMPL::DOM::Schema::ValidationError;
+
+our %CTOR = (
+    'IMPL::DOM::Schema::AnyNode' => sub {
+        my %args = @_;
+        
+        $args{nodeName} ||= 'SwitchNode';
+        
+        %args;
+    }
+);
+
+BEGIN {
+    public property messageNoMatch => prop_all;
+}
+
+sub CTOR {
+    my ($this,%args) = @_;
+    
+    $this->messageNoMatch($args{messageNoMatch} || 'A node %Node.nodeName% isn\'t expected in the %Node.parentNode.path%');
+}
+
+sub Validate {
+    my ($this,$node) = @_;
+    
+    if ( my ($schema) = $this->selectNodes(sub {$_[0]->name eq $node->nodeName} ) ) {
+        return $schema->Validate($node);
+    } else {
+        return new IMPL::DOM::Schema::ValidationError(
+            Node => $node,
+            Source => $this,
+            Message => $this->messageNoMatch
+        );
+    }
+}
+
+1;
+
+__END__
+
+=pod
+
+=head1 DESCRIPTION
+
+ ,      ,    .
+    C<IMPL::DOM::Schema::AnyNode>.
+
+=cut
--- a/Lib/IMPL/DOM/Schema/ValidationError.pm	Wed Sep 30 17:43:52 2009 +0400
+++ b/Lib/IMPL/DOM/Schema/ValidationError.pm	Mon Oct 05 00:48:49 2009 +0400
@@ -1,4 +1,4 @@
-package IMPL::DOM::Schema::VaidationError;
+package IMPL::DOM::Schema::ValidationError;
 use strict;
 use warnings;
 
--- a/Lib/IMPL/Object/Abstract.pm	Wed Sep 30 17:43:52 2009 +0400
+++ b/Lib/IMPL/Object/Abstract.pm	Mon Oct 05 00:48:49 2009 +0400
@@ -80,6 +80,10 @@
     @_;
 }
 
+sub PassArgs {
+    \&_pass_throgh_mapper;
+}
+
 sub PassThroughArgs {
     my $class = shift;
     $class = ref $class || $class;
--- a/_test/Test/DOM/Navigator.pm	Wed Sep 30 17:43:52 2009 +0400
+++ b/_test/Test/DOM/Navigator.pm	Mon Oct 05 00:48:49 2009 +0400
@@ -5,7 +5,39 @@
 
 use IMPL::Test qw(test failed);
 use IMPL::DOM::Navigator;
+use IMPL::DOM::Navigator::SchemaNavigator;
 use IMPL::DOM::Node;
+use IMPL::DOM::Schema;
+use IMPL::Class::Property;
+
+BEGIN {
+    public property doc => prop_all;
+}
+
+sub CTOR {
+    my ($this) = @_;
+    
+    $this->doc(
+        IMPL::DOM::Node->new(nodeName => 'root')->appendRange(
+            IMPL::DOM::Node->new(nodeName=> 'age', nodeValue => 21),
+            IMPL::DOM::Node->new(nodeName=> 'address')->appendRange(
+                IMPL::DOM::Node->new(nodeName=>'city', nodeValue=>'moscow'),
+                IMPL::DOM::Node->new(nodeName=>'street', nodeValue=>'main'),
+                IMPL::DOM::Node->new(nodeName=>'phone',nodeValue=>'123-456'),
+            ),
+            IMPL::DOM::Node->new(nodeName=> 'address')->appendRange(
+                IMPL::DOM::Node->new(nodeName=>'city', nodeValue=>'San Francisco'),
+                IMPL::DOM::Node->new(nodeName=>'street', nodeValue=>'Libertador'),
+            ),
+            IMPL::DOM::Node->new(nodeName=> 'contacts')->appendRange(
+                IMPL::DOM::Node->new(nodeName=>'phone',nodeValue=>'123-123'),
+                IMPL::DOM::Node->new(nodeName=>'phone',nodeValue=>'1-233-434-34-54'),
+                IMPL::DOM::Node->new(nodeName=>'email',nodeValue=>'some@mail.none')
+            )
+            
+        )
+    );
+}
 
 test Creation => sub {
     my ($this) = @_;
@@ -64,8 +96,66 @@
     failed ("Current node has a wrong value","Current: $curr","Expected: $doc") if $doc != $curr;
 };
 
+test selectNodes1 => sub {
+    my ($this) = @_;
+    
+    my $navi = new IMPL::DOM::Navigator($this->doc);
+    my @result = $navi->selectNodes('contacts','phone');
+    failed "Expected to get two entries, but got:",map($_->nodeName,@result) unless @result == 2;
+};
 
+test selectNodes2 => sub {
+    my ($this) = @_;
+    
+    my $navi = new IMPL::DOM::Navigator($this->doc);
+    my @result = $navi->selectNodes(undef,'phone');
+    failed "Expected to get three entries, but got:",map($_->nodeName,@result) unless @result == 3;
+};
 
+test FetchDoeachState => sub {
+    my ($this) = @_;
+    
+    my $navi = new IMPL::DOM::Navigator($this->doc);
+    
+    $navi->Navigate(undef,'phone');
+    
+    $navi->saveState();
+    
+    my @result;
+    doeach $navi sub {
+        push @result,$_;
+    };
+    
+    failed "Expected to get three nodes, but got: ", map($_->nodeName,@result) unless @result == 3;
+    
+    $navi->restoreState();
+    @result = ();
+    
+    push @result, $_ while fetch $navi;
+    
+    failed "Expected to get three nodes, but got: ", map($_->nodeName,@result) unless @result == 3;
+};
+
+test NavigateSchema => sub {
+    my $navi = new IMPL::DOM::Navigator::SchemaNavigator(IMPL::DOM::Schema->MetaSchema);
+    
+    my $root = $navi->NavigateName('schema') or failed "Failed to navigate to the root element";
+    
+    $navi->saveState;
+    $navi->NavigateName('Node') or failed "Failed to navigate to a simple node";
+    $navi->restoreState;
+    
+    failed "Can't navigate from simple node" if $navi->NavigateName('Property');
+    
+    $navi->NavigateName('ComplexType') or failed "Failed to navigate to a complex node";
+    $navi->NavigateName('NodeSet') or failed "Failed to navigate to NodeSet";
+    $navi->SchemaBack();
+    $navi->NavigateName('NodeList') or failed "Failed to navigate to NodeList";
+    $navi->NavigateName('SimpleNode') or failed "Failed to navigate to SimpleNode";
+    $navi->NavigateName('Enum') or failed "Failed to navigate to Enum";
+    $navi->NavigateName('Item') or failed "Failed to navigate to Item";
+    
+};
 
 
 1;
--- a/_test/Test/DOM/Node.pm	Wed Sep 30 17:43:52 2009 +0400
+++ b/_test/Test/DOM/Node.pm	Mon Oct 05 00:48:49 2009 +0400
@@ -86,7 +86,7 @@
 test SelectNodesByQuery => sub {
     my ($this) = @_;
     
-    my @result = $this->Root->selectNodes(sub { $_[0]->nodeName =~ /child/i } );
+    my @result = $this->Root->selectNodes(sub { $_->nodeName =~ /child/i } );
     failed
         "Wrong number of a selected nodes",
         "Expected: 2",
--- a/_test/Test/DOM/Schema.pm	Wed Sep 30 17:43:52 2009 +0400
+++ b/_test/Test/DOM/Schema.pm	Mon Oct 05 00:48:49 2009 +0400
@@ -3,12 +3,17 @@
 use warnings;
 
 use base qw(IMPL::Test::Unit);
-use IMPL::Test qw(test failed);
+use IMPL::Test qw(test failed shared);
+use IMPL::Class::Property;
 
 __PACKAGE__->PassThroughArgs;
 
 require IMPL::DOM::Schema;
 
+BEGIN {
+    shared public property SampleSchema => prop_all;
+}
+
 test GetMetaSchema => sub {
     my $metaSchema = IMPL::DOM::Schema->MetaSchema();
 };
@@ -21,4 +26,79 @@
     }
 };
 
+test VerifyCorrectSchema => sub {
+    my ($this) = @_;
+    my $metaSchema = IMPL::DOM::Schema->MetaSchema();
+    
+    my $schema = new IMPL::DOM::Schema;
+    $schema->appendRange(
+        IMPL::DOM::Schema::ComplexNode->new( name => 'personInfo' )->appendRange(
+            IMPL::DOM::Schema::NodeSet->new()->appendRange(
+                new IMPL::DOM::Schema::SimpleNode( name => 'firstName' ),
+                new IMPL::DOM::Schema::SimpleNode( name => 'lastName' ),
+                new IMPL::DOM::Schema::ComplexNode( name => 'address' )->appendRange(
+                    IMPL::DOM::Schema::NodeSet->new()->appendRange(
+                        new IMPL::DOM::Schema::SimpleNode( name => 'street' ),
+                        new IMPL::DOM::Schema::SimpleNode( name => 'line', minOccur => 0 )
+                    )
+                )
+            )
+        )
+    );
+    
+    $this->SampleSchema($schema);
+    
+    my @errors = $metaSchema->Validate($schema);
+    failed "Failed to validate a wellformed schema", map $_->Message, @errors if @errors;
+};
+
+test VerifyWrongSchema => sub {
+    my $metaSchema = IMPL::DOM::Schema->MetaSchema();
+    
+    my $schema = new IMPL::DOM::Schema;
+    $schema->appendRange(
+        IMPL::DOM::Schema::ComplexNode->new( name => 'personInfo' )->appendRange(
+            new IMPL::DOM::Schema::ComplexType( type => 'someType' ),
+            new IMPL::DOM::Schema::SimpleNode( name => 'lastName' ),
+            new IMPL::DOM::Schema::ComplexNode( name => 'address' )->appendRange(
+                new IMPL::DOM::Schema::SimpleNode( name => 'street' ),
+                new IMPL::DOM::Schema::SimpleNode( name => 'line' )
+            )
+        )
+    );
+    
+    my @errors = $metaSchema->Validate($schema);
+    failed "A not wellformed schema validated correctly" unless @errors;
+};
+
+test ValidateCorrectData => sub {
+    my ($this) = @_;
+    
+    my $data = IMPL::DOM::Node->new(nodeName => 'personInfo')->appendRange(
+        IMPL::DOM::Node->new(nodeName => 'firstName', nodeValue => 'John'),
+        IMPL::DOM::Node->new(nodeName => 'lastName', nodeValue => 'Smith'),
+        IMPL::DOM::Node->new(nodeName => 'address')->appendRange(
+            IMPL::DOM::Node->new(nodeName => 'street', nodeValue => 'main road')
+        )
+    );
+    
+    if (my @errors = $this->SampleSchema->Validate($data)) {
+        failed "Failed to validate a correct data", map $_->Message , @errors;
+    }
+};
+
+test ValidateWrongData => sub {
+    my ($this) = @_;
+    
+    my $data = IMPL::DOM::Node->new(nodeName => 'personInfo')->appendRange(
+        IMPL::DOM::Node->new(nodeName => 'firstName', nodeValue => 'John'),
+        IMPL::DOM::Node->new(nodeName => 'address')->appendRange(
+            IMPL::DOM::Node->new(nodeName => 'street', nodeValue => 'main road')
+        )
+    );
+    
+    failed "A wrong data validated corretly" unless $this->SampleSchema->Validate($data);
+};
+
+
 1;