|
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;
|
|
|
17 public property prefix => prop_all;
|
|
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
|
|
|
94 (ref $this ? $this : $this->instance)->prefix($prefix);
|
|
|
95 }
|
|
|
96
|
|
28
|
97 1;
|
|
|
98
|
|
|
99 __END__
|
|
|
100
|
|
|
101 =pod
|
|
|
102
|
|
|
103 =head1 DESCRIPTION
|
|
|
104
|
|
|
105 Схема данных, представляет собой DOM документ, элементами которой
|
|
|
106 являются сущности.
|
|
|
107
|
|
|
108 Каждый узел - это описание сущности.
|
|
|
109
|
|
|
110 =cut |
