annotate Lib/IMPL/ORM/Schema.pm @ 44:32d2350fccf9

ORM *Minor fixes *Working tarnsform to sql *Fixes to the sql traits
author Sergey
date Mon, 11 Jan 2010 01:42:00 +0300
parents 009aa9ca2e48
children 16ada169ca75
Ignore whitespace changes - Everywhere: Within whitespace: At end of lines:
rev   line source
28
6d33f75c6e1f ORM in works
Sergey
parents:
diff changeset
1 package IMPL::ORM::Schema;
6d33f75c6e1f ORM in works
Sergey
parents:
diff changeset
2 use strict;
6d33f75c6e1f ORM in works
Sergey
parents:
diff changeset
3 use warnings;
6d33f75c6e1f ORM in works
Sergey
parents:
diff changeset
4
6d33f75c6e1f ORM in works
Sergey
parents:
diff changeset
5 use base qw(IMPL::DOM::Document);
6d33f75c6e1f ORM in works
Sergey
parents:
diff changeset
6 use IMPL::Class::Property;
30
dd4d72600c69 ORM in works
Sergey
parents: 28
diff changeset
7 require IMPL::ORM::Schema::Entity;
38
d660fb38b7cc small fixes
Sergey
parents: 31
diff changeset
8 require IMPL::ORM::Schema::ValueType;
30
dd4d72600c69 ORM in works
Sergey
parents: 28
diff changeset
9
dd4d72600c69 ORM in works
Sergey
parents: 28
diff changeset
10 our %CTOR = (
44
Sergey
parents: 43
diff changeset
11 'IMPL::DOM::Document' => sub { nodeName => 'ORMSchema' }
30
dd4d72600c69 ORM in works
Sergey
parents: 28
diff changeset
12 );
28
6d33f75c6e1f ORM in works
Sergey
parents:
diff changeset
13
6d33f75c6e1f ORM in works
Sergey
parents:
diff changeset
14 BEGIN {
6d33f75c6e1f ORM in works
Sergey
parents:
diff changeset
15 public property mapValueTypes => prop_get | owner_set;
6d33f75c6e1f ORM in works
Sergey
parents:
diff changeset
16 public property mapReferenceTypes => prop_get | owner_set;
30
dd4d72600c69 ORM in works
Sergey
parents: 28
diff changeset
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
6d33f75c6e1f ORM in works
Sergey
parents:
diff changeset
19 }
6d33f75c6e1f ORM in works
Sergey
parents:
diff changeset
20
6d33f75c6e1f ORM in works
Sergey
parents:
diff changeset
21 sub CTOR {
6d33f75c6e1f ORM in works
Sergey
parents:
diff changeset
22 my ($this ) = @_;
6d33f75c6e1f ORM in works
Sergey
parents:
diff changeset
23 $this->mapValueTypes({});
6d33f75c6e1f ORM in works
Sergey
parents:
diff changeset
24 $this->mapReferenceTypes({});
30
dd4d72600c69 ORM in works
Sergey
parents: 28
diff changeset
25 $this->mapPending({});
28
6d33f75c6e1f ORM in works
Sergey
parents:
diff changeset
26 }
6d33f75c6e1f ORM in works
Sergey
parents:
diff changeset
27
6d33f75c6e1f ORM in works
Sergey
parents:
diff changeset
28 # return an entity for the specified typename
6d33f75c6e1f ORM in works
Sergey
parents:
diff changeset
29 # makes forward declaration if nesessary
6d33f75c6e1f ORM in works
Sergey
parents:
diff changeset
30 sub resolveType {
6d33f75c6e1f ORM in works
Sergey
parents:
diff changeset
31 my ($this,$typeName) = @_;
6d33f75c6e1f ORM in works
Sergey
parents:
diff changeset
32
6d33f75c6e1f ORM in works
Sergey
parents:
diff changeset
33 $this = ref $this ? $this : $this->instance;
6d33f75c6e1f ORM in works
Sergey
parents:
diff changeset
34
6d33f75c6e1f ORM in works
Sergey
parents:
diff changeset
35 if (my $entity = $this->mapReferenceTypes->{$typeName}) {
6d33f75c6e1f ORM in works
Sergey
parents:
diff changeset
36 return $entity;
6d33f75c6e1f ORM in works
Sergey
parents:
diff changeset
37 } elsif (UNIVERSAL::isa($typeName,'IMPL::ORM::Object')) {
6d33f75c6e1f ORM in works
Sergey
parents:
diff changeset
38 return $this->declareReferenceType($typeName);
6d33f75c6e1f ORM in works
Sergey
parents:
diff changeset
39 } else {
6d33f75c6e1f ORM in works
Sergey
parents:
diff changeset
40 return undef;
6d33f75c6e1f ORM in works
Sergey
parents:
diff changeset
41 }
6d33f75c6e1f ORM in works
Sergey
parents:
diff changeset
42 }
6d33f75c6e1f ORM in works
Sergey
parents:
diff changeset
43
30
dd4d72600c69 ORM in works
Sergey
parents: 28
diff changeset
44 sub declareReferenceType {
dd4d72600c69 ORM in works
Sergey
parents: 28
diff changeset
45 my ($this,$typeName) = @_;
dd4d72600c69 ORM in works
Sergey
parents: 28
diff changeset
46
44
Sergey
parents: 43
diff changeset
47 my $entity = new IMPL::ORM::Schema::Entity($typeName->entityName);
30
dd4d72600c69 ORM in works
Sergey
parents: 28
diff changeset
48
dd4d72600c69 ORM in works
Sergey
parents: 28
diff changeset
49 $this->mapPending->{$typeName} = $entity;
38
d660fb38b7cc small fixes
Sergey
parents: 31
diff changeset
50
42
4ff27cd051e3 updated ORM schema model
Sergey
parents: 31
diff changeset
51 $this->appendChild($entity);
30
dd4d72600c69 ORM in works
Sergey
parents: 28
diff changeset
52
dd4d72600c69 ORM in works
Sergey
parents: 28
diff changeset
53 return $this->mapReferenceTypes->{$typeName} = $entity;
dd4d72600c69 ORM in works
Sergey
parents: 28
diff changeset
54 }
dd4d72600c69 ORM in works
Sergey
parents: 28
diff changeset
55
dd4d72600c69 ORM in works
Sergey
parents: 28
diff changeset
56 sub _addReferenceType {
dd4d72600c69 ORM in works
Sergey
parents: 28
diff changeset
57 my ($this,$className) = @_;
dd4d72600c69 ORM in works
Sergey
parents: 28
diff changeset
58
42
4ff27cd051e3 updated ORM schema model
Sergey
parents: 31
diff changeset
59 if ( my $entity = delete $this->mapPending->{$className} ) {
4ff27cd051e3 updated ORM schema model
Sergey
parents: 31
diff changeset
60 $className->ormGetSchema($this,$entity);
4ff27cd051e3 updated ORM schema model
Sergey
parents: 31
diff changeset
61 } else {
4ff27cd051e3 updated ORM schema model
Sergey
parents: 31
diff changeset
62 return $this->appendChild( $this->mapReferenceTypes->{$className} = $className->ormGetSchema($this) );
4ff27cd051e3 updated ORM schema model
Sergey
parents: 31
diff changeset
63 }
4ff27cd051e3 updated ORM schema model
Sergey
parents: 31
diff changeset
64
30
dd4d72600c69 ORM in works
Sergey
parents: 28
diff changeset
65 }
dd4d72600c69 ORM in works
Sergey
parents: 28
diff changeset
66
28
6d33f75c6e1f ORM in works
Sergey
parents:
diff changeset
67 # returns valuetype name
6d33f75c6e1f ORM in works
Sergey
parents:
diff changeset
68 sub isValueType {
6d33f75c6e1f ORM in works
Sergey
parents:
diff changeset
69 my ($this,$typeName) = @_;
6d33f75c6e1f ORM in works
Sergey
parents:
diff changeset
70
6d33f75c6e1f ORM in works
Sergey
parents:
diff changeset
71 $this = ref $this ? $this : $this->instance;
6d33f75c6e1f ORM in works
Sergey
parents:
diff changeset
72
6d33f75c6e1f ORM in works
Sergey
parents:
diff changeset
73 return $this->mapValueTypes->{$typeName};
6d33f75c6e1f ORM in works
Sergey
parents:
diff changeset
74 }
6d33f75c6e1f ORM in works
Sergey
parents:
diff changeset
75
6d33f75c6e1f ORM in works
Sergey
parents:
diff changeset
76 my %instances;
6d33f75c6e1f ORM in works
Sergey
parents:
diff changeset
77 sub instance {
6d33f75c6e1f ORM in works
Sergey
parents:
diff changeset
78 my ($class) = @_;
6d33f75c6e1f ORM in works
Sergey
parents:
diff changeset
79
6d33f75c6e1f ORM in works
Sergey
parents:
diff changeset
80 return ($instances{$class} || ($instances{$class} = $class->new));
6d33f75c6e1f ORM in works
Sergey
parents:
diff changeset
81 }
6d33f75c6e1f ORM in works
Sergey
parents:
diff changeset
82
30
dd4d72600c69 ORM in works
Sergey
parents: 28
diff changeset
83 sub ValueTypes {
dd4d72600c69 ORM in works
Sergey
parents: 28
diff changeset
84 my ($this,%classes) = @_;
dd4d72600c69 ORM in works
Sergey
parents: 28
diff changeset
85
dd4d72600c69 ORM in works
Sergey
parents: 28
diff changeset
86 $this = ref $this ? $this : $this->instance;
dd4d72600c69 ORM in works
Sergey
parents: 28
diff changeset
87
42
4ff27cd051e3 updated ORM schema model
Sergey
parents: 31
diff changeset
88 while ( my ($typeName,$typeReflected) = each %classes ) {
4ff27cd051e3 updated ORM schema model
Sergey
parents: 31
diff changeset
89 $this->mapValueTypes->{$typeName} = $typeReflected;
4ff27cd051e3 updated ORM schema model
Sergey
parents: 31
diff changeset
90 $this->appendChild(IMPL::ORM::Schema::ValueType->new($typeName,$typeReflected));
4ff27cd051e3 updated ORM schema model
Sergey
parents: 31
diff changeset
91 }
30
dd4d72600c69 ORM in works
Sergey
parents: 28
diff changeset
92 }
dd4d72600c69 ORM in works
Sergey
parents: 28
diff changeset
93
dd4d72600c69 ORM in works
Sergey
parents: 28
diff changeset
94 sub Classes {
dd4d72600c69 ORM in works
Sergey
parents: 28
diff changeset
95 my ($this,@classNames) = @_;
dd4d72600c69 ORM in works
Sergey
parents: 28
diff changeset
96
dd4d72600c69 ORM in works
Sergey
parents: 28
diff changeset
97 $this = ref $this ? $this : $this->instance;
dd4d72600c69 ORM in works
Sergey
parents: 28
diff changeset
98
dd4d72600c69 ORM in works
Sergey
parents: 28
diff changeset
99 $this->_addReferenceType($this->prefix . $_) foreach @classNames;
dd4d72600c69 ORM in works
Sergey
parents: 28
diff changeset
100 }
dd4d72600c69 ORM in works
Sergey
parents: 28
diff changeset
101
dd4d72600c69 ORM in works
Sergey
parents: 28
diff changeset
102 sub usePrefix {
dd4d72600c69 ORM in works
Sergey
parents: 28
diff changeset
103 my ($this,$prefix) = @_;
dd4d72600c69 ORM in works
Sergey
parents: 28
diff changeset
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
dd4d72600c69 ORM in works
Sergey
parents: 28
diff changeset
107 (ref $this ? $this : $this->instance)->prefix($prefix);
dd4d72600c69 ORM in works
Sergey
parents: 28
diff changeset
108 }
dd4d72600c69 ORM in works
Sergey
parents: 28
diff changeset
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
4ff27cd051e3 updated ORM schema model
Sergey
parents: 31
diff changeset
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
6d33f75c6e1f ORM in works
Sergey
parents:
diff changeset
118 1;
6d33f75c6e1f ORM in works
Sergey
parents:
diff changeset
119
6d33f75c6e1f ORM in works
Sergey
parents:
diff changeset
120 __END__
6d33f75c6e1f ORM in works
Sergey
parents:
diff changeset
121
6d33f75c6e1f ORM in works
Sergey
parents:
diff changeset
122 =pod
6d33f75c6e1f ORM in works
Sergey
parents:
diff changeset
123
6d33f75c6e1f ORM in works
Sergey
parents:
diff changeset
124 =head1 DESCRIPTION
6d33f75c6e1f ORM in works
Sergey
parents:
diff changeset
125
6d33f75c6e1f ORM in works
Sergey
parents:
diff changeset
126 Схема данных, представляет собой DOM документ, элементами которой
6d33f75c6e1f ORM in works
Sergey
parents:
diff changeset
127 являются сущности.
6d33f75c6e1f ORM in works
Sergey
parents:
diff changeset
128
6d33f75c6e1f ORM in works
Sergey
parents:
diff changeset
129 Каждый узел - это описание сущности.
6d33f75c6e1f ORM in works
Sergey
parents:
diff changeset
130
42
4ff27cd051e3 updated ORM schema model
Sergey
parents: 31
diff changeset
131 <Schema>
4ff27cd051e3 updated ORM schema model
Sergey
parents: 31
diff changeset
132 <Entity entityName="My_Data_Foo">
4ff27cd051e3 updated ORM schema model
Sergey
parents: 31
diff changeset
133 <Field fieldName="Doo" fieldType="String"/>
4ff27cd051e3 updated ORM schema model
Sergey
parents: 31
diff changeset
134 <HasMany name="Boxes" target="My_Data_Box"/>
4ff27cd051e3 updated ORM schema model
Sergey
parents: 31
diff changeset
135 </Entity>
4ff27cd051e3 updated ORM schema model
Sergey
parents: 31
diff changeset
136 <Entity entityName="My_Data_Bar">
4ff27cd051e3 updated ORM schema model
Sergey
parents: 31
diff changeset
137 <Subclass base="My_Data_Foo"/>
4ff27cd051e3 updated ORM schema model
Sergey
parents: 31
diff changeset
138 <Field fieldName="Timestamp" fieldType="Integer"/>
4ff27cd051e3 updated ORM schema model
Sergey
parents: 31
diff changeset
139 </Entity>
4ff27cd051e3 updated ORM schema model
Sergey
parents: 31
diff changeset
140 <Entity entityName="My_Data_Box">
4ff27cd051e3 updated ORM schema model
Sergey
parents: 31
diff changeset
141 <Field fieldName="Capacity" fieldType="Integer"/>
4ff27cd051e3 updated ORM schema model
Sergey
parents: 31
diff changeset
142 </Entity>
4ff27cd051e3 updated ORM schema model
Sergey
parents: 31
diff changeset
143 </Schema>
4ff27cd051e3 updated ORM schema model
Sergey
parents: 31
diff changeset
144
28
6d33f75c6e1f ORM in works
Sergey
parents:
diff changeset
145 =cut