Mercurial > pub > Impl

comparison Lib/IMPL/ORM/Schema/TransformToSQL.pm @ 38:d660fb38b7cc

Find changesets by keywords (author, files, the commit message), revision number or hash, or revset expression.
small fixes ORM shema to SQL schema transformation
author Sergey
date Mon, 23 Nov 2009 17:57:07 +0300
parents
children 32d2350fccf9
comparison
equal deleted inserted replaced
37:c2e7f7c96bcd 38:d660fb38b7cc
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