|
407
|
1 package IMPL::ORM::Schema::TransformToSQL;
|
|
|
2 use strict;
|
|
|
3 use warnings;
|
|
|
4
|
|
|
5 use parent qw(IMPL::DOM::Transform);
|
|
|
6 use IMPL::Class::Property;
|
|
|
7 use IMPL::SQL::Types qw(DateTime Varchar Integer Float Text Binary);
|
|
|
8
|
|
|
9 require IMPL::SQL::Schema;
|
|
|
10
|
|
|
11 BEGIN {
|
|
|
12 public property Types => prop_get | owner_set;
|
|
|
13 }
|
|
|
14
|
|
|
15 our %CTOR = (
|
|
|
16 'IMPL::DOM::Transform' => sub {
|
|
|
17 ORMSchema => \&ORMSchemaTransform,
|
|
|
18 Entity => \&EntityTransform,
|
|
|
19 Field => \&FieldTransform,
|
|
|
20 HasOne => \&HasOneTransform,
|
|
|
21 HasMany => \&HasManyTransform,
|
|
|
22 Subclass => \&SubclassTransform,
|
|
|
23 ValueType => sub {}
|
|
|
24 }
|
|
|
25 );
|
|
|
26
|
|
|
27 sub CTOR {
|
|
|
28 my ($this,$refTypeMap) = @_;
|
|
|
29
|
|
|
30 $this->Types($refTypeMap) or die new IMPL::InvalidArgumentException("A reference to the type map hash is required");
|
|
|
31 }
|
|
|
32
|
|
|
33 sub ORMSchemaTransform {
|
|
|
34 my ($this,$node) = @_;
|
|
|
35
|
|
|
36 my $schema = IMPL::SQL::Schema->new(Name => ref $node);
|
|
|
37
|
|
|
38 my @constraints;
|
|
|
39
|
|
|
40 my %ctx = (Schema => $schema);
|
|
|
41
|
|
|
42 # all tables
|
|
|
43 foreach my $entity ($node->selectNodes('Entity')) {
|
|
|
44 $schema->AddTable($this->Transform($entity,\%ctx));
|
|
|
45 push @constraints, $entity->selectNodes(sub {$_->isa('IMPL::ORM::Schema::Relation')});
|
|
|
46 }
|
|
|
47
|
|
|
48 # establish relations
|
|
|
49 $this->Transform($_,\%ctx) foreach @constraints;
|
|
|
50
|
|
|
51 return $schema;
|
|
|
52 }
|
|
|
53
|
|
|
54 sub EntityTransform {
|
|
|
55 my ($this,$node,$ctx) = @_;
|
|
|
56
|
|
|
57 my $table = IMPL::SQL::Schema::Table->new(Name => $node->entityName, Schema => $ctx->{Schema});
|
|
|
58
|
|
|
59 $this->MakePrimaryKey($table);
|
|
|
60
|
|
|
61 $table->InsertColumn( $this->Transform($_,$ctx)) foreach$node->selectNodes('Field');
|
|
|
62
|
|
|
63 return $table;
|
|
|
64 }
|
|
|
65
|
|
|
66 sub FieldTransform {
|
|
|
67 my ($this,$field,$ctx) = @_;
|
|
|
68
|
|
|
69 return {
|
|
|
70 Name => $field->fieldName,
|
|
|
71 Type => $this->MapType($field->fieldType) || die new IMPL::Exception("Can't get map a rom schema type to the SQL type",$field->fieldType),
|
|
|
72 CanBeNull => $field->fieldNullable
|
|
|
73 };
|
|
|
74 }
|
|
|
75
|
|
|
76 sub HasOneTransform {
|
|
|
77 my ($this,$relation,$ctx) = @_;
|
|
|
78
|
|
|
79 my $sqlSchema = $ctx->{Schema};
|
|
|
80 my $table = $sqlSchema->Tables->{$relation->parentNode->entityName};
|
|
|
81 my $tableForeign = $sqlSchema->Tables->{$relation->target};
|
|
|
82 my $prefix = $relation->name;
|
|
|
83
|
|
|
84 my @fkColumns = $tableForeign->PrimaryKey->columns;
|
|
|
85
|
|
|
86 if (@fkColumns > 1) {
|
|
|
87 @fkColumns = map
|
|
|
88 $table->InsertColumn({
|
|
|
89 Name => $prefix . $_->Name,
|
|
|
90 Type => $_->Type,
|
|
|
91 CanBeNull => 1
|
|
|
92 }), @fkColumns;
|
|
|
93 } else {
|
|
|
94 @fkColumns = $table->InsertColumn({
|
|
|
95 Name => $prefix,
|
|
|
96 Type => $fkColumns[0]->Type,
|
|
|
97 CanBeNull => 1
|
|
|
98 });
|
|
|
99 }
|
|
|
100
|
|
|
101 $table->LinkTo($tableForeign,@fkColumns);
|
|
|
102 }
|
|
|
103
|
|
|
104 sub HasManyTransform {
|
|
|
105 my ($this,$relation,$ctx) = @_;
|
|
|
106
|
|
|
107 #similar to HasOne
|
|
|
108
|
|
|
109 my $sqlSchema = $ctx->{Schema};
|
|
|
110 my $table = $sqlSchema->Tables->{$relation->parentNode->entityName};
|
|
|
111 my $tableForeign = $sqlSchema->Tables->{$relation->target};
|
|
|
112 my $prefix = $relation->name;
|
|
|
113
|
|
|
114 my @fkColumns = $table->PrimaryKey->columns;
|
|
|
115
|
|
|
116 if (@fkColumns > 1 ) {
|
|
|
117 @fkColumns = map $tableForeign->InsertColumn({
|
|
|
118 Name => $prefix . $_->Name,
|
|
|
119 Type => $_->Type,
|
|
|
120 CanBeNull => 1
|
|
|
121 }), @fkColumns;
|
|
|
122 } else {
|
|
|
123 @fkColumns = $tableForeign->InsertColumn({
|
|
|
124 Name => $prefix,
|
|
|
125 Type => $fkColumns[0]->Type,
|
|
|
126 CanBeNull => 1
|
|
|
127 });
|
|
|
128 }
|
|
|
129
|
|
|
130 $tableForeign->LinkTo($table,@fkColumns);
|
|
|
131 }
|
|
|
132
|
|
|
133 sub SubclassTransform {
|
|
|
134 # actually this rlations has only logical implementation
|
|
|
135 }
|
|
|
136
|
|
|
137 sub MapType {
|
|
|
138 my ($this,$typeName) = @_;
|
|
|
139
|
|
|
140 $this->Types->{$typeName} || die new IMPL::Exception("Can't map a type",$typeName);
|
|
|
141 }
|
|
|
142
|
|
|
143 sub MakePrimaryKey {
|
|
|
144 my ($this,$table) = @_;
|
|
|
145
|
|
|
146 $table->InsertColumn( {Name => '_Id', Type => Integer } );
|
|
|
147 $table->SetPrimaryKey('_Id');
|
|
|
148 }
|
|
|
149
|
|
|
150 {
|
|
|
151 my $std;
|
|
|
152 sub Std {
|
|
|
153 $std ||= __PACKAGE__->new({
|
|
|
154 String => Varchar(255),
|
|
|
155 DateTime => DateTime,
|
|
|
156 Integer => Integer,
|
|
|
157 Float => Float(24),
|
|
|
158 Decimal => Float(53),
|
|
|
159 Real => Float(24),
|
|
|
160 Binary => Binary,
|
|
|
161 Text => Text
|
|
|
162 });
|
|
|
163 }
|
|
|
164 }
|
|
|
165
|
|
|
166 1;
|
|
|
167
|
|
|
168 __END__
|
|
|
169
|
|
|
170 =pod
|
|
|
171
|
|
|
172 =head1 SYNOPSIS
|
|
|
173
|
|
|
174 =begin code
|
|
|
175
|
|
|
176 my $sqlSchema = IMPL::ORM::Schema::TransformToSQL->Default->Transform(Data::Schema->instance);
|
|
|
177
|
|
|
178 =end code
|
|
|
179
|
|
|
180 =cut
|
|
|
181
|
