Mercurial > pub > Impl
changeset 38:d660fb38b7cc
small fixes
ORM shema to SQL schema transformation
author | Sergey |
---|---|
date | Mon, 23 Nov 2009 17:57:07 +0300 |
parents | c2e7f7c96bcd |
children | 4f5a6a1bfb0e |
files | Lib/IMPL/DOM/Node.pm Lib/IMPL/DOM/Property.pm Lib/IMPL/DOM/Transform.pm Lib/IMPL/ORM/Object.pm Lib/IMPL/ORM/Schema.pm Lib/IMPL/ORM/Schema/Field.pm Lib/IMPL/ORM/Schema/TransformToSQL.pm Lib/IMPL/ORM/Schema/ValueType.pm Lib/IMPL/SQL/Types.pm Lib/IMPL/Transform.pm _test/Test/ORM/Schema.pm |
diffstat | 11 files changed, 273 insertions(+), 24 deletions(-) [+] |
line wrap: on
line diff
--- a/Lib/IMPL/DOM/Node.pm Mon Nov 23 00:59:06 2009 +0300 +++ b/Lib/IMPL/DOM/Node.pm Mon Nov 23 17:57:07 2009 +0300 @@ -208,7 +208,7 @@ # this method is called by the parent node on his children, so we need no to check parent $this->{$document} = $this->{$parentNode}->document; - # prevetn ciclyc + # prevent cyclic weaken($this->{$document}) if $this->{$document}; $_->_updateDocRefs foreach @{$this->{$childNodes}};
--- a/Lib/IMPL/DOM/Property.pm Mon Nov 23 00:59:06 2009 +0300 +++ b/Lib/IMPL/DOM/Property.pm Mon Nov 23 17:57:07 2009 +0300 @@ -25,21 +25,21 @@ die new IMPL::InvalidOperationException("Custom mutators are not allowed","${class}::$name") if ref $mutators; if (($mutators & prop_all) == prop_all) { *{"${class}::$name"} = sub { - $_[0]->Property($name,@_[1..$#_]); + $_[0]->nodeProperty($name,@_[1..$#_]); }; $propInfo->canGet(1); $propInfo->canSet(1); } elsif( $mutators & prop_get ) { *{"${class}::$name"} = sub { die new IMPL::InvalidOperationException("This is a readonly property", "${class}::$name") if @_>1; - $_[0]->Property($name); + $_[0]->nodeProperty($name); }; $propInfo->canGet(1); $propInfo->canSet(0); } elsif( $mutators & prop_set ) { *{"${class}::$name"} = sub { die new IMPL::InvalidOperationException("This is a writeonly property", "${class}::$name") if @_<2; - $_[0]->Property($name,@_[1..$#_]); + $_[0]->nodeProperty($name,@_[1..$#_]); }; $propInfo->canGet(0); $propInfo->canSet(1);
--- /dev/null Thu Jan 01 00:00:00 1970 +0000 +++ b/Lib/IMPL/DOM/Transform.pm Mon Nov 23 17:57:07 2009 +0300 @@ -0,0 +1,33 @@ +package IMPL::DOM::Transform; +use strict; +use warnings; + +use base qw(IMPL::Transform); + +__PACKAGE__->PassThroughArgs; + +sub GetClassForObject { + my ($this,$object) = @_; + + if (my $class = ref $object) { + if (UNIVERSAL::isa($object,'IMPL::DOM::Node')) { + return $object->nodeName; + } else { + return $class; + } + } else { + return undef; + } +} + +1; + +__END__ + +=pod + +=head1 DESCRIPTION + +Преобразование для DOM документа + +=cut \ No newline at end of file
--- a/Lib/IMPL/ORM/Object.pm Mon Nov 23 00:59:06 2009 +0300 +++ b/Lib/IMPL/ORM/Object.pm Mon Nov 23 17:57:07 2009 +0300 @@ -72,7 +72,7 @@ $schema->appendChild( new IMPL::ORM::Schema::Relation::HasMany($ormProp->Name, $type->entityName) ); } elsif (my $type = $dataSchema->isValueType($ormProp->Type,'IMPL::ORM::Object')) { # поле - $schema->appendChild( new IMPL::ORM::Schema::Field($ormProp->Name,$type) ); + $schema->appendChild( new IMPL::ORM::Schema::Field($ormProp->Name,$type->name) ); } 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 Mon Nov 23 00:59:06 2009 +0300 +++ b/Lib/IMPL/ORM/Schema.pm Mon Nov 23 17:57:07 2009 +0300 @@ -5,15 +5,16 @@ use base qw(IMPL::DOM::Document); use IMPL::Class::Property; require IMPL::ORM::Schema::Entity; +require IMPL::ORM::Schema::ValueType; our %CTOR = ( - 'IMPL::DOM::Document' => sub { nodeName => 'Schema' } + 'IMPL::DOM::Document' => sub { nodeName => 'ORMSchema' } ); BEGIN { - public property mapValueTypes => prop_get | owner_set; - public property mapReferenceTypes => prop_get | owner_set; - public property mapPending => prop_get | owner_set; + private property mapValueTypes => prop_all; + private property mapReferenceTypes => prop_all; + private property mapPending => prop_all; public property prefix => prop_get | owner_set; } @@ -45,6 +46,8 @@ my $entity = new IMPL::ORM::Schema::Entity($typeName); + $this->appendChild($entity); + $this->mapPending->{$typeName} = $entity; return $this->mapReferenceTypes->{$typeName} = $entity; @@ -53,7 +56,7 @@ sub _addReferenceType { my ($this,$className) = @_; - $this->mapReferenceTypes->{$className} = $className->ormGetSchema($this,delete $this->mapPending->{$className}); + $this->mapReferenceTypes->{$className} = $className->ormGetSchema($this,delete $this->mapPending->{$className} || $this->appendChild(new IMPL::ORM::Schema::Entity($className))); } # returns valuetype name @@ -65,6 +68,12 @@ return $this->mapValueTypes->{$typeName}; } +sub ReferenceTypes { + my ($this) = @_; + + values %{$this->mapReferenceTypes}; +} + my %instances; sub instance { my ($class) = @_; @@ -77,7 +86,12 @@ $this = ref $this ? $this : $this->instance; - $this->mapValueTypes->{$_} = $classes{$_} foreach keys %classes; + $this->mapValueTypes->{$_} = $this->appendChild( + IMPL::ORM::Schema::ValueType->new( + name => $_, + mapper => $classes{$_} + ) + ) foreach keys %classes; } sub Classes {
--- a/Lib/IMPL/ORM/Schema/Field.pm Mon Nov 23 00:59:06 2009 +0300 +++ b/Lib/IMPL/ORM/Schema/Field.pm Mon Nov 23 17:57:07 2009 +0300 @@ -8,6 +8,7 @@ BEGIN { public property fieldName => prop_get | owner_set; public property fieldType => prop_get | owner_set; + public property fieldNullbale => prop_get | owner_set; } our %CTOR = ( @@ -15,10 +16,11 @@ ); sub CTOR { - my ($this,$name,$type) = @_; + my ($this,$name,$type,$nullable) = @_; $this->fieldName($name) or die new IMPL::InvalidArgumentException('A name is required for the field'); $this->fieldType($type) or die new IMPL::InvalidArgumentException('A type is required for the field'); + $this->fieldNullbale(1) if $nullable; } sub canHaveChildren {
--- /dev/null Thu Jan 01 00:00:00 1970 +0000 +++ b/Lib/IMPL/ORM/Schema/TransformToSQL.pm Mon Nov 23 17:57:07 2009 +0300 @@ -0,0 +1,159 @@ +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 + } +); + +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->ReferenceTypes) { + $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 = map + $table->InsertColumn({ + Name => $prefix . $_->Name, + Type => $_->Type, + CanBeNull => 1 + }), + @{$tableForeign->PrimaryKey->Columns}; + + $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 = $table->Name . '_' . $relation->name; + + my @fkColumns = map + $tableForeign->InsertColumn({ + Name => $prefix . $_->Name, + Type => $_->Type, + CanBeNull => 1 + }), + @{$table->PrimaryKey->Columns}; + + $tableForeign->LinkTo($table,@fkColumns); +} + +sub SubclassTransform { + # actually this rlations has only ligical 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 +
--- /dev/null Thu Jan 01 00:00:00 1970 +0000 +++ b/Lib/IMPL/ORM/Schema/ValueType.pm Mon Nov 23 17:57:07 2009 +0300 @@ -0,0 +1,22 @@ +package IMPL::ORM::Schema::ValueType; +use strict; +use warnings; + +use base qw(IMPL::DOM::Node); +use IMPL::Class::Property; +use IMPL::DOM::Property qw(_dom); + +BEGIN { + public _dom property name => prop_all; + public _dom property mapper => prop_all; +} + +our %CTOR = ( + 'IMPL::DOM::Node' => sub { + my %args = @_; + $args{nodeName} = 'ValueType'; + %args; + } +); + +1;
--- a/Lib/IMPL/SQL/Types.pm Mon Nov 23 00:59:06 2009 +0300 +++ b/Lib/IMPL/SQL/Types.pm Mon Nov 23 17:57:07 2009 +0300 @@ -4,7 +4,7 @@ require Exporter; our @ISA = qw(Exporter); -our @EXPORT_OK = qw(&Integer &Varchar &Float &Real &Text &Binary); +our @EXPORT_OK = qw(&Integer &Varchar &Float &Real &Text &Binary &DateTime); require IMPL::SQL::Schema::Type; @@ -32,4 +32,8 @@ return IMPL::SQL::Schema::Type->new(Name => 'BINARY'); } +sub DateTime() { + return IMPL::SQL::Schema::Type->new(Name => 'DATETIME'); +} + 1;
--- a/Lib/IMPL/Transform.pm Mon Nov 23 00:59:06 2009 +0300 +++ b/Lib/IMPL/Transform.pm Mon Nov 23 17:57:07 2009 +0300 @@ -20,29 +20,35 @@ } sub Transform { - my ($this,$object) = @_; + my ($this,$object,@args) = @_; if (not ref $object) { die new IMPL::Exception("There is no the template for a plain value in the transform") unless $this->{$Plain}; my $template = $this->{$Plain}; - return $this->$template($object); + return $this->$template($object,@args); } else { my $template = $this->MatchTemplate($object) || $this->Default or die new IMPL::Transform::NoTransformException(ref $object); - return $this->$template($object); + return $this->$template($object,@args); } } sub MatchTemplate { my ($this,$object) = @_; - my $class = ref $object; + my $class = $this->GetClassForObject( $object ); foreach my $tClass ( keys %{$this->Templates || {}} ) { return $this->Templates->{$tClass} if ($tClass eq $class); } } +sub GetClassForObject { + my ($this,$object) = @_; + + return ref $object; +} + package IMPL::Transform::NoTransformException; use base qw(IMPL::Exception); @@ -76,7 +82,8 @@ my $result = $t->Transform($obj); -=head1 Summary -Преобразует данные содержащиеся в форме в реальные объекты используя специальное преобразование. +=head1 DESCRIPTION + +Преобразование одного объекта к другому, например даных к их представлению. =cut \ No newline at end of file
--- a/_test/Test/ORM/Schema.pm Mon Nov 23 00:59:06 2009 +0300 +++ b/_test/Test/ORM/Schema.pm Mon Nov 23 17:57:07 2009 +0300 @@ -7,6 +7,8 @@ use IMPL::Test qw(test failed); +require IMPL::ORM::Schema::TransformToSQL; + test ExtractClassSchema => sub { my ($this) = @_; @@ -24,6 +26,12 @@ return 1; }; +test TransformDataSchema => sub { + my $sqlSchema = IMPL::ORM::Schema::TransformToSQL->Std->Transform(Test::ORM::Schema::Data->instance) + or failed("Failed to transform a schema"); + $sqlSchema->Dispose; +}; + package Test::ORM::Schema::Data::User; use base qw(IMPL::ORM::Object); @@ -59,11 +67,11 @@ use base qw(IMPL::ORM::Schema); __PACKAGE__->ValueTypes ( - 'String' => 'IMPL::ORM::Value::String', - 'DateTime' => 'IMPL::ORM::Value::DateTime', - 'Integer' => 'IMPL::ORM::Value::Inetger', - 'Float' => 'IMPL::ORM::Value::Float', - 'Decimal' => 'IMPL::ORM::Value::Decimal' + String => 'IMPL::ORM::Value::String', + DateTime => 'IMPL::ORM::Value::DateTime', + Integer => 'IMPL::ORM::Value::Inetger', + Float => 'IMPL::ORM::Value::Float', + Decimal => 'IMPL::ORM::Value::Decimal' ); __PACKAGE__->usePrefix(__PACKAGE__);