# HG changeset patch
# User Sergey
# Date 1263163320 -10800
# Node ID 32d2350fccf97083f00a7c4db57759e08f42f1ec
# Parent  009aa9ca2e485909cb4e363be142bd1ffc65839a
ORM
*Minor fixes
*Working tarnsform to sql
*Fixes to the sql traits

diff -r 009aa9ca2e48 -r 32d2350fccf9 Lib/IMPL/ORM/Object.pm
--- a/Lib/IMPL/ORM/Object.pm	Thu Jan 07 15:41:49 2010 +0300
+++ b/Lib/IMPL/ORM/Object.pm	Mon Jan 11 01:42:00 2010 +0300
@@ -15,7 +15,11 @@
 
 BEGIN {
     private _direct property _entities => prop_all;
-    public property objectType => prop_all;
+    public property objectType => prop_all, {type => 'String'};
+    
+    sub _PropertyImplementor {
+        'IMPL::ORM::PropertyImplementor'
+    }
 }
 
 my %schemaCache;
@@ -42,12 +46,8 @@
     return $this->{$_entities}{$class} ? $this->{$_entities}{$class}->Get($prop,$value) : undef;
 }
 
-sub _PropertyImplementor {
-    'IMPL::ORM::PropertyImplementor'
-}
-
 sub entityName {
-    (my $self = ref $_[0] || $_[0]) =~ s/::/_/g;
+    (my $self = ref $_[0] || $_[0]) =~ s/^.*?(\w+)$/$1/;
     return $self;
 }
 
@@ -70,9 +70,9 @@
             # отношение 1 ко многим
             my $type = $dataSchema->resolveType($ormProp->Type) or die new IMPL::InvalidOperationException("Failed to resolve a reference type due building schema for a class", $ormProp->Class, $ormProp->Name);
             $schema->appendChild( new IMPL::ORM::Schema::Relation::HasMany($ormProp->Name, $type->entityName) );
-        } elsif (my $type = $dataSchema->isValueType($ormProp->Type,'IMPL::ORM::Object')) {
+        } elsif (my $type = $dataSchema->isValueType($ormProp->Type)) {
             # поле
-            $schema->appendChild( new IMPL::ORM::Schema::Field($ormProp->Name,$type->name) );
+            $schema->appendChild( new IMPL::ORM::Schema::Field($ormProp->Name,$ormProp->Type) );
         } elsif (my $entity = $dataSchema->resolveType($ormProp->Type)) {
             # отношение ссылка
             $schema->appendChild( new IMPL::ORM::Schema::Relation::HasOne($ormProp->Name,$entity->entityName));
diff -r 009aa9ca2e48 -r 32d2350fccf9 Lib/IMPL/ORM/Schema.pm
--- a/Lib/IMPL/ORM/Schema.pm	Thu Jan 07 15:41:49 2010 +0300
+++ b/Lib/IMPL/ORM/Schema.pm	Mon Jan 11 01:42:00 2010 +0300
@@ -8,7 +8,7 @@
 require IMPL::ORM::Schema::ValueType;
 
 our %CTOR = (
-    'IMPL::DOM::Document' => sub { nodeName => 'Schema' }
+    'IMPL::DOM::Document' => sub { nodeName => 'ORMSchema' }
 );
 
 BEGIN {
@@ -44,7 +44,7 @@
 sub declareReferenceType {
     my ($this,$typeName) = @_;
     
-    my $entity = new IMPL::ORM::Schema::Entity($typeName);
+    my $entity = new IMPL::ORM::Schema::Entity($typeName->entityName);
     
     $this->mapPending->{$typeName} = $entity;
     
diff -r 009aa9ca2e48 -r 32d2350fccf9 Lib/IMPL/ORM/Schema/TransformToSQL.pm
--- a/Lib/IMPL/ORM/Schema/TransformToSQL.pm	Thu Jan 07 15:41:49 2010 +0300
+++ b/Lib/IMPL/ORM/Schema/TransformToSQL.pm	Mon Jan 11 01:42:00 2010 +0300
@@ -19,7 +19,8 @@
         Field => \&FieldTransform,
         HasOne => \&HasOneTransform,
         HasMany => \&HasManyTransform,
-        Subclass => \&SubclassTransform
+        Subclass => \&SubclassTransform,
+        ValueType => sub {}
     }
 );
 
@@ -39,7 +40,7 @@
     my %ctx = (Schema => $schema);
     
     # all tables
-    foreach my $entity ($node->ReferenceTypes) {
+    foreach my $entity ($node->selectNodes('Entity')) {
         $schema->AddTable($this->Transform($entity,\%ctx));
         push @constraints, $entity->selectNodes(sub {$_->isa('IMPL::ORM::Schema::Relation')});
     }
@@ -80,14 +81,23 @@
     my $tableForeign = $sqlSchema->Tables->{$relation->target};
     my $prefix = $relation->name;
     
-    my @fkColumns = map
+    my @fkColumns = @{$tableForeign->PrimaryKey->Columns};
+    
+    if (@fkColumns > 1) {
+        @fkColumns = map
         $table->InsertColumn({
             Name => $prefix . $_->Name,
             Type => $_->Type,
             CanBeNull => 1
-        }),
-        @{$tableForeign->PrimaryKey->Columns};
-        
+        }), @fkColumns;
+    } else {
+        @fkColumns = $table->InsertColumn({
+            Name => $prefix,
+            Type => $fkColumns[0]->Type,
+            CanBeNull => 1
+        });
+    }
+    
     $table->LinkTo($tableForeign,@fkColumns);    
 }
 
