Mercurial > pub > Impl
annotate Lib/IMPL/ORM/Schema.pm @ 42:4ff27cd051e3
updated ORM schema model
| author | Sergey |
|---|---|
| date | Thu, 07 Jan 2010 15:34:42 +0300 |
| parents | d59526f6310e |
| children | 009aa9ca2e48 |
| 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; |
| 42 | 8 require IMPL::ORM::Schema::ValueType; |
| 30 | 9 |
| 10 our %CTOR = ( | |
| 11 'IMPL::DOM::Document' => sub { nodeName => 'Schema' } | |
| 12 ); | |
| 28 | 13 |
| 14 BEGIN { | |
| 15 public property mapValueTypes => prop_get | owner_set; | |
| 16 public property mapReferenceTypes => prop_get | owner_set; | |
| 30 | 17 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
|
18 public property prefix => prop_get | owner_set; |
| 28 | 19 } |
| 20 | |
| 21 sub CTOR { | |
| 22 my ($this ) = @_; | |
| 23 $this->mapValueTypes({}); | |
| 24 $this->mapReferenceTypes({}); | |
| 30 | 25 $this->mapPending({}); |
| 28 | 26 } |
| 27 | |
| 28 # return an entity for the specified typename | |
| 29 # makes forward declaration if nesessary | |
| 30 sub resolveType { | |
| 31 my ($this,$typeName) = @_; | |
| 32 | |
| 33 $this = ref $this ? $this : $this->instance; | |
| 34 | |
| 35 if (my $entity = $this->mapReferenceTypes->{$typeName}) { | |
| 36 return $entity; | |
| 37 } elsif (UNIVERSAL::isa($typeName,'IMPL::ORM::Object')) { | |
| 38 return $this->declareReferenceType($typeName); | |
| 39 } else { | |
| 40 return undef; | |
| 41 } | |
| 42 } | |
| 43 | |
| 30 | 44 sub declareReferenceType { |
| 45 my ($this,$typeName) = @_; | |
| 46 | |
| 47 my $entity = new IMPL::ORM::Schema::Entity($typeName); | |
| 48 | |
| 49 $this->mapPending->{$typeName} = $entity; | |
| 50 | |
| 42 | 51 $this->appendChild($entity); |
| 52 | |
| 30 | 53 return $this->mapReferenceTypes->{$typeName} = $entity; |
| 54 } | |
| 55 | |
| 56 sub _addReferenceType { | |
| 57 my ($this,$className) = @_; | |
| 58 | |
| 42 | 59 if ( my $entity = delete $this->mapPending->{$className} ) { |
| 60 $className->ormGetSchema($this,$entity); | |
| 61 } else { | |
| 62 return $this->appendChild( $this->mapReferenceTypes->{$className} = $className->ormGetSchema($this) ); | |
| 63 } | |
| 64 | |
| 30 | 65 } |
| 66 | |
| 28 | 67 # returns valuetype name |
| 68 sub isValueType { | |
| 69 my ($this,$typeName) = @_; | |
| 70 | |
| 71 $this = ref $this ? $this : $this->instance; | |
| 72 | |
| 73 return $this->mapValueTypes->{$typeName}; | |
| 74 } | |
| 75 | |
| 76 my %instances; | |
| 77 sub instance { | |
| 78 my ($class) = @_; | |
| 79 | |
| 80 return ($instances{$class} || ($instances{$class} = $class->new)); | |
| 81 } | |
| 82 | |
| 30 | 83 sub ValueTypes { |
| 84 my ($this,%classes) = @_; | |
| 85 | |
| 86 $this = ref $this ? $this : $this->instance; | |
| 87 | |
| 42 | 88 while ( my ($typeName,$typeReflected) = each %classes ) { |
| 89 $this->mapValueTypes->{$typeName} = $typeReflected; | |
| 90 $this->appendChild(IMPL::ORM::Schema::ValueType->new($typeName,$typeReflected)); | |
| 91 } | |
| 30 | 92 } |
| 93 | |
| 94 sub Classes { | |
| 95 my ($this,@classNames) = @_; | |
| 96 | |
| 97 $this = ref $this ? $this : $this->instance; | |
| 98 | |
| 99 $this->_addReferenceType($this->prefix . $_) foreach @classNames; | |
| 100 } | |
| 101 | |
| 102 sub usePrefix { | |
| 103 my ($this,$prefix) = @_; | |
| 104 | |
|
31
d59526f6310e
Small fixes to Test framework (correct handlinf of the compilation errors in the test units)
Sergey
parents:
30
diff
changeset
|
105 $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
|
106 |
| 30 | 107 (ref $this ? $this : $this->instance)->prefix($prefix); |
| 108 } | |
| 109 | |
|
31
d59526f6310e
Small fixes to Test framework (correct handlinf of the compilation errors in the test units)
Sergey
parents:
30
diff
changeset
|
110 sub CompleteSchema { |
|
d59526f6310e
Small fixes to Test framework (correct handlinf of the compilation errors in the test units)
Sergey
parents:
30
diff
changeset
|
111 my ($this) = @_; |
|
d59526f6310e
Small fixes to Test framework (correct handlinf of the compilation errors in the test units)
Sergey
parents:
30
diff
changeset
|
112 |
|
d59526f6310e
Small fixes to Test framework (correct handlinf of the compilation errors in the test units)
Sergey
parents:
30
diff
changeset
|
113 $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
|
114 |
| 42 | 115 $_->ormGetSchema($this,delete $this->mapPending->{$_}) foreach (keys %{$this->mapPending}); |
|
31
d59526f6310e
Small fixes to Test framework (correct handlinf of the compilation errors in the test units)
Sergey
parents:
30
diff
changeset
|
116 } |
|
d59526f6310e
Small fixes to Test framework (correct handlinf of the compilation errors in the test units)
Sergey
parents:
30
diff
changeset
|
117 |
| 28 | 118 1; |
| 119 | |
| 120 __END__ | |
| 121 | |
| 122 =pod | |
| 123 | |
| 124 =head1 DESCRIPTION | |
| 125 | |
| 126 Схема данных, представляет собой DOM документ, элементами которой | |
| 127 являются сущности. | |
| 128 | |
| 129 Каждый узел - это описание сущности. | |
| 130 | |
| 42 | 131 <Schema> |
| 132 <Entity entityName="My_Data_Foo"> | |
| 133 <Field fieldName="Doo" fieldType="String"/> | |
| 134 <HasMany name="Boxes" target="My_Data_Box"/> | |
| 135 </Entity> | |
| 136 <Entity entityName="My_Data_Bar"> | |
| 137 <Subclass base="My_Data_Foo"/> | |
| 138 <Field fieldName="Timestamp" fieldType="Integer"/> | |
| 139 </Entity> | |
| 140 <Entity entityName="My_Data_Box"> | |
| 141 <Field fieldName="Capacity" fieldType="Integer"/> | |
| 142 </Entity> | |
| 143 </Schema> | |
| 144 | |
| 28 | 145 =cut |