annotate Lib/IMPL/ORM/Schema.pm @ 36:1828103371d0

DOM in works
author Sergey
date Fri, 20 Nov 2009 16:48:08 +0300
parents d59526f6310e
children d660fb38b7cc 4ff27cd051e3
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;
dd4d72600c69 ORM in works
Sergey
parents: 28
diff changeset
8
dd4d72600c69 ORM in works
Sergey
parents: 28
diff changeset
9 our %CTOR = (
dd4d72600c69 ORM in works
Sergey
parents: 28
diff changeset
10 'IMPL::DOM::Document' => sub { nodeName => 'Schema' }
dd4d72600c69 ORM in works
Sergey
parents: 28
diff changeset
11 );
28
6d33f75c6e1f ORM in works
Sergey
parents:
diff changeset
12
6d33f75c6e1f ORM in works
Sergey
parents:
diff changeset
13 BEGIN {
6d33f75c6e1f ORM in works
Sergey
parents:
diff changeset
14 public property mapValueTypes => prop_get | owner_set;
6d33f75c6e1f ORM in works
Sergey
parents:
diff changeset
15 public property mapReferenceTypes => prop_get | owner_set;
30
dd4d72600c69 ORM in works
Sergey
parents: 28
diff changeset
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
6d33f75c6e1f ORM in works
Sergey
parents:
diff changeset
18 }
6d33f75c6e1f ORM in works
Sergey
parents:
diff changeset
19
6d33f75c6e1f ORM in works
Sergey
parents:
diff changeset
20 sub CTOR {
6d33f75c6e1f ORM in works
Sergey
parents:
diff changeset
21 my ($this ) = @_;
6d33f75c6e1f ORM in works
Sergey
parents:
diff changeset
22 $this->mapValueTypes({});
6d33f75c6e1f ORM in works
Sergey
parents:
diff changeset
23 $this->mapReferenceTypes({});
30
dd4d72600c69 ORM in works
Sergey
parents: 28
diff changeset
24 $this->mapPending({});
28
6d33f75c6e1f ORM in works
Sergey
parents:
diff changeset
25 }
6d33f75c6e1f ORM in works
Sergey
parents:
diff changeset
26
6d33f75c6e1f ORM in works
Sergey
parents:
diff changeset
27 # return an entity for the specified typename
6d33f75c6e1f ORM in works
Sergey
parents:
diff changeset
28 # makes forward declaration if nesessary
6d33f75c6e1f ORM in works
Sergey
parents:
diff changeset
29 sub resolveType {
6d33f75c6e1f ORM in works
Sergey
parents:
diff changeset
30 my ($this,$typeName) = @_;
6d33f75c6e1f ORM in works
Sergey
parents:
diff changeset
31
6d33f75c6e1f ORM in works
Sergey
parents:
diff changeset
32 $this = ref $this ? $this : $this->instance;
6d33f75c6e1f ORM in works
Sergey
parents:
diff changeset
33
6d33f75c6e1f ORM in works
Sergey
parents:
diff changeset
34 if (my $entity = $this->mapReferenceTypes->{$typeName}) {
6d33f75c6e1f ORM in works
Sergey
parents:
diff changeset
35 return $entity;
6d33f75c6e1f ORM in works
Sergey
parents:
diff changeset
36 } elsif (UNIVERSAL::isa($typeName,'IMPL::ORM::Object')) {
6d33f75c6e1f ORM in works
Sergey
parents:
diff changeset
37 return $this->declareReferenceType($typeName);
6d33f75c6e1f ORM in works
Sergey
parents:
diff changeset
38 } else {
6d33f75c6e1f ORM in works
Sergey
parents:
diff changeset
39 return undef;
6d33f75c6e1f ORM in works
Sergey
parents:
diff changeset
40 }
6d33f75c6e1f ORM in works
Sergey
parents:
diff changeset
41 }
6d33f75c6e1f ORM in works
Sergey
parents:
diff changeset
42
30
dd4d72600c69 ORM in works
Sergey
parents: 28
diff changeset
43 sub declareReferenceType {
dd4d72600c69 ORM in works
Sergey
parents: 28
diff changeset
44 my ($this,$typeName) = @_;
dd4d72600c69 ORM in works
Sergey
parents: 28
diff changeset
45
dd4d72600c69 ORM in works
Sergey
parents: 28
diff changeset
46 my $entity = new IMPL::ORM::Schema::Entity($typeName);
dd4d72600c69 ORM in works
Sergey
parents: 28
diff changeset
47
dd4d72600c69 ORM in works
Sergey
parents: 28
diff changeset
48 $this->mapPending->{$typeName} = $entity;
dd4d72600c69 ORM in works
Sergey
parents: 28
diff changeset
49
dd4d72600c69 ORM in works
Sergey
parents: 28
diff changeset
50 return $this->mapReferenceTypes->{$typeName} = $entity;
dd4d72600c69 ORM in works
Sergey
parents: 28
diff changeset
51 }
dd4d72600c69 ORM in works
Sergey
parents: 28
diff changeset
52
dd4d72600c69 ORM in works
Sergey
parents: 28
diff changeset
53 sub _addReferenceType {
dd4d72600c69 ORM in works
Sergey
parents: 28
diff changeset
54 my ($this,$className) = @_;
dd4d72600c69 ORM in works
Sergey
parents: 28
diff changeset
55
dd4d72600c69 ORM in works
Sergey
parents: 28
diff changeset
56 $this->mapReferenceTypes->{$className} = $className->ormGetSchema($this,delete $this->mapPending->{$className});
dd4d72600c69 ORM in works
Sergey
parents: 28
diff changeset
57 }
dd4d72600c69 ORM in works
Sergey
parents: 28
diff changeset
58
28
6d33f75c6e1f ORM in works
Sergey
parents:
diff changeset
59 # returns valuetype name
6d33f75c6e1f ORM in works
Sergey
parents:
diff changeset
60 sub isValueType {
6d33f75c6e1f ORM in works
Sergey
parents:
diff changeset
61 my ($this,$typeName) = @_;
6d33f75c6e1f ORM in works
Sergey
parents:
diff changeset
62
6d33f75c6e1f ORM in works
Sergey
parents:
diff changeset
63 $this = ref $this ? $this : $this->instance;
6d33f75c6e1f ORM in works
Sergey
parents:
diff changeset
64
6d33f75c6e1f ORM in works
Sergey
parents:
diff changeset
65 return $this->mapValueTypes->{$typeName};
6d33f75c6e1f ORM in works
Sergey
parents:
diff changeset
66 }
6d33f75c6e1f ORM in works
Sergey
parents:
diff changeset
67
6d33f75c6e1f ORM in works
Sergey
parents:
diff changeset
68 my %instances;
6d33f75c6e1f ORM in works
Sergey
parents:
diff changeset
69 sub instance {
6d33f75c6e1f ORM in works
Sergey
parents:
diff changeset
70 my ($class) = @_;
6d33f75c6e1f ORM in works
Sergey
parents:
diff changeset
71
6d33f75c6e1f ORM in works
Sergey
parents:
diff changeset
72 return ($instances{$class} || ($instances{$class} = $class->new));
6d33f75c6e1f ORM in works
Sergey
parents:
diff changeset
73 }
6d33f75c6e1f ORM in works
Sergey
parents:
diff changeset
74
30
dd4d72600c69 ORM in works
Sergey
parents: 28
diff changeset
75 sub ValueTypes {
dd4d72600c69 ORM in works
Sergey
parents: 28
diff changeset
76 my ($this,%classes) = @_;
dd4d72600c69 ORM in works
Sergey
parents: 28
diff changeset
77
dd4d72600c69 ORM in works
Sergey
parents: 28
diff changeset
78 $this = ref $this ? $this : $this->instance;
dd4d72600c69 ORM in works
Sergey
parents: 28
diff changeset
79
dd4d72600c69 ORM in works
Sergey
parents: 28
diff changeset
80 $this->mapValueTypes->{$_} = $classes{$_} foreach keys %classes;
dd4d72600c69 ORM in works
Sergey
parents: 28
diff changeset
81 }
dd4d72600c69 ORM in works
Sergey
parents: 28
diff changeset
82
dd4d72600c69 ORM in works
Sergey
parents: 28
diff changeset
83 sub Classes {
dd4d72600c69 ORM in works
Sergey
parents: 28
diff changeset
84 my ($this,@classNames) = @_;
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
dd4d72600c69 ORM in works
Sergey
parents: 28
diff changeset
88 $this->_addReferenceType($this->prefix . $_) foreach @classNames;
dd4d72600c69 ORM in works
Sergey
parents: 28
diff changeset
89 }
dd4d72600c69 ORM in works
Sergey
parents: 28
diff changeset
90
dd4d72600c69 ORM in works
Sergey
parents: 28
diff changeset
91 sub usePrefix {
dd4d72600c69 ORM in works
Sergey
parents: 28
diff changeset
92 my ($this,$prefix) = @_;
dd4d72600c69 ORM in works
Sergey
parents: 28
diff changeset
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
dd4d72600c69 ORM in works
Sergey
parents: 28
diff changeset
96 (ref $this ? $this : $this->instance)->prefix($prefix);
dd4d72600c69 ORM in works
Sergey
parents: 28
diff changeset
97 }
dd4d72600c69 ORM in works
Sergey
parents: 28
diff changeset
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
6d33f75c6e1f ORM in works
Sergey
parents:
diff changeset
108 1;
6d33f75c6e1f ORM in works
Sergey
parents:
diff changeset
109
6d33f75c6e1f ORM in works
Sergey
parents:
diff changeset
110 __END__
6d33f75c6e1f ORM in works
Sergey
parents:
diff changeset
111
6d33f75c6e1f ORM in works
Sergey
parents:
diff changeset
112 =pod
6d33f75c6e1f ORM in works
Sergey
parents:
diff changeset
113
6d33f75c6e1f ORM in works
Sergey
parents:
diff changeset
114 =head1 DESCRIPTION
6d33f75c6e1f ORM in works
Sergey
parents:
diff changeset
115
6d33f75c6e1f ORM in works
Sergey
parents:
diff changeset
116 Схема данных, представляет собой DOM документ, элементами которой
6d33f75c6e1f ORM in works
Sergey
parents:
diff changeset
117 являются сущности.
6d33f75c6e1f ORM in works
Sergey
parents:
diff changeset
118
6d33f75c6e1f ORM in works
Sergey
parents:
diff changeset
119 Каждый узел - это описание сущности.
6d33f75c6e1f ORM in works
Sergey
parents:
diff changeset
120
6d33f75c6e1f ORM in works
Sergey
parents:
diff changeset
121 =cut