annotate Lib/IMPL/DOM/Navigator/SchemaNavigator.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 7f00786f8210
children a8086f85a571
Ignore whitespace changes - Everywhere: Within whitespace: At end of lines:
rev   line source
18
818c74b038ae DOM Schema + tests
Sergey
parents:
diff changeset
1 package IMPL::DOM::Navigator::SchemaNavigator;
818c74b038ae DOM Schema + tests
Sergey
parents:
diff changeset
2 use strict;
818c74b038ae DOM Schema + tests
Sergey
parents:
diff changeset
3 use warnings;
818c74b038ae DOM Schema + tests
Sergey
parents:
diff changeset
4
818c74b038ae DOM Schema + tests
Sergey
parents:
diff changeset
5 use base qw(IMPL::DOM::Navigator);
818c74b038ae DOM Schema + tests
Sergey
parents:
diff changeset
6 use IMPL::Class::Property;
818c74b038ae DOM Schema + tests
Sergey
parents:
diff changeset
7 use IMPL::Class::Property::Direct;
818c74b038ae DOM Schema + tests
Sergey
parents:
diff changeset
8
24
7f00786f8210 Первая рабочая реазизация схемы и навигаторов
Sergey
parents: 18
diff changeset
9 require IMPL::DOM::Schema::ComplexType;
7f00786f8210 Первая рабочая реазизация схемы и навигаторов
Sergey
parents: 18
diff changeset
10 require IMPL::DOM::Schema::NodeSet;
7f00786f8210 Первая рабочая реазизация схемы и навигаторов
Sergey
parents: 18
diff changeset
11 require IMPL::DOM::Schema::AnyNode;
7f00786f8210 Первая рабочая реазизация схемы и навигаторов
Sergey
parents: 18
diff changeset
12
18
818c74b038ae DOM Schema + tests
Sergey
parents:
diff changeset
13 __PACKAGE__->PassThroughArgs;
818c74b038ae DOM Schema + tests
Sergey
parents:
diff changeset
14
818c74b038ae DOM Schema + tests
Sergey
parents:
diff changeset
15 BEGIN {
818c74b038ae DOM Schema + tests
Sergey
parents:
diff changeset
16 public _direct property Schema => prop_get;
24
7f00786f8210 Первая рабочая реазизация схемы и навигаторов
Sergey
parents: 18
diff changeset
17 private _direct property _historySteps => prop_all;
18
818c74b038ae DOM Schema + tests
Sergey
parents:
diff changeset
18 }
818c74b038ae DOM Schema + tests
Sergey
parents:
diff changeset
19
818c74b038ae DOM Schema + tests
Sergey
parents:
diff changeset
20 sub CTOR {
818c74b038ae DOM Schema + tests
Sergey
parents:
diff changeset
21 my ($this,$schema) = @_;
818c74b038ae DOM Schema + tests
Sergey
parents:
diff changeset
22
818c74b038ae DOM Schema + tests
Sergey
parents:
diff changeset
23 $this->{$Schema} = $schema;
818c74b038ae DOM Schema + tests
Sergey
parents:
diff changeset
24
818c74b038ae DOM Schema + tests
Sergey
parents:
diff changeset
25 die new IMPL::InvalidArgumentException("A schema object is required") unless $schema->isa('IMPL::DOM::Schema');
818c74b038ae DOM Schema + tests
Sergey
parents:
diff changeset
26 }
818c74b038ae DOM Schema + tests
Sergey
parents:
diff changeset
27
24
7f00786f8210 Первая рабочая реазизация схемы и навигаторов
Sergey
parents: 18
diff changeset
28 my $schemaAnyNode = IMPL::DOM::Schema::ComplexType->new(type => '::AnyNodeType', nativeType => 'IMPL::DOM::ComplexNode')->appendRange(
7f00786f8210 Первая рабочая реазизация схемы и навигаторов
Sergey
parents: 18
diff changeset
29 IMPL::DOM::Schema::NodeSet->new()->appendRange(
7f00786f8210 Первая рабочая реазизация схемы и навигаторов
Sergey
parents: 18
diff changeset
30 IMPL::DOM::Schema::AnyNode->new()
7f00786f8210 Первая рабочая реазизация схемы и навигаторов
Sergey
parents: 18
diff changeset
31 )
7f00786f8210 Первая рабочая реазизация схемы и навигаторов
Sergey
parents: 18
diff changeset
32 );
7f00786f8210 Первая рабочая реазизация схемы и навигаторов
Sergey
parents: 18
diff changeset
33
7f00786f8210 Первая рабочая реазизация схемы и навигаторов
Sergey
parents: 18
diff changeset
34 sub NavigateName {
7f00786f8210 Первая рабочая реазизация схемы и навигаторов
Sergey
parents: 18
diff changeset
35 my ($this,$name) = @_;
18
818c74b038ae DOM Schema + tests
Sergey
parents:
diff changeset
36
24
7f00786f8210 Первая рабочая реазизация схемы и навигаторов
Sergey
parents: 18
diff changeset
37 # perform a safe navigation
7f00786f8210 Первая рабочая реазизация схемы и навигаторов
Sergey
parents: 18
diff changeset
38 return dosafe $this sub {
7f00786f8210 Первая рабочая реазизация схемы и навигаторов
Sergey
parents: 18
diff changeset
39 my $steps = 1;
7f00786f8210 Первая рабочая реазизация схемы и навигаторов
Sergey
parents: 18
diff changeset
40 # navigate to node
7f00786f8210 Первая рабочая реазизация схемы и навигаторов
Sergey
parents: 18
diff changeset
41 if (
7f00786f8210 Первая рабочая реазизация схемы и навигаторов
Sergey
parents: 18
diff changeset
42 my $node = $this->Navigate( sub {
7f00786f8210 Первая рабочая реазизация схемы и навигаторов
Sergey
parents: 18
diff changeset
43 $_->isa('IMPL::DOM::Schema::Node') and (
7f00786f8210 Первая рабочая реазизация схемы и навигаторов
Sergey
parents: 18
diff changeset
44 $_->name eq $name
7f00786f8210 Первая рабочая реазизация схемы и навигаторов
Sergey
parents: 18
diff changeset
45 or
7f00786f8210 Первая рабочая реазизация схемы и навигаторов
Sergey
parents: 18
diff changeset
46 $_->nodeName eq 'AnyNode'
7f00786f8210 Первая рабочая реазизация схемы и навигаторов
Sergey
parents: 18
diff changeset
47 or
7f00786f8210 Первая рабочая реазизация схемы и навигаторов
Sergey
parents: 18
diff changeset
48 ( $_->nodeName eq 'SwitchNode' and $_->selectNodes( sub { $_->name eq $name } ) )
7f00786f8210 Первая рабочая реазизация схемы и навигаторов
Sergey
parents: 18
diff changeset
49 )
7f00786f8210 Первая рабочая реазизация схемы и навигаторов
Sergey
parents: 18
diff changeset
50 })
7f00786f8210 Первая рабочая реазизация схемы и навигаторов
Sergey
parents: 18
diff changeset
51 ) {
7f00786f8210 Первая рабочая реазизация схемы и навигаторов
Sergey
parents: 18
diff changeset
52 if ($node->nodeName eq 'AnyNode') {
7f00786f8210 Первая рабочая реазизация схемы и навигаторов
Sergey
parents: 18
diff changeset
53 # if we navigate to the anynode
7f00786f8210 Первая рабочая реазизация схемы и навигаторов
Sergey
parents: 18
diff changeset
54 # assume it to be ComplexType by default
7f00786f8210 Первая рабочая реазизация схемы и навигаторов
Sergey
parents: 18
diff changeset
55 $node = $node->type ? $this->{$Schema}->resolveType($node->type) : $schemaAnyNode;
7f00786f8210 Первая рабочая реазизация схемы и навигаторов
Sergey
parents: 18
diff changeset
56 } elsif ($node->nodeName eq 'SwitchNode') {
7f00786f8210 Первая рабочая реазизация схемы и навигаторов
Sergey
parents: 18
diff changeset
57 # if we are in the switchnode
7f00786f8210 Первая рабочая реазизация схемы и навигаторов
Sergey
parents: 18
diff changeset
58 # navigate to the target node
7f00786f8210 Первая рабочая реазизация схемы и навигаторов
Sergey
parents: 18
diff changeset
59 $node = $this->Navigate(sub { $_->name eq $name });
7f00786f8210 Первая рабочая реазизация схемы и навигаторов
Sergey
parents: 18
diff changeset
60 $steps ++;
7f00786f8210 Первая рабочая реазизация схемы и навигаторов
Sergey
parents: 18
diff changeset
61 }
7f00786f8210 Первая рабочая реазизация схемы и навигаторов
Sergey
parents: 18
diff changeset
62
7f00786f8210 Первая рабочая реазизация схемы и навигаторов
Sergey
parents: 18
diff changeset
63 if ($node->nodeName eq 'Node') {
7f00786f8210 Первая рабочая реазизация схемы и навигаторов
Sergey
parents: 18
diff changeset
64 # if we navigate to a reference
7f00786f8210 Первая рабочая реазизация схемы и навигаторов
Sergey
parents: 18
diff changeset
65 # resolve it
7f00786f8210 Первая рабочая реазизация схемы и навигаторов
Sergey
parents: 18
diff changeset
66 $node = $this->{$Schema}->resolveType($node->type);
7f00786f8210 Первая рабочая реазизация схемы и навигаторов
Sergey
parents: 18
diff changeset
67 $this->internalNavigateNodeSet($node);
7f00786f8210 Первая рабочая реазизация схемы и навигаторов
Sergey
parents: 18
diff changeset
68 $steps++;
7f00786f8210 Первая рабочая реазизация схемы и навигаторов
Sergey
parents: 18
diff changeset
69 }
7f00786f8210 Первая рабочая реазизация схемы и навигаторов
Sergey
parents: 18
diff changeset
70
7f00786f8210 Первая рабочая реазизация схемы и навигаторов
Sergey
parents: 18
diff changeset
71 # if target node is a complex node
7f00786f8210 Первая рабочая реазизация схемы и навигаторов
Sergey
parents: 18
diff changeset
72 if ($node->isa('IMPL::DOM::Schema::ComplexNode')) {
7f00786f8210 Первая рабочая реазизация схемы и навигаторов
Sergey
parents: 18
diff changeset
73 # navigate to it's content
7f00786f8210 Первая рабочая реазизация схемы и навигаторов
Sergey
parents: 18
diff changeset
74 $this->internalNavigateNodeSet($node->content);
7f00786f8210 Первая рабочая реазизация схемы и навигаторов
Sergey
parents: 18
diff changeset
75 $steps ++;
7f00786f8210 Первая рабочая реазизация схемы и навигаторов
Sergey
parents: 18
diff changeset
76 }
7f00786f8210 Первая рабочая реазизация схемы и навигаторов
Sergey
parents: 18
diff changeset
77
7f00786f8210 Первая рабочая реазизация схемы и навигаторов
Sergey
parents: 18
diff changeset
78 push @{$this->{$_historySteps}},$steps;
7f00786f8210 Первая рабочая реазизация схемы и навигаторов
Sergey
parents: 18
diff changeset
79
7f00786f8210 Первая рабочая реазизация схемы и навигаторов
Sergey
parents: 18
diff changeset
80 # return found node schema
7f00786f8210 Первая рабочая реазизация схемы и навигаторов
Sergey
parents: 18
diff changeset
81 return $node;
7f00786f8210 Первая рабочая реазизация схемы и навигаторов
Sergey
parents: 18
diff changeset
82 } else {
7f00786f8210 Первая рабочая реазизация схемы и навигаторов
Sergey
parents: 18
diff changeset
83 die; # abort navigation
18
818c74b038ae DOM Schema + tests
Sergey
parents:
diff changeset
84 }
818c74b038ae DOM Schema + tests
Sergey
parents:
diff changeset
85 }
818c74b038ae DOM Schema + tests
Sergey
parents:
diff changeset
86 }
818c74b038ae DOM Schema + tests
Sergey
parents:
diff changeset
87
24
7f00786f8210 Первая рабочая реазизация схемы и навигаторов
Sergey
parents: 18
diff changeset
88 sub SchemaBack {
7f00786f8210 Первая рабочая реазизация схемы и навигаторов
Sergey
parents: 18
diff changeset
89 my ($this) = @_;
7f00786f8210 Первая рабочая реазизация схемы и навигаторов
Sergey
parents: 18
diff changeset
90
7f00786f8210 Первая рабочая реазизация схемы и навигаторов
Sergey
parents: 18
diff changeset
91 $this->Back(pop @{$this->{$_historySteps}}) if $this->{$_historySteps};
7f00786f8210 Первая рабочая реазизация схемы и навигаторов
Sergey
parents: 18
diff changeset
92 }
7f00786f8210 Первая рабочая реазизация схемы и навигаторов
Sergey
parents: 18
diff changeset
93
18
818c74b038ae DOM Schema + tests
Sergey
parents:
diff changeset
94 1;
818c74b038ae DOM Schema + tests
Sergey
parents:
diff changeset
95 __END__
818c74b038ae DOM Schema + tests
Sergey
parents:
diff changeset
96
818c74b038ae DOM Schema + tests
Sergey
parents:
diff changeset
97 =pod
818c74b038ae DOM Schema + tests
Sergey
parents:
diff changeset
98
818c74b038ae DOM Schema + tests
Sergey
parents:
diff changeset
99 =head1 DESCRIPTION
818c74b038ae DOM Schema + tests
Sergey
parents:
diff changeset
100
24
7f00786f8210 Первая рабочая реазизация схемы и навигаторов
Sergey
parents: 18
diff changeset
101 ,
7f00786f8210 Первая рабочая реазизация схемы и навигаторов
Sergey
parents: 18
diff changeset
102 .
7f00786f8210 Первая рабочая реазизация схемы и навигаторов
Sergey
parents: 18
diff changeset
103
7f00786f8210 Первая рабочая реазизация схемы и навигаторов
Sergey
parents: 18
diff changeset
104 =head1 METHODS
7f00786f8210 Первая рабочая реазизация схемы и навигаторов
Sergey
parents: 18
diff changeset
105
7f00786f8210 Первая рабочая реазизация схемы и навигаторов
Sergey
parents: 18
diff changeset
106 =over
7f00786f8210 Первая рабочая реазизация схемы и навигаторов
Sergey
parents: 18
diff changeset
107
7f00786f8210 Первая рабочая реазизация схемы и навигаторов
Sergey
parents: 18
diff changeset
108 =item C<< $navi->NavigateName($name) >>
7f00786f8210 Первая рабочая реазизация схемы и навигаторов
Sergey
parents: 18
diff changeset
109
7f00786f8210 Первая рабочая реазизация схемы и навигаторов
Sergey
parents: 18
diff changeset
110 . C<name>
7f00786f8210 Первая рабочая реазизация схемы и навигаторов
Sergey
parents: 18
diff changeset
111
7f00786f8210 Первая рабочая реазизация схемы и навигаторов
Sergey
parents: 18
diff changeset
112 =item C<< $navi->SchemaBack >>
7f00786f8210 Первая рабочая реазизация схемы и навигаторов
Sergey
parents: 18
diff changeset
113
7f00786f8210 Первая рабочая реазизация схемы и навигаторов
Sergey
parents: 18
diff changeset
114 C<NavigateName>.
7f00786f8210 Первая рабочая реазизация схемы и навигаторов
Sergey
parents: 18
diff changeset
115
7f00786f8210 Первая рабочая реазизация схемы и навигаторов
Sergey
parents: 18
diff changeset
116 .
7f00786f8210 Первая рабочая реазизация схемы и навигаторов
Sergey
parents: 18
diff changeset
117
7f00786f8210 Первая рабочая реазизация схемы и навигаторов
Sergey
parents: 18
diff changeset
118 =back
18
818c74b038ae DOM Schema + tests
Sergey
parents:
diff changeset
119
818c74b038ae DOM Schema + tests
Sergey
parents:
diff changeset
120 =cut