|
38
|
1 package IMPL::ORM::Schema::TransformToSQL;
|
|
|
2 use strict;
|
|
|
3 use warnings;
|
|
|
4
|
|
|
5 use base 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 }
|
|
|
24 );
|
|
|
25
|
|
|
26 sub CTOR {
|
|
|
27 my ($this,$refTypeMap) = @_;
|
|
|
28
|
|
|
29 $this->Types($refTypeMap) or die new IMPL::InvalidArgumentException("A reference to the type map hash is required");
|
|
|
30 }
|
|
|
31
|
|
|
32 sub ORMSchemaTransform {
|
|
|
33 my ($this,$node) = @_;
|
|
|
34
|
|
|
35 my $schema = IMPL::SQL::Schema->new(Name => ref $node);
|
|
|
36
|
|
|
37 my @constraints;
|
|
|
38
|
|
|
39 my %ctx = (Schema => $schema);
|
|
|
40
|
|
|
41 # all tables
|
|
|
42 foreach my $entity ($node->ReferenceTypes) {
|
|
|
43 $schema->AddTable($this->Transform($entity,\%ctx));
|
|
|
44 push @constraints, $entity->selectNodes(sub {$_->isa('IMPL::ORM::Schema::Relation')});
|
|
|
45 }
|
|
|
46
|
|
|
47 # establish relations
|
|
|
48 $this->Transform($_,\%ctx) foreach @constraints;
|
|
|
49
|
|
|
50 return $schema;
|
|
|
51 }
|
|
|
52
|
|
|
53 sub EntityTransform {
|
|
|
54 my ($this,$node,$ctx) = @_;
|
|
|
55
|
|
|
56 my $table = IMPL::SQL::Schema::Table->new(Name => $node->entityName, Schema => $ctx->{Schema});
|
|
|
57
|
|
|
58 $this->MakePrimaryKey($table);
|
|
|
59
|
|
|
60 $table->InsertColumn( $this->Transform($_,$ctx)) foreach$node->selectNodes('Field');
|
|
|
61
|
|
|
62 return $table;
|
|
|
63 }
|
|
|
64
|
|
|
65 sub FieldTransform {
|
|
|
66 my ($this,$field,$ctx) = @_;
|
|
|
67
|
|
|
68 return {
|
|
|
69 Name => $field->fieldName,
|
|
|
70 Type => $this->MapType($field->fieldType) || die new IMPL::Exception("Can't get map a rom schema type to the SQL type",$field->fieldType),
|
|
|
71 CanBeNull => $field->fieldNullable
|
|
|
72 };
|
|
|
73 }
|
|
|
74
|
|
|
75 sub HasOneTransform {
|
|
|
76 my ($this,$relation,$ctx) = @_;
|
|
|
77
|
|
|
78 my $sqlSchema = $ctx->{Schema};
|
|
|
79 my $table = $sqlSchema->Tables->{$relation->parentNode->entityName};
|
|
|
80 my $tableForeign = $sqlSchema->Tables->{$relation->target};
|
|
|
81 my $prefix = $relation->name;
|
|
|
82
|
|
|
83 my @fkColumns = map
|
|
|
84 $table->InsertColumn({
|
|
|
85 Name => $prefix . $_->Name,
|
|
|
86 Type => $_->Type,
|
|
|
87 CanBeNull => 1
|
|
|
88 }),
|
|
|
89 @{$tableForeign->PrimaryKey->Columns};
|
|
|
90
|
|
|
91 $table->LinkTo($tableForeign,@fkColumns);
|
|
|
92 }
|
|
|
93
|
|
|
94 sub HasManyTransform {
|
|
|
95 my ($this,$relation,$ctx) = @_;
|
|
|
96
|
|
|
97 #similar to HasOne
|
|
|
98
|
|
|
99 my $sqlSchema = $ctx->{Schema};
|
|
|
100 my $table = $sqlSchema->Tables->{$relation->parentNode->entityName};
|
|
|
101 my $tableForeign = $sqlSchema->Tables->{$relation->target};
|
|
|
102 my $prefix = $table->Name . '_' . $relation->name;
|
|
|
103
|
|
|
104 my @fkColumns = map
|
|
|
105 $tableForeign->InsertColumn({
|
|
|
106 Name => $prefix . $_->Name,
|
|
|
107 Type => $_->Type,
|
|
|
108 CanBeNull => 1
|
|
|
109 }),
|
|
|
110 @{$table->PrimaryKey->Columns};
|
|
|
111
|
|
|
112 $tableForeign->LinkTo($table,@fkColumns);
|
|
|
113 }
|
|
|
114
|
|
|
115 sub SubclassTransform {
|
|
|
116 # actually this rlations has only ligical implementation
|
|
|
117 }
|
|
|
118
|
|
|
119 sub MapType {
|
|
|
120 my ($this,$typeName) = @_;
|
|
|
121
|
|
|
122 $this->Types->{$typeName} || die new IMPL::Exception("Can't map a type",$typeName);
|
|
|
123 }
|
|
|
124
|
|
|
125 sub MakePrimaryKey {
|
|
|
126 my ($this,$table) = @_;
|
|
|
127
|
|
|
128 $table->InsertColumn( {Name => '_Id', Type => Integer } );
|
|
|
129 $table->SetPrimaryKey('_Id');
|
|
|
130 }
|
|
|
131
|
|
|
132 {
|
|
|
133 my $std;
|
|
|
134 sub Std {
|
|
|
135 $std ||= __PACKAGE__->new({
|
|
|
136 String => Varchar(255),
|
|
|
137 DateTime => DateTime,
|
|
|
138 Integer => Integer,
|
|
|
139 Float => Float(24),
|
|
|
140 Decimal => Float(53),
|
|
|
141 Real => Float(24),
|
|
|
142 Binary => Binary,
|
|
|
143 Text => Text
|
|
|
144 });
|
|
|
145 }
|
|
|
146 }
|
|
|
147
|
|
|
148 1;
|
|
|
149
|
|
|
150 __END__
|
|
|
151
|
|
|
152 =pod
|
|
|
153
|
|
|
154 =head1 SYNOPSIS
|
|
|
155
|
|
|
156 my $sqlSchema = IMPL::ORM::Schema::TransformToSQL->Default->Transform(Data::Schema->instance);
|
|
|
157
|
|
|
158 =cut
|
|
|
159
|