@@ -99,21 +109,29 @@
     my $sqlSchema = $ctx->{Schema};
     my $table = $sqlSchema->Tables->{$relation->parentNode->entityName};
     my $tableForeign = $sqlSchema->Tables->{$relation->target};
-    my $prefix = $table->Name . '_' . $relation->name;
+    my $prefix = $relation->name;
     
-    my @fkColumns = map
-        $tableForeign->InsertColumn({
+    my @fkColumns = @{$table->PrimaryKey->Columns};
+    
+    if (@fkColumns > 1 ) {
+        @fkColumns = map $tableForeign->InsertColumn({
             Name => $prefix . $_->Name,
             Type => $_->Type,
             CanBeNull => 1
-        }),
-        @{$table->PrimaryKey->Columns};
+        }), @fkColumns;
+    } else {
+        @fkColumns = $tableForeign->InsertColumn({
+            Name => $prefix,
+            Type => $fkColumns[0]->Type,
+            CanBeNull => 1
+        });
+    }
         
     $tableForeign->LinkTo($table,@fkColumns);    
 }
 
 sub SubclassTransform {
-    # actually this rlations has only ligical implementation
+    # actually this rlations has only logical implementation
 }
 
 sub MapType {
diff -r 009aa9ca2e48 -r 32d2350fccf9 Lib/IMPL/ORM/Store/SQL.pm
--- /dev/null	Thu Jan 01 00:00:00 1970 +0000
+++ b/Lib/IMPL/ORM/Store/SQL.pm	Mon Jan 11 01:42:00 2010 +0300
@@ -0,0 +1,30 @@
+package IMPL::ORM::Store::SQL;
+use strict;
+use warnings;
+
+use base qw(IMPL::Object);
+
+use IMPL::Class::Property;
+
+BEGIN {
+    public property Connection => prop_all;
+}
+
+sub loadObjects {
+    my ($this,$rObjects) = @_;
+}
+
+sub search {
+    my ($this,$query) = @_;
+}
+
+1;
+
+__END__
+
+=pod
+
+=head1 DESCRIPTION
+Драйвер для SQL баз данных.
+
+=cut
\ No newline at end of file
diff -r 009aa9ca2e48 -r 32d2350fccf9 Lib/IMPL/SQL/Schema/Traits.pm
--- a/Lib/IMPL/SQL/Schema/Traits.pm	Thu Jan 07 15:41:49 2010 +0300
+++ b/Lib/IMPL/SQL/Schema/Traits.pm	Mon Jan 11 01:42:00 2010 +0300
@@ -13,8 +13,8 @@
 } ;
 
 BEGIN {
-    public _direct property SrcSchema => prop_none;
-    public _direct property DstSchema => prop_none;
+    public _direct property SrcSchema => prop_all;
+    public _direct property DstSchema => prop_all;
     public _direct property PendingActions => prop_get;
     public _direct property TableInfo => prop_get;
     public _direct property Handler => prop_get;
@@ -51,7 +51,7 @@
         return 1;
     }
     
