Mercurial > pub > Impl
annotate Lib/IMPL/ORM/Schema.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 | dd4d72600c69 |
| 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 |