view Lib/IMPL/ORM/Schema/TransformToSQL.pm @ 70:2dfb0b0ad12f

More docs
author wizard
date Wed, 24 Mar 2010 17:42:04 +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