annotate lib/IMPL/ORM/Schema/TransformToSQL.pm @ 408:5c80e33f1218 ref20150831

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