diff lib/IMPL/ORM/Schema/TransformToSQL.pm @ 407:c6e90e02dd17 ref20150831

renamed Lib->lib
author cin
date Fri, 04 Sep 2015 19:40:23 +0300
parents
children
line wrap: on
line diff
--- /dev/null	Thu Jan 01 00:00:00 1970 +0000
+++ b/lib/IMPL/ORM/Schema/TransformToSQL.pm	Fri Sep 04 19:40:23 2015 +0300
@@ -0,0 +1,181 @@
+package IMPL::ORM::Schema::TransformToSQL;
+use strict;
+use warnings;
+
+use parent 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,
+        ValueType => sub {}
+    }
+);
+
+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->selectNodes('Entity')) {
+        $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 = $tableForeign->PrimaryKey->columns;
+    
+    if (@fkColumns > 1) {
+        @fkColumns = map
+        $table->InsertColumn({
+            Name => $prefix . $_->Name,
+            Type => $_->Type,
+            CanBeNull => 1
+        }), @fkColumns;
+    } else {
+        @fkColumns = $table->InsertColumn({
+            Name => $prefix,
+            Type => $fkColumns[0]->Type,
+            CanBeNull => 1
+        });
+    }
+    
+    $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 = $relation->name;
+    
+    my @fkColumns = $table->PrimaryKey->columns;
+    
+    if (@fkColumns > 1 ) {
+        @fkColumns = map $tableForeign->InsertColumn({
+            Name => $prefix . $_->Name,
+            Type => $_->Type,
+            CanBeNull => 1
+        }), @fkColumns;
+    } else {
+        @fkColumns = $tableForeign->InsertColumn({
+            Name => $prefix,
+            Type => $fkColumns[0]->Type,
+            CanBeNull => 1
+        });
+    }
+        
+    $tableForeign->LinkTo($table,@fkColumns);    
+}
+
+sub SubclassTransform {
+    # actually this rlations has only logical 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
+
+=begin code
+
+my $sqlSchema = IMPL::ORM::Schema::TransformToSQL->Default->Transform(Data::Schema->instance);
+
+=end code
+
+=cut
+