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

small fixes ORM shema to SQL schema transformation
author Sergey
date Mon, 23 Nov 2009 17:57:07 +0300
parents
children 32d2350fccf9
line wrap: on
line diff
--- /dev/null	Thu Jan 01 00:00:00 1970 +0000
+++ b/Lib/IMPL/ORM/Schema/TransformToSQL.pm	Mon Nov 23 17:57:07 2009 +0300
@@ -0,0 +1,159 @@
+package IMPL::ORM::Schema::TransformToSQL;
+use strict;
+use warnings;
+
+use base qw(IMPL::DOM::Transform);
+use IMPL::Class::Property;
+use IMPL::SQL::Types qw(DateTime Varchar Integer Float Text Binary);
+
+require IMPL::SQL::Schema;
+
+BEGIN {
+    public property Types => prop_get | owner_set;
+}
+
+our %CTOR = (
+    'IMPL::DOM::Transform' => sub {
+        ORMSchema => \&ORMSchemaTransform,
+        Entity => \&EntityTransform,
+        Field => \&FieldTransform,
+        HasOne => \&HasOneTransform,
+        HasMany => \&HasManyTransform,
+        Subclass => \&SubclassTransform
+    }
+);
+
+sub CTOR {
+    my ($this,$refTypeMap) = @_;
+    
+    $this->Types($refTypeMap) or die new IMPL::InvalidArgumentException("A reference to the type map hash is required");
+}
+
+sub ORMSchemaTransform {
+    my ($this,$node) = @_;
+    
+    my $schema = IMPL::SQL::Schema->new(Name => ref $node);
+    
+    my @constraints;
+    
+    my %ctx = (Schema => $schema);
+    
+    # all tables
+    foreach my $entity ($node->ReferenceTypes) {
+        $schema->AddTable($this->Transform($entity,\%ctx));
+        push @constraints, $entity->selectNodes(sub {$_->isa('IMPL::ORM::Schema::Relation')});
+    }
+    
+    # establish relations
+    $this->Transform($_,\%ctx) foreach @constraints;
+    
+    return $schema;
+}
+
+sub EntityTransform {
+    my ($this,$node,$ctx) = @_;
+    
+    my $table = IMPL::SQL::Schema::Table->new(Name => $node->entityName, Schema => $ctx->{Schema});
+    
+    $this->MakePrimaryKey($table);
+    
+    $table->InsertColumn( $this->Transform($_,$ctx)) foreach$node->selectNodes('Field');
+    
+    return $table;
+}
+
+sub FieldTransform {
+    my ($this,$field,$ctx) = @_;
+    
+    return {
+        Name => $field->fieldName,
+        Type => $this->MapType($field->fieldType) || die new IMPL::Exception("Can't get map a rom schema type to the SQL type",$field->fieldType),
+        CanBeNull => $field->fieldNullable
+    };
+}
+
+sub HasOneTransform {
+    my ($this,$relation,$ctx) = @_;
+    
+    my $sqlSchema = $ctx->{Schema};
+    my $table = $sqlSchema->Tables->{$relation->parentNode->entityName};
+    my $tableForeign = $sqlSchema->Tables->{$relation->target};
+    my $prefix = $relation->name;
+    
+    my @fkColumns = map
+        $table->InsertColumn({
+            Name => $prefix . $_->Name,
+            Type => $_->Type,
+            CanBeNull => 1
+        }),
+        @{$tableForeign->PrimaryKey->Columns};
+        
+    $table->LinkTo($tableForeign,@fkColumns);    
+}
+
+sub HasManyTransform {
+    my ($this,$relation,$ctx) = @_;
+    
+    #similar to HasOne
+    
+    my $sqlSchema = $ctx->{Schema};
+    my $table = $sqlSchema->Tables->{$relation->parentNode->entityName};
+    my $tableForeign = $sqlSchema->Tables->{$relation->target};
+    my $prefix = $table->Name . '_' . $relation->name;
+    
+    my @fkColumns = map
+        $tableForeign->InsertColumn({
+            Name => $prefix . $_->Name,
+            Type => $_->Type,
+            CanBeNull => 1
+        }),
+        @{$table->PrimaryKey->Columns};
+        
+    $tableForeign->LinkTo($table,@fkColumns);    
+}
+
+sub SubclassTransform {
+    # actually this rlations has only ligical implementation
+}
+
+sub MapType {
+    my ($this,$typeName) = @_;
+    
+    $this->Types->{$typeName} || die new IMPL::Exception("Can't map a type",$typeName);
+}
+
+sub MakePrimaryKey {
+    my ($this,$table) = @_;
+    
+    $table->InsertColumn( {Name => '_Id', Type => Integer } );
+    $table->SetPrimaryKey('_Id');
+}
+
+{
+    my $std;
+    sub Std {
+        $std ||= __PACKAGE__->new({
+            String => Varchar(255),
+            DateTime => DateTime,
+            Integer => Integer,
+            Float => Float(24),
+            Decimal => Float(53),
+            Real => Float(24),
+            Binary => Binary,
+            Text => Text
+        });
+    }
+}
+
+1;
+
+__END__
+
+=pod
+
+=head1 SYNOPSIS
+
+my $sqlSchema = IMPL::ORM::Schema::TransformToSQL->Default->Transform(Data::Schema->instance);
+
+=cut
+