Mercurial > pub > Impl
annotate Lib/IMPL/ORM/Schema.pm @ 35:f25d021780b3
DOM::Navigator::Builder working version
author | Sergey |
---|---|
date | Tue, 17 Nov 2009 17:46:24 +0300 |
parents | d59526f6310e |
children | d660fb38b7cc 4ff27cd051e3 |
rev | line source |
---|---|
28 | 1 package IMPL::ORM::Schema; |
2 use strict; | |
3 use warnings; | |
4 | |
5 use base qw(IMPL::DOM::Document); | |
6 use IMPL::Class::Property; | |
30 | 7 require IMPL::ORM::Schema::Entity; |
8 | |
9 our %CTOR = ( | |
10 'IMPL::DOM::Document' => sub { nodeName => 'Schema' } | |
11 ); | |
28 | 12 |
13 BEGIN { | |
14 public property mapValueTypes => prop_get | owner_set; | |
15 public property mapReferenceTypes => prop_get | owner_set; | |
30 | 16 public property mapPending => prop_get | owner_set; |
31
d59526f6310e
Small fixes to Test framework (correct handlinf of the compilation errors in the test units)
Sergey
parents:
30
diff
changeset
|
17 public property prefix => prop_get | owner_set; |
28 | 18 } |
19 | |
20 sub CTOR { | |
21 my ($this ) = @_; | |
22 $this->mapValueTypes({}); | |
23 $this->mapReferenceTypes({}); | |
30 | 24 $this->mapPending({}); |
28 | 25 } |
26 | |
27 # return an entity for the specified typename | |
28 # makes forward declaration if nesessary | |
29 sub resolveType { | |
30 my ($this,$typeName) = @_; | |
31 | |
32 $this = ref $this ? $this : $this->instance; | |
33 | |
34 if (my $entity = $this->mapReferenceTypes->{$typeName}) { | |
35 return $entity; | |
36 } elsif (UNIVERSAL::isa($typeName,'IMPL::ORM::Object')) { | |
37 return $this->declareReferenceType($typeName); | |
38 } else { | |
39 return undef; | |
40 } | |
41 } | |
42 | |
30 | 43 sub declareReferenceType { |
44 my ($this,$typeName) = @_; | |
45 | |
46 my $entity = new IMPL::ORM::Schema::Entity($typeName); | |
47 | |
48 $this->mapPending->{$typeName} = $entity; | |
49 | |
50 return $this->mapReferenceTypes->{$typeName} = $entity; | |
51 } | |
52 | |
53 sub _addReferenceType { | |
54 my ($this,$className) = @_; | |
55 | |
56 $this->mapReferenceTypes->{$className} = $className->ormGetSchema($this,delete $this->mapPending->{$className}); | |
57 } | |
58 | |
28 | 59 # returns valuetype name |
60 sub isValueType { | |
61 my ($this,$typeName) = @_; | |
62 | |
63 $this = ref $this ? $this : $this->instance; | |
64 | |
65 return $this->mapValueTypes->{$typeName}; | |
66 } | |
67 | |
68 my %instances; | |
69 sub instance { | |
70 my ($class) = @_; | |
71 | |
72 return ($instances{$class} || ($instances{$class} = $class->new)); | |
73 } | |
74 | |
30 | 75 sub ValueTypes { |
76 my ($this,%classes) = @_; | |
77 | |
78 $this = ref $this ? $this : $this->instance; | |
79 | |
80 $this->mapValueTypes->{$_} = $classes{$_} foreach keys %classes; | |
81 } | |
82 | |
83 sub Classes { | |
84 my ($this,@classNames) = @_; | |
85 | |
86 $this = ref $this ? $this : $this->instance; | |
87 | |
88 $this->_addReferenceType($this->prefix . $_) foreach @classNames; | |
89 } | |
90 | |
91 sub usePrefix { | |
92 my ($this,$prefix) = @_; | |
93 | |
31
d59526f6310e
Small fixes to Test framework (correct handlinf of the compilation errors in the test units)
Sergey
parents:
30
diff
changeset
|
94 $prefix .= '::' if $prefix and $prefix !~ /::$/; |
d59526f6310e
Small fixes to Test framework (correct handlinf of the compilation errors in the test units)
Sergey
parents:
30
diff
changeset
|
95 |
30 | 96 (ref $this ? $this : $this->instance)->prefix($prefix); |
97 } | |
98 | |
31
d59526f6310e
Small fixes to Test framework (correct handlinf of the compilation errors in the test units)
Sergey
parents:
30
diff
changeset
|
99 sub CompleteSchema { |
d59526f6310e
Small fixes to Test framework (correct handlinf of the compilation errors in the test units)
Sergey
parents:
30
diff
changeset
|
100 my ($this) = @_; |
d59526f6310e
Small fixes to Test framework (correct handlinf of the compilation errors in the test units)
Sergey
parents:
30
diff
changeset
|
101 |
d59526f6310e
Small fixes to Test framework (correct handlinf of the compilation errors in the test units)
Sergey
parents:
30
diff
changeset
|
102 $this = ref $this ? $this : $this->instance; |
d59526f6310e
Small fixes to Test framework (correct handlinf of the compilation errors in the test units)
Sergey
parents:
30
diff
changeset
|
103 |
d59526f6310e
Small fixes to Test framework (correct handlinf of the compilation errors in the test units)
Sergey
parents:
30
diff
changeset
|
104 $this->mapReferenceTypes->{$_} = $_->ormGetSchema($this,delete $this->mapPending->{$_}) |
d59526f6310e
Small fixes to Test framework (correct handlinf of the compilation errors in the test units)
Sergey
parents:
30
diff
changeset
|
105 foreach (keys %{$this->mapPending}); |
d59526f6310e
Small fixes to Test framework (correct handlinf of the compilation errors in the test units)
Sergey
parents:
30
diff
changeset
|
106 } |
d59526f6310e
Small fixes to Test framework (correct handlinf of the compilation errors in the test units)
Sergey
parents:
30
diff
changeset
|
107 |
28 | 108 1; |
109 | |
110 __END__ | |
111 | |
112 =pod | |
113 | |
114 =head1 DESCRIPTION | |
115 | |
116 Схема данных, представляет собой DOM документ, элементами которой | |
117 являются сущности. | |
118 | |
119 Каждый узел - это описание сущности. | |
120 | |
121 =cut |