Mercurial > pub > Impl
changeset 44:32d2350fccf9
ORM
*Minor fixes
*Working tarnsform to sql
*Fixes to the sql traits
author | Sergey |
---|---|
date | Mon, 11 Jan 2010 01:42:00 +0300 |
parents | 009aa9ca2e48 |
children | 1b1fb9d54f55 |
files | Lib/IMPL/ORM/Object.pm Lib/IMPL/ORM/Schema.pm Lib/IMPL/ORM/Schema/TransformToSQL.pm Lib/IMPL/ORM/Store/SQL.pm Lib/IMPL/SQL/Schema/Traits.pm Lib/IMPL/SQL/Schema/Traits/mysql.pm Lib/IMPL/SQL/Types.pm Lib/IMPL/Transform.pm _test/Test/ORM/Schema.pm |
diffstat | 9 files changed, 119 insertions(+), 46 deletions(-) [+] |
line wrap: on
line diff
--- 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));
--- 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;
--- 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 {
--- /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
--- 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]};
--- 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) = @_;
--- 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($) {
--- 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__
--- 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; };