view Lib/IMPL/ORM/Schema/TransformToSQL.pm @ 59:0f3e369553bd

Rewritten property implementation (probably become slower but more flexible) Configuration infrastructure in progress (in the aspect of the lazy activation) Initial concept for the code generator
author wizard
date Tue, 09 Mar 2010 02:50:45 +0300
parents 16ada169ca75
children 2d1c3f713280
line wrap: on
line source

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,
        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

my $sqlSchema = IMPL::ORM::Schema::TransformToSQL->Default->Transform(Data::Schema->instance);

=cut