Mercurial > pub > Impl
annotate Lib/IMPL/ORM/Schema.pm @ 38:d660fb38b7cc
small fixes
ORM shema to SQL schema transformation
| author | Sergey |
|---|---|
| date | Mon, 23 Nov 2009 17:57:07 +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; |
| 38 | 8 require IMPL::ORM::Schema::ValueType; |
| 30 | 9 |
| 10 our %CTOR = ( | |
| 38 | 11 'IMPL::DOM::Document' => sub { nodeName => 'ORMSchema' } |
| 30 | 12 ); |
| 28 | 13 |
| 14 BEGIN { | |
| 38 | 15 private property mapValueTypes => prop_all; |
| 16 private property mapReferenceTypes => prop_all; | |
| 17 private property mapPending => prop_all; | |
|
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 | |
| 38 | 49 $this->appendChild($entity); |
| 50 | |
| 30 | 51 $this->mapPending->{$typeName} = $entity; |
| 52 | |
| 53 return $this->mapReferenceTypes->{$typeName} = $entity; | |
| 54 } | |
| 55 | |
| 56 sub _addReferenceType { | |
| 57 my ($this,$className) = @_; | |
| 58 | |
| 38 | 59 $this->mapReferenceTypes->{$className} = $className->ormGetSchema($this,delete $this->mapPending->{$className} || $this->appendChild(new IMPL::ORM::Schema::Entity($className))); |
| 30 | 60 } |
| 61 | |
| 28 | 62 # returns valuetype name |
| 63 sub isValueType { | |
| 64 my ($this,$typeName) = @_; | |
| 65 | |
| 66 $this = ref $this ? $this : $this->instance; | |
| 67 | |
| 68 return $this->mapValueTypes->{$typeName}; | |
| 69 } | |
| 70 | |
| 38 | 71 sub ReferenceTypes { |
| 72 my ($this) = @_; | |
| 73 | |
| 74 values %{$this->mapReferenceTypes}; | |
| 75 } | |
| 76 | |
| 28 | 77 my %instances; |
| 78 sub instance { | |
| 79 my ($class) = @_; | |
| 80 | |
| 81 return ($instances{$class} || ($instances{$class} = $class->new)); | |
| 82 } | |
| 83 | |
| 30 | 84 sub ValueTypes { |
| 85 my ($this,%classes) = @_; | |
| 86 | |
| 87 $this = ref $this ? $this : $this->instance; | |
| 88 | |
| 38 | 89 $this->mapValueTypes->{$_} = $this->appendChild( |
| 90 IMPL::ORM::Schema::ValueType->new( | |
| 91 name => $_, | |
| 92 mapper => $classes{$_} | |
| 93 ) | |
| 94 ) foreach keys %classes; | |
| 30 | 95 } |
| 96 | |
| 97 sub Classes { | |
| 98 my ($this,@classNames) = @_; | |
| 99 | |
| 100 $this = ref $this ? $this : $this->instance; | |
| 101 | |
| 102 $this->_addReferenceType($this->prefix . $_) foreach @classNames; | |
| 103 } | |
| 104 | |
| 105 sub usePrefix { | |
| 106 my ($this,$prefix) = @_; | |
| 107 | |
|
31
d59526f6310e
Small fixes to Test framework (correct handlinf of the compilation errors in the test units)
Sergey
parents:
30
diff
changeset
|
108 $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
|
109 |
| 30 | 110 (ref $this ? $this : $this->instance)->prefix($prefix); |
| 111 } | |
| 112 | |
|
31
d59526f6310e
Small fixes to Test framework (correct handlinf of the compilation errors in the test units)
Sergey
parents:
30
diff
changeset
|
113 sub CompleteSchema { |
|
d59526f6310e
Small fixes to Test framework (correct handlinf of the compilation errors in the test units)
Sergey
parents:
30
diff
changeset
|
114 my ($this) = @_; |
|
d59526f6310e
Small fixes to Test framework (correct handlinf of the compilation errors in the test units)
Sergey
parents:
30
diff
changeset
|
115 |
|
d59526f6310e
Small fixes to Test framework (correct handlinf of the compilation errors in the test units)
Sergey
parents:
30
diff
changeset
|
116 $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
|
117 |
|
d59526f6310e
Small fixes to Test framework (correct handlinf of the compilation errors in the test units)
Sergey
parents:
30
diff
changeset
|
118 $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
|
119 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
|
120 } |
|
d59526f6310e
Small fixes to Test framework (correct handlinf of the compilation errors in the test units)
Sergey
parents:
30
diff
changeset
|
121 |
| 28 | 122 1; |
| 123 | |
| 124 __END__ | |
| 125 | |
| 126 =pod | |
| 127 | |
| 128 =head1 DESCRIPTION | |
| 129 | |
| 130 Схема данных, представляет собой DOM документ, элементами которой | |
| 131 являются сущности. | |
| 132 | |
| 133 Каждый узел - это описание сущности. | |
| 134 | |
| 135 =cut |