-    if ( not grep {$srcTable->Column($_->Name)} $dstTable->Columns ) {
+    if ( not grep {$srcTable->Column($_->Name)} @{$dstTable->Columns} ) {
         
         $this->{$TableInfo}->{$srcTable->Name}->{'NewName'} = $dstTable->Name if $srcTable->Name ne $dstTable->Name;
         
@@ -76,14 +76,14 @@
     }
     
     my $i = 0;
-    my %dstColumns = map { $_->Name, $i++} $dstTable->Columns ;
+    my %dstColumns = map { $_->Name, $i++} @{$dstTable->Columns} ;
     
     # сначала удаляем столбцы
     # потом добавляем недостающие и изменяем столбцы в нужном порядке
     
     my @columnsToUpdate;
     
-    foreach my $srcColumn ($srcTable->Columns) {
+    foreach my $srcColumn (@{$srcTable->Columns}) {
         if (defined (my $dstColumnIndex = delete $dstColumns{$srcColumn->Name})) {
             push @columnsToUpdate, { Action => 'update', ColumnSrc => $srcColumn, ColumnDst => $dstTable->ColumnAt($dstColumnIndex), NewPosition => $dstColumnIndex};
         } else {
@@ -126,8 +126,8 @@
     
     ref $src eq ref $dst or return 0;
     
-    my @dstColumns = $dst->Columns;
-    scalar(@{$src->Columns}) == scalar(@{$dst->Columns}) and not grep { my $column = shift @dstColumns; not $column->isSame($_) } $src->Columns or return 0;
+    my @dstColumns = @{$dst->Columns};
+    scalar(@{$src->Columns}) == scalar(@{$dst->Columns}) and not grep { my $column = shift @dstColumns; not $column->isSame($_) } @{$src->Columns} or return 0;
     
     not UNIVERSAL::isa($src,'IMPL::SQL::Schema::Constraint::ForeignKey') or ConstraintEquals($src->ReferencedPrimaryKey,$dst->ReferencedPrimaryKey) or return 0;
     
@@ -167,7 +167,7 @@
     $this->{$Handler}->DropTable($this->MapTableName($tbl->Name));
     $this->{$TableInfo}{$this->MapTableName($tbl->Name)}{'State'} = STATE_REMOVED;
     $this->{$TableInfo}{$this->MapTableName($tbl->Name)}{'Constraints'} = {map {$_,STATE_REMOVED} keys %{$tbl->Constraints}};
-    $this->{$TableInfo}{$this->MapTableName($tbl->Name)}{'Columns'} = {map { $_->Name, STATE_REMOVED} $tbl->Columns};
+    $this->{$TableInfo}{$this->MapTableName($tbl->Name)}{'Columns'} = {map { $_->Name, STATE_REMOVED} @{$tbl->Columns}};
     
     return 1;
 }
@@ -180,7 +180,7 @@
     
     $this->{$TableInfo}->{$tbl->Name}->{'State'} = STATE_CREATED;
     
-    $this->{$TableInfo}->{$tbl->Name}->{'Columns'} = {map { $_->Name, STATE_CREATED } $tbl->Columns};
+    $this->{$TableInfo}->{$tbl->Name}->{'Columns'} = {map { $_->Name, STATE_CREATED } @{$tbl->Columns}};
     $this->{$TableInfo}->{$tbl->Name}->{'Constraints'} = {map {$_->Name, STATE_CREATED} grep { not UNIVERSAL::isa($_,'IMPL::SQL::Schema::Constraint::ForeignKey') } values %{$tbl->Constraints}};
     
     $this->AddConstraint($_) foreach grep { UNIVERSAL::isa($_,'IMPL::SQL::Schema::Constraint::ForeignKey') } values %{$tbl->Constraints};
@@ -242,7 +242,12 @@
     
     my $pending;
     
-    $pending = grep { my $column = $_; not grep { IfUndef($this->{$TableInfo}{$constraint->Table->Name}{'Columns'}{$column->Name}, STATE_NORMAL) == $_ } (STATE_UPDATED, STATE_CREATED) } $constraint->Columns;
+    $pending = grep {
+        my $column = $_;
+        not grep {
+            IfUndef($this->{$TableInfo}{$constraint->Table->Name}{'Columns'}{$column->Name}, STATE_NORMAL) == $_
+        } (STATE_UPDATED, STATE_CREATED)
+    } @{$constraint->Columns};
     
     if ($pending) {
         push @{$this->{$PendingActions}},{Action => \&AddConstraint, Args => [$constraint]};
diff -r 009aa9ca2e48 -r 32d2350fccf9 Lib/IMPL/SQL/Schema/Traits/mysql.pm
--- a/Lib/IMPL/SQL/Schema/Traits/mysql.pm	Thu Jan 07 15:41:49 2010 +0300
+++ b/Lib/IMPL/SQL/Schema/Traits/mysql.pm	Mon Jan 11 01:42:00 2010 +0300
@@ -5,7 +5,7 @@
 use IMPL::Class::Property::Direct;
 
 BEGIN {
-    public _direct property SqlBatch => prop_none;
+    public _direct property SqlBatch => prop_all;
 }
 
 sub formatTypeNameInteger {
@@ -235,7 +235,7 @@
     my @sql;
     
     # table body
-    push @sql, map { formatColumn($_,$level+1) } $table->Columns ;
+    push @sql, map { formatColumn($_,$level+1) } @{$table->Columns} ;
     if ($options{'skip_foreign_keys'}) {
         push @sql, map { formatConstraint($_,$level+1) } grep {not UNIVERSAL::isa($_,'IMPL::SQL::Schema::Constraint::ForeignKey')} values %{$table->Constraints};
     } else {
@@ -303,7 +303,7 @@
     my ($constraint,$level) = @_;
     
     my $name = quote_names($constraint->Name);
-    my $columns = join(',',map quote_names($_->Name),$constraint->Columns);
+    my $columns = join(',',map quote_names($_->Name),@{$constraint->Columns});
     
     if (ref $constraint eq 'IMPL::SQL::Schema::Constraint::PrimaryKey') {
         return "\t"x$level."PRIMARY KEY ($columns)";
@@ -321,13 +321,13 @@
     my ($constraint,$level) = @_;
     
     my $name = quote_names($constraint->Name);
-    my $columns = join(',',map quote_names($_->Name),$constraint->Columns);
+    my $columns = join(',',map quote_names($_->Name),@{$constraint->Columns});
     
     not $constraint->OnDelete or grep { uc $constraint->OnDelete eq $_ } ('RESTRICT','CASCADE','SET NULL','NO ACTION','SET DEFAULT') or die new IMPL::Exception('Invalid ON DELETE reference',$constraint->OnDelete);
     not $constraint->OnUpdate or grep { uc $constraint->OnUpdate eq $_ } ('RESTRICT','CASCADE','SET NULL','NO ACTION','SET DEFAULT') or die new IMPL::Exception('Invalid ON UPDATE reference',$constraint->OnUpdate);
     
     my $refname = quote_names($constraint->ReferencedPrimaryKey->Table->Name);
-    my $refcolumns = join(',',map quote_names($_->Name),$constraint->ReferencedPrimaryKey->Columns);
+    my $refcolumns = join(',',map quote_names($_->Name),@{$constraint->ReferencedPrimaryKey->Columns});
     return (
         "\t"x$level.
         "CONSTRAINT $name FOREIGN KEY $name ($columns) REFERENCES $refname ($refcolumns)".
@@ -461,7 +461,7 @@
 sub Sql {
     my ($this) = @_;
     if (wantarray) {
-        $this->SqlBatch;
+        @{$this->SqlBatch || []};
     } else {
         return join("\n",$this->SqlBatch);
     }
@@ -477,12 +477,13 @@
     public _direct property PendingConstraints => prop_none;
 }
 
-sub CTOR {
-    my ($this,%args) = @_;
-    
-    $args{'Handler'} = new IMPL::SQL::Schema::Traits::mysql::Handler;
-    $this->SUPER::CTOR(%args);
-}
+our %CTOR = (
+    'IMPL::SQL::Schema::Traits' => sub {
+        my %args = @_;
+        $args{'Handler'} = new IMPL::SQL::Schema::Traits::mysql::Handler;
+        %args;
+    }
+);
 
 sub DropConstraint {
     my ($this,$constraint) = @_;
diff -r 009aa9ca2e48 -r 32d2350fccf9 Lib/IMPL/SQL/Types.pm
--- a/Lib/IMPL/SQL/Types.pm	Thu Jan 07 15:41:49 2010 +0300
+++ b/Lib/IMPL/SQL/Types.pm	Mon Jan 11 01:42:00 2010 +0300
@@ -13,7 +13,7 @@
 }
 
 sub Varchar($) {
-    return IMPL::SQL::Schema::Type->new(Name => 'VARCHAR', Length => shift);
+    return IMPL::SQL::Schema::Type->new(Name => 'VARCHAR', MaxLength => shift);
 }
 
 sub Float($) {
diff -r 009aa9ca2e48 -r 32d2350fccf9 Lib/IMPL/Transform.pm
--- a/Lib/IMPL/Transform.pm	Thu Jan 07 15:41:49 2010 +0300
+++ b/Lib/IMPL/Transform.pm	Mon Jan 11 01:42:00 2010 +0300
@@ -52,6 +52,10 @@
 package IMPL::Transform::NoTransformException;
 use base qw(IMPL::Exception);
 
+our %CTOR = (
+    'IMPL::Exception' => sub { 'No transformation', @_ }
+);
+
 1;
 
 __END__
diff -r 009aa9ca2e48 -r 32d2350fccf9 _test/Test/ORM/Schema.pm
--- a/_test/Test/ORM/Schema.pm	Thu Jan 07 15:41:49 2010 +0300
+++ b/_test/Test/ORM/Schema.pm	Mon Jan 11 01:42:00 2010 +0300
@@ -3,6 +3,8 @@
 use warnings;
 use base qw(IMPL::Test::Unit);
 
+require IMPL::SQL::Schema::Traits::mysql;
+
 __PACKAGE__->PassThroughArgs;
 
 use IMPL::Test qw(test failed);
@@ -26,9 +28,22 @@
     return 1;
 };
 
-test TransformDataSchema => sub {
+test GenerateSQL => sub {
     my $sqlSchema = IMPL::ORM::Schema::TransformToSQL->Std->Transform(Test::ORM::Schema::Data->instance)
         or failed("Failed to transform a schema");
+        
+    my $sqlEmpty = new IMPL::SQL::Schema(Name => 'empty');
+    
+    my $traits = IMPL::SQL::Schema::Traits::mysql->new(
+        SrcSchema => $sqlEmpty,
+        DstSchema => $sqlSchema
+    );
+    
+    $traits->UpdateSchema();
+    
+    print "$_\n" foreach $traits->Handler->Sql;
+    
+    $sqlEmpty->Dispose;
     $sqlSchema->Dispose;
 };